helm/DEVEL/lablgtkmathview/gMathViewAux.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 (* finds the common node ancestor of two nodes *)
  24 let common_ancestor (first : Gdome.node) (last : Gdome.node) =
  25  let rec path n =
  26   match n#get_parentNode with
  27      None -> [n]
  28    | Some p -> n::(path p)
  29  in
  30   let rec last_common =
  31    function
  32       _, hd1::tl1, hd2::tl2 when hd1#isSameNode hd2 -> (last_common ((Some hd1),tl1,tl2))
  33     | Some e, _, _ -> e
  34     | _,_,_ -> assert false
  35   in
  36    (last_common (None,(List.rev (path first)),(List.rev (path last))))
  37
  38 (* true if n1 is n2 or one of n2's descendants *)
  39 let rec descendant_of (n1 : Gdome.node) (n2 : Gdome.node) =
  40  if n1#isSameNode n2 then true
  41  else
  42   match n1#get_parentNode with
  43      None -> false
  44    | Some n1' -> descendant_of n1' n2
  45
  46 (* mem el l = true if the node n is stored in the list l *)
  47 let mem (el : Gdome.element) =
  48  let rec mem_aux =
  49   function
  50      hd::_ when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) -> true
  51    | _::tl -> mem_aux tl
  52    | _ -> false
  53  in
  54   mem_aux
  55
  56 (* remove el l = l' where l' has the same nodes as l except that all
  57  * the occurrences of n have been removed *)
  58 let remove (el : Gdome.element) =
  59  let rec remove_aux =
  60   function
  61      hd::tl when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) -> remove_aux tl
  62    | hd::tl -> hd::(remove_aux tl)
  63    | [] -> []
  64  in
  65   remove_aux
  66
  67 class single_selection_math_view_signals obj (set_selection_changed : (Gdome.element option -> unit) -> unit) =
  68  object
  69   inherit GMathView.math_view_signals obj
  70   method selection_changed = set_selection_changed
  71  end
  72 ;;
  73
  74 class single_selection_math_view obj =
  75   object(self)
  76    inherit GMathView.math_view_skel obj
  77    val mutable root_selection = None
  78    val mutable selection_changed = (fun _ -> ())
  79
  80    method set_selection root_selection' =
  81     begin
  82      match root_selection with
  83         None -> ()
  84       | Some e -> self#unselect e
  85     end;
  86     root_selection <- root_selection';
  87     match root_selection' with
  88        None -> ()
  89      | Some e -> self#select e
  90
  91    method get_selection = root_selection
  92
  93    method connect =
  94     new single_selection_math_view_signals obj (function f -> selection_changed <- f)
  95
  96    initializer
  97     ignore
  98      (self#connect#press_move
  99        (fun (first: Gdome.element option) (last: Gdome.element option) ->
 100          match first, last with
 101             None, _
 102           | _, None -> selection_changed None
 103           | Some first', Some last' ->
 104              selection_changed
 105               (Some (new Gdome.element_of_node (common_ancestor (first' :> Gdome.node) (last' :> Gdome.node)))))) ;
 106     ignore (self#connect#clicked (fun _ -> self#set_selection None))
 107   end
 108 ;;
 109
 110 let single_selection_math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width
 111  ?width ?height ?packing ?show () =
 112  let w =
 113    GtkMathView.MathView.create
 114     ?adjustmenth:(Gaux.may_map ~f:GData.as_adjustment adjustmenth)
 115     ?adjustmentv:(Gaux.may_map ~f:GData.as_adjustment adjustmentv)
 116     ()
 117  in
 118   GtkBase.Container.set w ?border_width ?width ?height;
 119  let mathview = GObj.pack_return (new single_selection_math_view w) ~packing ~show in
 120  begin
 121     match font_size with
 122     | Some size -> mathview#set_font_size size
 123     | None      -> ()
 124   end;
 125   begin
 126     match font_manager with
 127     | Some manager -> mathview#set_font_manager_type ~fm_type:manager
 128     | None         -> ()
 129   end;
 130   mathview
 131 ;;
 132
 133 class multi_selection_math_view_signals obj (set_selection_changed : (Gdome.element option -> unit) -> unit) =
 134  object
 135   inherit GMathView.math_view_signals obj
 136   method selection_changed = set_selection_changed
 137  end
 138 ;;
 139
 140 class multi_selection_math_view obj =
 141   object(self)
 142    inherit single_selection_math_view obj
 143    val mutable selected : Gdome.element list = []
 144
 145    method remove_selection (elem : Gdome.element) =
 146     if mem elem selected then
 147      selected <- remove elem selected ;
 148      self#unselect elem
 149
 150    method remove_selections =
 151     List.iter (fun e -> self#unselect e) selected ;
 152     selected <- []
 153
 154    method add_selection (elem : Gdome.element) =
 155     if not (mem elem selected) then
 156      selected <- elem::selected ;
 157      self#select elem
 158
 159    method get_selections = selected
 160
 161    method set_selection root_selection' =
 162     begin
 163      match root_selection with
 164         None -> ()
 165       | Some e -> self#unselect e ; List.iter (fun e -> self#select e) selected
 166     end;
 167     root_selection <- root_selection';
 168     match root_selection' with
 169        None -> ()
 170      | Some e -> self#select e
 171   end
 172 ;;
 173
 174 let multi_selection_math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width
 175  ?width ?height ?packing ?show () =
 176  let w =
 177    GtkMathView.MathView.create
 178     ?adjustmenth:(Gaux.may_map ~f:GData.as_adjustment adjustmenth)
 179     ?adjustmentv:(Gaux.may_map ~f:GData.as_adjustment adjustmentv)
 180     ()
 181  in
 182   GtkBase.Container.set w ?border_width ?width ?height;
 183  let mathview = GObj.pack_return (new multi_selection_math_view w) ~packing ~show in
 184  begin
 185     match font_size with
 186     | Some size -> mathview#set_font_size size
 187     | None      -> ()
 188   end;
 189   begin
 190     match font_manager with
 191     | Some manager -> mathview#set_font_manager_type ~fm_type:manager
 192     | None         -> ()
 193   end;
 194   mathview
 195 ;;
 196