helm/DEVEL/lablgtkmathview/gMathView.ml

   1 (* Copyright (C) 2000, Luca Padovani <luca.padovani@cs.unibo.it>.
   2  *
   3  * This file is part of lablgtkmathview, the Ocaml binding
   4  * for the GtkMathView widget.
   5  *
   6  * lablgtkmathview is free software; you can redistribute it and/or
   7  * modify it under the terms of the GNU General Public License
   8  * as published by the Free Software Foundation; either version 2
   9  * of the License, or (at your option) any later version.
  10  *
  11  * lablgtkmathview is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14  * GNU General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU General Public License
  17  * along with lablgtkmathview; if not, write to the Free Software
  18  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  19  *
  20  * For details, send a mail to the author.
  21  *)
  22
  23 open Gaux
  24 open Gtk
  25 open Gtk_mathview
  26 open GtkBase
  27 open GtkMathView
  28 open GObj
  29
  30 exception ErrorLoadingFile of string;;
  31 exception ErrorWritingFile of string;;
  32 exception ErrorLoadingDOM;;
  33 exception NoSelection;;
  34
  35 let option_element_of_option =
  36  function
  37     None -> None
  38   | Some v -> Some (new Gdome.element v)
  39
  40 class math_view_signals obj = object
  41   inherit GContainer.container_signals obj
  42   method click =
  43    let module S = GtkSignal in
  44     let new_click =
  45      let new_marshaller f x y =
  46       MathView.Signals.click.S.marshaller
  47        (fun e s -> f (new Gdome.element e) s) x y
  48      in
  49       { S.name = "click"; S.classe = `math_view;
  50         S.marshaller = new_marshaller }
  51     in
  52      GtkSignal.connect ~sgn:new_click obj ~after
  53   method select_begin =
  54    let module S = GtkSignal in
  55     let new_select_begin =
  56      let new_marshaller f x y =
  57       MathView.Signals.select_begin.S.marshaller
  58        (fun e s -> f (option_element_of_option e) s) x y
  59      in
  60       { S.name = "select_begin"; S.classe = `math_view;
  61         S.marshaller = new_marshaller }
  62     in
  63      GtkSignal.connect ~sgn:new_select_begin obj ~after
  64    method select_over =
  65    let module S = GtkSignal in
  66     let new_select_over =
  67      let new_marshaller f x y =
  68       MathView.Signals.select_over.S.marshaller
  69        (fun e s -> f (option_element_of_option e) s) x y
  70      in
  71       { S.name = "select_over"; S.classe = `math_view;
  72         S.marshaller = new_marshaller }
  73     in
  74      GtkSignal.connect ~sgn:new_select_over obj ~after
  75    method select_end =
  76    let module S = GtkSignal in
  77     let new_select_end =
  78      let new_marshaller f x y =
  79       MathView.Signals.select_end.S.marshaller
  80        (fun e s -> f (option_element_of_option e) s) x y
  81      in
  82       { S.name = "select_end"; S.classe = `math_view;
  83         S.marshaller = new_marshaller }
  84     in
  85      GtkSignal.connect ~sgn:new_select_end obj ~after
  86    method select_abort =
  87    let module S = GtkSignal in
  88     let new_select_abort =
  89      let new_marshaller f x y =
  90       MathView.Signals.select_abort.S.marshaller
  91        (fun () -> f ()) x y
  92      in
  93       { S.name = "select_abort"; S.classe = `math_view;
  94         S.marshaller = new_marshaller }
  95     in
  96      GtkSignal.connect ~sgn:new_select_abort obj ~after
  97   method element_over =
  98    let module S = GtkSignal in
  99     let new_element_over =
 100      let new_marshaller f x y =
 101       MathView.Signals.element_over.S.marshaller
 102        (fun e s -> f (option_element_of_option e) s) x y
 103      in
 104       { S.name = "element_over"; S.classe = `math_view;
 105         S.marshaller = new_marshaller }
 106     in
 107      GtkSignal.connect ~sgn:new_element_over obj ~after
 108 end
 109
 110 class math_view_skel obj = object
 111  inherit GContainer.container (obj : Gtk_mathview.math_view obj)
 112  method freeze = MathView.freeze obj
 113  method thaw = MathView.thaw obj
 114  method load_uri ~filename =
 115   if not (MathView.load_uri obj ~filename) then raise (ErrorLoadingFile filename)
 116  method load_doc ~dom =
 117   if not (MathView.load_doc obj ~dom:((dom : Gdome.document)#as_Document)) then
 118    raise ErrorLoadingDOM
 119  method unload = MathView.unload obj
 120  method select element = MathView.select obj ((element : Gdome.element)#as_Element)
 121  method unselect element = MathView.unselect obj ((element : Gdome.element)#as_Element)
 122  method is_selected element = MathView.is_selected obj ((element : Gdome.element)#as_Element)
 123  method get_width = MathView.get_width obj
 124  method get_height = MathView.get_height obj
 125  method get_top = MathView.get_top obj
 126  method set_top = MathView.set_top obj
 127  method set_adjustments =
 128   fun adj1 adj2 ->
 129    MathView.set_adjustments obj (GData.as_adjustment adj1)
 130    (GData.as_adjustment adj2)
 131  method get_hadjustment = new GData.adjustment (MathView.get_hadjustment obj)
 132  method get_vadjustment = new GData.adjustment (MathView.get_vadjustment obj)
 133  method get_buffer = MathView.get_buffer obj
 134  method get_frame = new GBin.frame (MathView.get_frame obj)
 135  method set_font_size = MathView.set_font_size obj
 136  method get_font_size = MathView.get_font_size obj
 137  method set_anti_aliasing = MathView.set_anti_aliasing obj
 138  method get_anti_aliasing = MathView.get_anti_aliasing obj
 139  method set_transparency = MathView.set_transparency obj
 140  method get_transparency = MathView.get_transparency obj
 141  method set_log_verbosity = MathView.set_log_verbosity obj
 142  method get_log_verbosity = MathView.get_log_verbosity obj
 143  method export_to_postscript
 144         ?(width = 595) ?(height = 822) ?(x_margin = 72) ?(y_margin = 72)
 145         ?(disable_colors = false) ~filename () =
 146   let result = MathView.export_to_postscript obj
 147         ~width ~height ~x_margin ~y_margin ~disable_colors ~filename
 148   in
 149   if not result then raise (ErrorWritingFile filename)
 150  method get_font_manager_type = MathView.get_font_manager_type obj
 151  method set_font_manager_type ~fm_type = MathView.set_font_manager_type obj ~fm_type
 152 end
 153
 154 class math_view obj = object
 155  inherit math_view_skel (obj : Gtk_mathview.math_view obj)
 156  method connect = new math_view_signals obj
 157 end
 158
 159 let math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width
 160  ?width ?height ?packing ?show () =
 161  let w =
 162    MathView.create
 163     ?adjustmenth:(may_map ~f:GData.as_adjustment adjustmenth)
 164     ?adjustmentv:(may_map ~f:GData.as_adjustment adjustmentv)
 165     ()
 166  in
 167   Container.set w ?border_width ?width ?height;
 168  let mathview = pack_return (new math_view w) ~packing ~show in
 169  begin
 170     match font_size with
 171     | Some size -> mathview#set_font_size size
 172     | None      -> ()
 173   end;
 174   begin
 175     match font_manager with
 176     | Some manager -> mathview#set_font_manager_type ~fm_type:manager
 177     | None         -> ()
 178   end;
 179   mathview
 180 ;;