X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtksourceview%2FgSourceView.ml;h=251f76c59f1a506896646cbef0cdf85f65bf6b69;hb=97c2d258a5c524eb5c4b85208899d80751a2c82f;hp=30f13b2fea3a7942d335d5af0c8b680b309204f0;hpb=22a7ffd6835f8e36f53bfe07248bd6a0fb582a4f;p=helm.git diff --git a/helm/DEVEL/lablgtksourceview/gSourceView.ml b/helm/DEVEL/lablgtksourceview/gSourceView.ml index 30f13b2fe..251f76c59 100644 --- a/helm/DEVEL/lablgtksourceview/gSourceView.ml +++ b/helm/DEVEL/lablgtksourceview/gSourceView.ml @@ -1,26 +1,22 @@ -(* Copyright (C) 2005: - * Stefano Zacchiroli - * Claudio Sacerdoti Coen +(* + * lablgtksourceview, OCaml binding for the GtkSourceView text widget * - * This file is part of lablgtksourceview, the OCaml binding for the - * GtkSourceView widget. + * Copyright (C) 2005 Stefano Zacchiroli * - * lablgtksourceview is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License as - * published by the Free Software Foundation; either version 2 of the + * This library is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as + * published by the Free Software Foundation; either version 2.1 of the * License, or (at your option) any later version. - * - * lablgtksourceview is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of + * + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with lablgtksourceview; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA - * 02111-1307, USA. + * Lesser General Public License for more details. * - * For details, send a mail to the authors. + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + * USA *) open Gaux @@ -32,19 +28,79 @@ open GtkSourceView open OgtkSourceViewProps open GObj -let get_bool = function `BOOL b -> b | _ -> assert false -let bool b = `BOOL b -let get_uint = function `INT i -> i | _ -> assert false -let uint i = `INT i -let get_int = function `INT i -> i | _ -> assert false -let int i = `INT i +let get_bool = function `BOOL x -> x | _ -> assert false +let bool x = `BOOL x +let get_uint = function `INT x -> x | _ -> assert false +let uint x = `INT x +let get_int = function `INT x -> x | _ -> assert false +let int x = `INT x +let get_gobject = function `OBJECT x -> x | _ -> assert false +let gobject x = `OBJECT (Some x) + +(** {2 GtkSourceLanguage} *) + +class source_language_signals obj' = +object (self) + inherit ['a] gobject_signals (obj' : [> Gtk_sourceview.source_language] obj) + inherit source_language_sigs +end + +class source_language (obj: Gtk_sourceview.source_language obj) = +object (self) + method as_source_language = obj + method connect = new source_language_signals obj + method misc = new gobject_ops obj + method get_name = SourceLanguage.get_name obj + method get_section = SourceLanguage.get_section obj + method get_escape_char = SourceLanguage.get_escape_char obj +end + +(** {2 GtkSourceLanguagesManager} *) + +class source_languages_manager + (obj: Gtk_sourceview.source_languages_manager obj) = +object (self) + method get_oid = Gobject.get_oid obj + method as_source_languages_manager = obj + method get_language_from_mime_type s = + match SourceLanguagesManager.get_language_from_mime_type obj s with + | None -> None + | Some obj -> Some (new source_language obj) + method lang_files_dirs = SourceLanguagesManager.get_lang_files_dirs obj +end + +(* let source_languages_manager ?lang_files_dirs () = + let properties = + match lang_files_dirs with + | None -> [] + | Some dirs -> + let list_obj = gslist_of_string_list dirs in + [Gobject.param + "lang-files-dirs" + (`OBJECT (Some list_obj))] + in + new source_languages_manager (SourceLanguagesManager.create properties) *) + +let source_languages_manager () = + new source_languages_manager (SourceLanguagesManager.create []) + +let source_language_from_file ?languages_manager fname = + let languages_manager = + match languages_manager with + | None -> source_languages_manager () + | Some lm -> lm + in + let manager_obj = languages_manager#as_source_languages_manager in + match SourceLanguage.new_from_file fname manager_obj with + | None -> None + | Some lang_obj -> Some (new source_language lang_obj) (** {2 GtkSourceBuffer} *) -class source_buffer_signals obj_arg = +class source_buffer_signals obj' = object - inherit ['a] gobject_signals (obj_arg : [> Gtk_sourceview.source_buffer] obj) - inherit GText.buffer_signals obj_arg + inherit ['a] gobject_signals (obj' : [> Gtk_sourceview.source_buffer] obj) + inherit GText.buffer_signals obj' inherit source_buffer_sigs end @@ -60,6 +116,13 @@ object (self) method max_undo_levels = get_int (self#misc#get_property "max-undo-levels") method set_max_undo_levels x = self#misc#set_property "max-undo-levels" (int x) + method language = + match get_gobject (self#misc#get_property "language") with + | None -> None + | Some obj -> + Some (new source_language (Gobject.try_cast obj "GtkSourceLanguage")) + method set_language (x: source_language) = + self#misc#set_property "language" (gobject x#as_source_language) method escape_char = get_uint (self#misc#get_property "escape-char") method set_escape_char x = self#misc#set_property "escape-char" (uint x) method can_undo = SourceBuffer.can_undo obj @@ -72,8 +135,13 @@ object (self) SourceBuffer.end_not_undoable_action obj end -let source_buffer ?text = - SourceBuffer.make_params [] ~cont:(fun pl () -> +let source_buffer ?language ?text (* ?tag_table *) = + let language = + match language with + | None -> None + | Some source_language -> Some (source_language#as_source_language) + in + SourceBuffer.make_params [] ?language ~cont:(fun pl () -> let buf = new source_buffer (SourceBuffer.create pl) in (match text with | None -> () @@ -85,17 +153,23 @@ let source_buffer' = source_buffer (** {2 GtkSourceView} *) -class source_view_signals obj_arg = +class source_view_signals obj' = object - inherit widget_signals_impl (obj_arg : [> Gtk_sourceview.source_view] obj) - inherit GText.view_signals obj_arg + inherit widget_signals_impl (obj' : [> Gtk_sourceview.source_view] obj) + inherit GText.view_signals obj' inherit source_view_sigs end -class source_view (obj: Gtk_sourceview.source_view obj) = +class source_view (obj': Gtk_sourceview.source_view obj) = object (self) - inherit GText.view_skel obj - method connect = new source_view_signals obj + inherit GText.view_skel obj' + val source_buf = + let buf_obj = + Gobject.try_cast (GtkText.View.get_buffer obj') "GtkSourceBuffer" + in + new source_buffer buf_obj + method source_buffer = source_buf + method connect = new source_view_signals obj' method set_show_line_numbers x = self#misc#set_property "show_line_numbers" (bool x) method show_line_numbers = @@ -124,12 +198,22 @@ let source_view ?source_buffer = SourceView.make_params [] ~cont:( GtkText.View.make_params ~cont:( GContainer.pack_container ~create:(fun pl -> - let buf = + let obj = match source_buffer with - | None -> source_buffer' () - | Some source_buffer -> source_buffer + | Some buf -> + SourceView.new_with_buffer + (Gobject.try_cast buf#as_buffer "GtkSourceBuffer") + | None -> SourceView.new_ () in - let obj = SourceView.create pl in - GtkText.View.set_buffer obj buf#as_buffer; + Gobject.set_params (Gobject.try_cast obj "GtkSourceView") pl; new source_view obj))) +(** {2 Misc} *) + +let find_matching_bracket iter = + let iter = iter#copy in + if SourceViewMisc.find_matching_bracket iter#as_iter then + Some iter + else + None +