X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtksourceview%2FgSourceView.ml;h=251f76c59f1a506896646cbef0cdf85f65bf6b69;hb=97c2d258a5c524eb5c4b85208899d80751a2c82f;hp=9a4534f833f9ab8a1363254e2acf1ab89b4432fe;hpb=4f576c9474396e214db9fcf8bb974c603c16a825;p=helm.git

diff --git a/helm/DEVEL/lablgtksourceview/gSourceView.ml b/helm/DEVEL/lablgtksourceview/gSourceView.ml
index 9a4534f83..251f76c59 100644
--- a/helm/DEVEL/lablgtksourceview/gSourceView.ml
+++ b/helm/DEVEL/lablgtksourceview/gSourceView.ml
@@ -1,26 +1,22 @@
-(* Copyright (C) 2005:
- *	Stefano Zacchiroli     <zack@cs.unibo.it>
- * 	Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>
+(*
+ * 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 <zack@cs.unibo.it>
  * 
- * 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,31 +28,192 @@ open GtkSourceView
 open OgtkSourceViewProps
 open GObj
 
-let get_bool = function
-  | `BOOL b -> b
-  | _ -> assert false
+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) *)
 
-class source_view_signals obj_param =
+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' =
+object
+  inherit ['a] gobject_signals (obj' : [> Gtk_sourceview.source_buffer] obj)
+  inherit GText.buffer_signals obj'
+  inherit source_buffer_sigs
+end
+
+class source_buffer (obj: Gtk_sourceview.source_buffer obj) =
+object (self)
+  inherit GText.buffer_skel obj
+  method connect = new source_buffer_signals obj
+  method misc = new gobject_ops obj
+  method check_brackets = get_bool (self#misc#get_property "check-brackets")
+  method set_check_brackets x = self#misc#set_property "check-brackets" (bool x)
+  method highlight = get_bool (self#misc#get_property "highlight")
+  method set_highlight x = self#misc#set_property "highlight" (bool x)
+  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
+  method can_redo = SourceBuffer.can_redo obj
+  method undo () = SourceBuffer.undo obj
+  method redo () = SourceBuffer.redo obj
+  method begin_not_undoable_action () =
+    SourceBuffer.begin_not_undoable_action obj
+  method end_not_undoable_action () =
+    SourceBuffer.end_not_undoable_action obj
+end
+
+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 -> ()
+    | Some text -> buf#set_text text);
+    buf)
+
+  (* alias used below, needed because "source_buffer" is a name in scope *)
+let source_buffer' = source_buffer
+
+(** {2 GtkSourceView} *)
+
+class source_view_signals obj' =
 object
-  inherit widget_signals_impl (obj_param : [> Gtk_sourceview.source_view] obj)
-(*   inherit OgtkTextProps.text_view_sigs *)
-  inherit GText.view_signals obj_param
+  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 =
     get_bool (self#misc#get_property "show_line_numbers")
-  method set_show_line_numbers b =
-    self#misc#set_property "show_line_numbers" (`BOOL b)
+  method set_show_line_markers x =
+    self#misc#set_property "show_line_markers" (bool x)
+  method show_line_markers =
+    get_bool (self#misc#get_property "show_line_markers")
+  method set_tabs_width x = self#misc#set_property "tabs_width" (uint x)
+  method tabs_width = get_uint (self#misc#get_property "tabs_width")
+  method set_auto_indent x = self#misc#set_property "auto_indent" (bool x)
+  method auto_indent = get_bool (self#misc#get_property "auto_indent")
+  method set_insert_spaces_instead_of_tabs x =
+    self#misc#set_property "insert_spaces_instead_of_tabs" (bool x)
+  method insert_spaces_instead_of_tabs =
+    get_bool (self#misc#get_property "insert_spaces_instead_of_tabs")
+  method set_show_margin x = self#misc#set_property "show_margin" (bool x)
+  method show_margin = get_bool (self#misc#get_property "show_margin")
+  method set_margin x = self#misc#set_property "margin" (uint x)
+  method margin = get_uint (self#misc#get_property "margin")
+  method set_smart_home_end x = self#misc#set_property "smart_home_end" (bool x)
+  method smart_home_end = get_bool (self#misc#get_property "smart_home_end")
 end
 
-let source_view =
+let source_view ?source_buffer =
   SourceView.make_params [] ~cont:(
     GtkText.View.make_params ~cont:(
       GContainer.pack_container ~create:(fun pl ->
-        new source_view (SourceView.create pl))))
+        let obj =
+          match source_buffer with
+          | Some buf ->
+              SourceView.new_with_buffer
+                (Gobject.try_cast buf#as_buffer "GtkSourceBuffer")
+          | None -> SourceView.new_ ()
+        in
+        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