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 class math_view_signals obj = object
  36   inherit GContainer.container_signals obj
  37   method clicked =
  38    let module S = GtkSignal in
  39     let new_clicked =
  40      let new_marshaller f x y =
  41       MathView.Signals.clicked.S.marshaller
  42        (fun e -> f (new Gdome.element e)) x y
  43      in
  44       { S.name = "clicked"; S.classe = `math_view;
  45         S.marshaller = new_marshaller }
  46     in
  47      GtkSignal.connect ~sgn:new_clicked obj ~after
  48   method press_move =
  49    let module S = GtkSignal in
  50     let new_press_move =
  51      let new_marshaller f x y =
  52       MathView.Signals.press_move.S.marshaller
  53        (fun x y ->
  54          let option_element_of_option v =
  55           match v with
  56              None -> None
  57            | Some v' -> Some (new Gdome.element v')
  58          in
  59           f (option_element_of_option x) (option_element_of_option y)) x y
  60      in
  61       { S.name = "press_move"; S.classe = `math_view;
  62         S.marshaller = new_marshaller }
  63     in
  64      GtkSignal.connect ~sgn:new_press_move obj ~after
  65   method element_changed =
  66    let module S = GtkSignal in
  67     let new_element_changed =
  68      let new_marshaller f x y =
  69       MathView.Signals.element_changed.S.marshaller
  70        (function None -> f None | Some e -> f (Some (new Gdome.element e))) x y
  71      in
  72       { S.name = "element_changed"; S.classe = `math_view;
  73         S.marshaller = new_marshaller }
  74     in
  75      GtkSignal.connect ~sgn:new_element_changed obj ~after
  76 end
  77
  78 class math_view_skel obj = object
  79  inherit GContainer.container (obj : Gtk_mathview.math_view obj)
  80  method freeze = MathView.freeze obj
  81  method thaw = MathView.thaw obj
  82  method load_uri ~filename =
  83   if not (MathView.load_uri obj ~filename) then raise (ErrorLoadingFile filename)
  84  method load_doc ~dom =
  85   if not (MathView.load_doc obj ~dom:((dom : Gdome.document)#as_Document)) then
  86    raise ErrorLoadingDOM
  87  method unload = MathView.unload obj
  88  method select element = MathView.select obj ((element : Gdome.element)#as_Element)
  89  method unselect element = MathView.unselect obj ((element : Gdome.element)#as_Element)
  90  method is_selected element = MathView.is_selected obj ((element : Gdome.element)#as_Element)
  91  method get_width = MathView.get_width obj
  92  method get_height = MathView.get_height obj
  93  method get_top = MathView.get_top obj
  94  method set_top = MathView.set_top obj
  95  method set_adjustments =
  96   fun adj1 adj2 ->
  97    MathView.set_adjustments obj (GData.as_adjustment adj1)
  98    (GData.as_adjustment adj2)
  99  method get_hadjustment = new GData.adjustment (MathView.get_hadjustment obj)
 100  method get_vadjustment = new GData.adjustment (MathView.get_vadjustment obj)
 101  method get_buffer = MathView.get_buffer obj
 102  method get_frame = new GBin.frame (MathView.get_frame obj)
 103  method set_font_size = MathView.set_font_size obj
 104  method get_font_size = MathView.get_font_size obj
 105  method set_anti_aliasing = MathView.set_anti_aliasing obj
 106  method get_anti_aliasing = MathView.get_anti_aliasing obj
 107  method set_transparency = MathView.set_transparency obj
 108  method get_transparency = MathView.get_transparency obj
 109  method set_log_verbosity = MathView.set_log_verbosity obj
 110  method get_log_verbosity = MathView.get_log_verbosity obj
 111  method export_to_postscript
 112         ?(width = 595) ?(height = 822) ?(x_margin = 72) ?(y_margin = 72)
 113         ?(disable_colors = false) ~filename () =
 114   let result = MathView.export_to_postscript obj
 115         ~width ~height ~x_margin ~y_margin ~disable_colors ~filename
 116   in
 117   if not result then raise (ErrorWritingFile filename)
 118  method get_font_manager_type = MathView.get_font_manager_type obj
 119  method set_font_manager_type ~fm_type = MathView.set_font_manager_type obj ~fm_type
 120 end
 121
 122 class math_view obj = object
 123  inherit math_view_skel (obj : Gtk_mathview.math_view obj)
 124  method connect = new math_view_signals obj
 125 end
 126
 127 let math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width
 128  ?width ?height ?packing ?show () =
 129  let w =
 130    MathView.create
 131     ?adjustmenth:(may_map ~f:GData.as_adjustment adjustmenth)
 132     ?adjustmentv:(may_map ~f:GData.as_adjustment adjustmentv)
 133     ()
 134  in
 135   Container.set w ?border_width ?width ?height;
 136  let mathview = pack_return (new math_view w) ~packing ~show in
 137  begin
 138     match font_size with
 139     | Some size -> mathview#set_font_size size
 140     | None      -> ()
 141   end;
 142   begin
 143     match font_manager with
 144     | Some manager -> mathview#set_font_manager_type ~fm_type:manager
 145     | None         -> ()
 146   end;
 147   mathview
 148 ;;