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 let remove_descendants_of (el : Gdome.element) =
  47  let rec aux =
  48   function
  49      [] -> []
  50    | hd::tl when descendant_of (hd :> Gdome.node) (el :> Gdome.node) -> aux tl
  51    | hd::tl -> hd::(aux tl)
  52  in
  53   aux
  54
  55 (* mem el l = true if the node n is stored in the list l *)
  56 let mem (el : Gdome.element) =
  57  let rec mem_aux =
  58   function
  59      hd::_ when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) -> true
  60    | _::tl -> mem_aux tl
  61    | _ -> false
  62  in
  63   mem_aux
  64
  65 (* remove el l = l' where l' has the same nodes as l except that all
  66  * the occurrences of n have been removed *)
  67 let remove (el : Gdome.element) =
  68  let rec remove_aux =
  69   function
  70      hd::tl when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) -> remove_aux tl
  71    | hd::tl -> hd::(remove_aux tl)
  72    | [] -> []
  73  in
  74   remove_aux
  75
  76 class single_selection_math_view_signals obj (set_selection_changed : (Gdome.element option -> unit) -> unit) =
  77  object
  78   inherit GMathView.math_view_signals obj
  79   method selection_changed = set_selection_changed
  80  end
  81 ;;
  82
  83 class single_selection_math_view obj =
  84   object(self)
  85    inherit GMathView.math_view_skel obj
  86    val mutable first_selected = None
  87    val mutable root_selected = None
  88    val mutable selection_changed = (fun _ -> ())
  89
  90    method set_selection elem =
  91     begin
  92      match root_selected with
  93         None -> ()
  94       | Some e -> self#unselect e
  95     end;
  96     root_selected <- elem;
  97     match elem with
  98        None -> ()
  99      | Some e -> self#select e
 100
 101    method get_selection = root_selected
 102
 103    method connect =
 104     new single_selection_math_view_signals obj (function f -> selection_changed <- f)
 105
 106    method action_toggle (elem : Gdome.element) =
 107     match elem#get_namespaceURI, elem#get_localName with
 108        Some ns, Some ln when ns#to_string = "http://www.w3.org/1998/Math/MathML" &&
 109                              ln#to_string = "maction" ->
 110         begin
 111          let selection_attr = Gdome.domString "selection" in
 112          let selection =
 113           if elem#hasAttribute ~name:selection_attr then
 114            int_of_string (elem#getAttribute ~name:selection_attr)#to_string
 115           else
 116            1
 117          in
 118           self#freeze ;
 119           (* the widget will cast the index back into a valid range *)
 120           elem#setAttribute ~name:selection_attr ~value:(Gdome.domString (string_of_int (selection + 1))) ;
 121           self#thaw ;
 122           true
 123         end
 124      | _ ->
 125         begin
 126          match elem#get_parentNode with
 127             Some p ->
 128              begin
 129               try
 130                self#action_toggle (new Gdome.element_of_node p)
 131               with
 132                GdomeInit.DOMCastException _ -> false
 133              end
 134           | None -> assert false (* every element has a parent *)
 135         end
 136
 137    initializer
 138     ignore
 139      (self#connect#select_begin
 140        (fun (elem : Gdome.element option) _ ->
 141          if not (elem = root_selected) then selection_changed elem ;
 142          first_selected <- elem)) ;
 143
 144     ignore
 145      (self#connect#select_over
 146        (fun (elem : Gdome.element option) _ ->
 147          match first_selected, elem with
 148             None, _
 149           | _, None -> selection_changed None
 150           | Some first', Some last' ->
 151              selection_changed
 152               (Some (new Gdome.element_of_node (common_ancestor (first' :> Gdome.node) (last' :> Gdome.node)))))) ;
 153
 154     ignore
 155      (self#connect#select_end
 156        (fun (elem : Gdome.element option) _ -> first_selected <- None)) ;
 157
 158     ignore
 159      (self#connect#select_abort
 160        (fun () ->
 161          first_selected <- None ;
 162          selection_changed None)) ;
 163
 164    ignore (self#connect#click (fun _ _ -> self#set_selection None))
 165   end
 166 ;;
 167
 168 let single_selection_math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width
 169  ?width ?height ?packing ?show () =
 170  let w =
 171    GtkMathView.MathView.create
 172     ?adjustmenth:(Gaux.may_map ~f:GData.as_adjustment adjustmenth)
 173     ?adjustmentv:(Gaux.may_map ~f:GData.as_adjustment adjustmentv)
 174     ()
 175  in
 176   GtkBase.Container.set w ?border_width ?width ?height;
 177  let mathview = GObj.pack_return (new single_selection_math_view w) ~packing ~show in
 178  begin
 179     match font_size with
 180     | Some size -> mathview#set_font_size size
 181     | None      -> ()
 182   end;
 183   begin
 184     match font_manager with
 185     | Some manager -> mathview#set_font_manager_type ~fm_type:manager
 186     | None         -> ()
 187   end;
 188   mathview
 189 ;;
 190
 191 class multi_selection_math_view_signals obj (set_selection_changed : (Gdome.element option -> unit) -> unit) =
 192  object
 193   inherit GMathView.math_view_signals obj
 194   method selection_changed = set_selection_changed
 195  end
 196 ;;
 197
 198 class multi_selection_math_view obj =
 199   object(self)
 200    inherit single_selection_math_view obj
 201    val mutable selected : Gdome.element list = []
 202
 203    method remove_selection (elem : Gdome.element) =
 204     if mem elem selected then
 205      selected <- remove elem selected ;
 206      self#unselect elem
 207
 208    method remove_selections =
 209     List.iter (fun e -> self#unselect e) selected ;
 210     selected <- [] ;
 211     match self#get_selection with
 212        None -> ()
 213      | Some e -> self#select e
 214
 215    method add_selection (elem : Gdome.element) =
 216     selected <- elem::(remove_descendants_of elem selected) ;
 217     self#select elem
 218
 219    method get_selections = selected
 220
 221    method set_selection elem =
 222     begin
 223      match root_selected with
 224         None -> ()
 225       | Some e -> self#unselect e ; List.iter (fun e -> self#select e) selected
 226     end;
 227     root_selected <- elem;
 228     match elem with
 229        None -> ()
 230      | Some e -> self#select e
 231
 232    initializer
 233     ignore
 234      (self#connect#select_begin
 235        (fun _ state ->
 236          if not (List.mem `CONTROL (Gdk.Convert.modifier state)) then self#remove_selections)) ;
 237
 238     ignore
 239      (self#connect#select_over
 240        (fun _ state ->
 241          Printf.printf "stable selections: %d\n" (List.length selected) ;
 242          Printf.printf "select_over with state: " ;
 243          let c =
 244           function
 245              `SHIFT -> "shift "
 246            | `LOCK -> "lock "
 247            | `CONTROL -> "control "
 248            | `MOD1 -> "mod1 "
 249            | _ -> ""
 250          in
 251           List.iter (fun x -> print_string (c x)) (Gdk.Convert.modifier state) ;
 252           print_char '\n' ;
 253           flush stdout)) ;
 254
 255     ignore
 256      (self#connect#select_end
 257        (fun _ state ->
 258          Printf.printf "select_end\n" ; flush stdout ;
 259          if not (List.mem `CONTROL (Gdk.Convert.modifier state)) then self#remove_selections ;
 260          match root_selected with
 261             None -> ()
 262           | Some e -> self#set_selection None ; self#add_selection e))
 263
 264    end
 265  ;;
 266
 267 let multi_selection_math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width
 268  ?width ?height ?packing ?show () =
 269  let w =
 270    GtkMathView.MathView.create
 271     ?adjustmenth:(Gaux.may_map ~f:GData.as_adjustment adjustmenth)
 272     ?adjustmentv:(Gaux.may_map ~f:GData.as_adjustment adjustmentv)
 273     ()
 274  in
 275   GtkBase.Container.set w ?border_width ?width ?height;
 276  let mathview = GObj.pack_return (new multi_selection_math_view w) ~packing ~show in
 277  begin
 278     match font_size with
 279     | Some size -> mathview#set_font_size size
 280     | None      -> ()
 281   end;
 282   begin
 283     match font_manager with
 284     | Some manager -> mathview#set_font_manager_type ~fm_type:manager
 285     | None         -> ()
 286   end;
 287   mathview
 288 ;;
 289