helm/DEVEL/lablgtksourceview/gSourceView.ml

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