helm/DEVEL/lablgtksourceview/gSourceView.ml

   1 (*
   2  * lablgtksourceview, OCaml binding for the GtkSourceView text widget
   3  *
   4  * Copyright (C) 2005  Stefano Zacchiroli <zack@cs.unibo.it>
   5  *
   6  * This library is free software; you can redistribute it and/or modify
   7  * it under the terms of the GNU Lesser General Public License as
   8  * published by the Free Software Foundation; either version 2.1 of the
   9  * License, or (at your option) any later version.
  10  *
  11  * This library is distributed in the hope that it will be useful, but
  12  * WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14  * Lesser General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU Lesser General Public
  17  * License along with this library; if not, write to the Free Software
  18  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
  19  * USA
  20  *)
  21
  22 open Gaux
  23 open Gtk_sourceview
  24 open Gobject
  25 open Gtk
  26 open GtkBase
  27 open GtkSourceView
  28 open OgtkSourceViewProps
  29 open GObj
  30
  31 let get_bool = function `BOOL x -> x | _ -> assert false
  32 let bool x = `BOOL x
  33 let get_uint = function `INT x -> x | _ -> assert false
  34 let uint x = `INT x
  35 let get_int = function `INT x -> x | _ -> assert false
  36 let int x = `INT x
  37 let get_gobject = function `OBJECT x -> x | _ -> assert false
  38 let gobject x = `OBJECT (Some x)
  39
  40 (** {2 GtkSourceLanguage} *)
  41
  42 class source_language_signals obj' =
  43 object (self)
  44   inherit ['a] gobject_signals (obj' : [> Gtk_sourceview.source_language] obj)
  45   inherit source_language_sigs
  46 end
  47
  48 class source_language (obj: Gtk_sourceview.source_language obj) =
  49 object (self)
  50   method as_source_language = obj
  51   method connect = new source_language_signals obj
  52   method misc = new gobject_ops obj
  53   method get_name = SourceLanguage.get_name obj
  54   method get_section = SourceLanguage.get_section obj
  55   method get_escape_char = SourceLanguage.get_escape_char obj
  56 end
  57
  58 (** {2 GtkSourceLanguagesManager} *)
  59
  60 class source_languages_manager
  61   (obj: Gtk_sourceview.source_languages_manager obj) =
  62 object (self)
  63   method get_oid = Gobject.get_oid obj
  64   method as_source_languages_manager = obj
  65   method get_language_from_mime_type s =
  66     match SourceLanguagesManager.get_language_from_mime_type obj s with
  67     | None -> None
  68     | Some obj -> Some (new source_language obj)
  69   method lang_files_dirs = SourceLanguagesManager.get_lang_files_dirs obj
  70 end
  71
  72 (* let source_languages_manager ?lang_files_dirs () =
  73   let properties =
  74     match lang_files_dirs with
  75     | None -> []
  76     | Some dirs ->
  77         let list_obj = gslist_of_string_list dirs in
  78         [Gobject.param
  79           "lang-files-dirs"
  80           (`OBJECT (Some list_obj))]
  81   in
  82   new source_languages_manager (SourceLanguagesManager.create properties) *)
  83
  84 let source_languages_manager () =
  85   new source_languages_manager (SourceLanguagesManager.create [])
  86
  87 let source_language_from_file ?languages_manager fname =
  88   let languages_manager =
  89     match languages_manager with
  90     | None -> source_languages_manager ()
  91     | Some lm -> lm
  92   in
  93   let manager_obj = languages_manager#as_source_languages_manager in
  94   match SourceLanguage.new_from_file fname manager_obj with
  95   | None -> None
  96   | Some lang_obj -> Some (new source_language lang_obj)
  97
  98 (** {2 GtkSourceBuffer} *)
  99
 100 class source_buffer_signals obj' =
 101 object
 102   inherit ['a] gobject_signals (obj' : [> Gtk_sourceview.source_buffer] obj)
 103   inherit GText.buffer_signals obj'
 104   inherit source_buffer_sigs
 105 end
 106
 107 class source_buffer (obj: Gtk_sourceview.source_buffer obj) =
 108 object (self)
 109   inherit GText.buffer_skel obj
 110   method connect = new source_buffer_signals obj
 111   method misc = new gobject_ops obj
 112   method check_brackets = get_bool (self#misc#get_property "check-brackets")
 113   method set_check_brackets x = self#misc#set_property "check-brackets" (bool x)
 114   method highlight = get_bool (self#misc#get_property "highlight")
 115   method set_highlight x = self#misc#set_property "highlight" (bool x)
 116   method max_undo_levels = get_int (self#misc#get_property "max-undo-levels")
 117   method set_max_undo_levels x =
 118     self#misc#set_property "max-undo-levels" (int x)
 119   method language =
 120     match get_gobject (self#misc#get_property "language") with
 121     | None -> None
 122     | Some obj ->
 123         Some (new source_language (Gobject.try_cast obj "GtkSourceLanguage"))
 124   method set_language (x: source_language) =
 125     self#misc#set_property "language" (gobject x#as_source_language)
 126   method escape_char = get_uint (self#misc#get_property "escape-char")
 127   method set_escape_char x = self#misc#set_property "escape-char" (uint x)
 128   method can_undo = SourceBuffer.can_undo obj
 129   method can_redo = SourceBuffer.can_redo obj
 130   method undo () = SourceBuffer.undo obj
 131   method redo () = SourceBuffer.redo obj
 132   method begin_not_undoable_action () =
 133     SourceBuffer.begin_not_undoable_action obj
 134   method end_not_undoable_action () =
 135     SourceBuffer.end_not_undoable_action obj
 136 end
 137
 138 let source_buffer ?language ?text (* ?tag_table *) =
 139   let language =
 140     match language with
 141     | None -> None
 142     | Some source_language -> Some (source_language#as_source_language)
 143   in
 144   SourceBuffer.make_params [] ?language ~cont:(fun pl () ->
 145     let buf = new source_buffer (SourceBuffer.create pl) in
 146     (match text with
 147     | None -> ()
 148     | Some text -> buf#set_text text);
 149     buf)
 150
 151   (* alias used below, needed because "source_buffer" is a name in scope *)
 152 let source_buffer' = source_buffer
 153
 154 (** {2 GtkSourceView} *)
 155
 156 class source_view_signals obj' =
 157 object
 158   inherit widget_signals_impl (obj' : [> Gtk_sourceview.source_view] obj)
 159   inherit GText.view_signals obj'
 160   inherit source_view_sigs
 161 end
 162
 163 class source_view (obj': Gtk_sourceview.source_view obj) =
 164 object (self)
 165   inherit GText.view_skel obj'
 166   val source_buf =
 167     let buf_obj =
 168       Gobject.try_cast (GtkText.View.get_buffer obj') "GtkSourceBuffer"
 169     in
 170     new source_buffer buf_obj
 171   method source_buffer = source_buf
 172   method connect = new source_view_signals obj'
 173   method set_show_line_numbers x =
 174     self#misc#set_property "show_line_numbers" (bool x)
 175   method show_line_numbers =
 176     get_bool (self#misc#get_property "show_line_numbers")
 177   method set_show_line_markers x =
 178     self#misc#set_property "show_line_markers" (bool x)
 179   method show_line_markers =
 180     get_bool (self#misc#get_property "show_line_markers")
 181   method set_tabs_width x = self#misc#set_property "tabs_width" (uint x)
 182   method tabs_width = get_uint (self#misc#get_property "tabs_width")
 183   method set_auto_indent x = self#misc#set_property "auto_indent" (bool x)
 184   method auto_indent = get_bool (self#misc#get_property "auto_indent")
 185   method set_insert_spaces_instead_of_tabs x =
 186     self#misc#set_property "insert_spaces_instead_of_tabs" (bool x)
 187   method insert_spaces_instead_of_tabs =
 188     get_bool (self#misc#get_property "insert_spaces_instead_of_tabs")
 189   method set_show_margin x = self#misc#set_property "show_margin" (bool x)
 190   method show_margin = get_bool (self#misc#get_property "show_margin")
 191   method set_margin x = self#misc#set_property "margin" (uint x)
 192   method margin = get_uint (self#misc#get_property "margin")
 193   method set_smart_home_end x = self#misc#set_property "smart_home_end" (bool x)
 194   method smart_home_end = get_bool (self#misc#get_property "smart_home_end")
 195 end
 196
 197 let source_view ?source_buffer =
 198   SourceView.make_params [] ~cont:(
 199     GtkText.View.make_params ~cont:(
 200       GContainer.pack_container ~create:(fun pl ->
 201         let obj =
 202           match source_buffer with
 203           | Some buf ->
 204               SourceView.new_with_buffer
 205                 (Gobject.try_cast buf#as_buffer "GtkSourceBuffer")
 206           | None -> SourceView.new_ ()
 207         in
 208         Gobject.set_params (Gobject.try_cast obj "GtkSourceView") pl;
 209         new source_view obj)))
 210
 211 (** {2 Misc} *)
 212
 213 let find_matching_bracket iter =
 214   let iter = iter#copy in
 215   if SourceViewMisc.find_matching_bracket iter#as_iter then
 216     Some iter
 217   else
 218     None
 219