helm/DEVEL/lablgtkmathview/gMathViewAux.ml

   1 (* Copyright (C) 2000-2003, Luca Padovani <luca.padovani@cs.unibo.it>,
   2  *                          Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>.
   3  *
   4  * This file is part of lablgtkmathview, the Ocaml binding
   5  * for the GtkMathView widget.
   6  *
   7  * lablgtkmathview is free software; you can redistribute it and/or
   8  * modify it under the terms of the GNU General Public License
   9  * as published by the Free Software Foundation; either version 2
  10  * of the License, or (at your option) any later version.
  11  *
  12  * lablgtkmathview is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with lablgtkmathview; if not, write to the Free Software
  19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  20  *
  21  * For details, send a mail to the author.
  22  *)
  23
  24 (* finds the common node ancestor of two nodes *)
  25 let common_ancestor (first : Gdome.node) (last : Gdome.node) =
  26  let rec path n =
  27   match n#get_parentNode with
  28      None -> [n]
  29    | Some p -> n::(path p)
  30  in
  31   let rec last_common =
  32    function
  33       _, hd1::tl1, hd2::tl2 when hd1#isSameNode hd2 -> (last_common ((Some hd1),tl1,tl2))
  34     | Some e, _, _ -> e
  35     | _,_,_ -> assert false
  36   in
  37    (last_common (None,(List.rev (path first)),(List.rev (path last))))
  38
  39 let same_element (e1 : Gdome.element option) (e2 : Gdome.element option) =
  40  match e1, e2 with
  41     None, None -> true
  42   | Some e1, Some e2 when (e1 :> Gdome.node)#isSameNode (e2 :> Gdome.node) -> true
  43   | _ -> false
  44
  45 (* true if n1 is n2 or one of n2's descendants *)
  46 let rec descendant_of (n1 : Gdome.node) (n2 : Gdome.node) =
  47  if n1#isSameNode n2 then true
  48  else
  49   match n1#get_parentNode with
  50      None -> false
  51    | Some n1' -> descendant_of n1' n2
  52
  53 let remove_descendants_of (el : Gdome.element) =
  54  let rec aux =
  55   function
  56      [] -> []
  57    | hd::tl when descendant_of (hd :> Gdome.node) (el :> Gdome.node) -> aux tl
  58    | hd::tl -> hd::(aux tl)
  59  in
  60   aux
  61
  62 (* mem el l = true if the node n is stored in the list l *)
  63 let mem (el : Gdome.element) =
  64  let rec mem_aux =
  65   function
  66      hd::_ when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) -> true
  67    | _::tl -> mem_aux tl
  68    | _ -> false
  69  in
  70   mem_aux
  71
  72 (* remove el l = l' where l' has the same nodes as l except that all
  73  * the occurrences of n have been removed *)
  74 let remove (el : Gdome.element) =
  75  let rec remove_aux =
  76   function
  77      hd::tl when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) -> remove_aux tl
  78    | hd::tl -> hd::(remove_aux tl)
  79    | [] -> []
  80  in
  81   remove_aux
  82
  83 class single_selection_math_view_signals obj (set_selection_changed : (Gdome.element option -> unit) -> unit) =
  84  object
  85   inherit GMathView.math_view_signals obj
  86   method selection_changed = set_selection_changed
  87  end
  88 ;;
  89
  90 class single_selection_math_view obj =
  91   object(self)
  92    inherit GMathView.math_view_skel obj
  93    val mutable first_selected = None
  94    val mutable root_selected = None
  95    val mutable selection_changed = (fun _ -> ())
  96
  97    method set_selection elem =
  98     begin
  99      match root_selected with
 100         None -> ()
 101       | Some e -> self#unselect e
 102     end;
 103     root_selected <- elem;
 104     match elem with
 105        None -> ()
 106      | Some e -> self#select e
 107
 108    method get_selection = root_selected
 109
 110    method connect =
 111     new single_selection_math_view_signals obj (function f -> selection_changed <- f)
 112
 113    method action_toggle (elem : Gdome.element) =
 114     match elem#get_namespaceURI, elem#get_localName with
 115        Some ns, Some ln when ns#to_string = "http://www.w3.org/1998/Math/MathML" &&
 116                              ln#to_string = "maction" ->
 117         begin
 118          let selection_attr = Gdome.domString "selection" in
 119          let selection =
 120           if elem#hasAttribute ~name:selection_attr then
 121            int_of_string (elem#getAttribute ~name:selection_attr)#to_string
 122           else
 123            1
 124          in
 125           self#freeze ;
 126           (* the widget will cast the index back into a valid range *)
 127           elem#setAttribute ~name:selection_attr ~value:(Gdome.domString (string_of_int (selection + 1))) ;
 128           self#thaw ;
 129           true
 130         end
 131      | _ ->
 132         begin
 133          match elem#get_parentNode with
 134             Some p ->
 135              begin
 136               try
 137                self#action_toggle (new Gdome.element_of_node p)
 138               with
 139                GdomeInit.DOMCastException _ -> false
 140              end
 141           | None -> assert false (* every element has a parent *)
 142         end
 143
 144    initializer
 145     ignore
 146      (self#connect#select_begin
 147        (fun (elem : Gdome.element option) _ ->
 148          if not (same_element root_selected elem) then
 149           begin
 150            self#set_selection elem ;
 151            selection_changed elem
 152           end ;
 153          first_selected <- elem)) ;
 154
 155     ignore
 156      (self#connect#select_over
 157        (fun (elem : Gdome.element option) _ ->
 158          let new_selected =
 159           match first_selected, elem with
 160              Some first', Some last' ->
 161                (Some (new Gdome.element_of_node (common_ancestor (first' :> Gdome.node) (last' :> Gdome.node))))
 162            | _ -> None
 163          in
 164           if not (same_element root_selected new_selected) then
 165            begin
 166             self#set_selection new_selected ;
 167             selection_changed new_selected
 168            end)) ;
 169
 170     ignore
 171      (self#connect#select_end
 172        (fun (elem : Gdome.element option) _ -> first_selected <- None)) ;
 173
 174     ignore
 175      (self#connect#select_abort
 176        (fun () ->
 177          first_selected <- None ;
 178          selection_changed None)) ;
 179
 180    ignore (self#connect#click (fun _ _ -> self#set_selection None))
 181   end
 182 ;;
 183
 184 let single_selection_math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width
 185  ?width ?height ?packing ?show () =
 186  let w =
 187    GtkMathView.MathView.create
 188     ?adjustmenth:(Gaux.may_map ~f:GData.as_adjustment adjustmenth)
 189     ?adjustmentv:(Gaux.may_map ~f:GData.as_adjustment adjustmentv)
 190     ()
 191  in
 192   GtkBase.Container.set w ?border_width ?width ?height;
 193  let mathview = GObj.pack_return (new single_selection_math_view w) ~packing ~show in
 194  begin
 195     match font_size with
 196     | Some size -> mathview#set_font_size size
 197     | None      -> ()
 198   end;
 199   begin
 200     match font_manager with
 201     | Some manager -> mathview#set_font_manager_type ~fm_type:manager
 202     | None         -> ()
 203   end;
 204   mathview
 205 ;;
 206
 207 class multi_selection_math_view_signals obj (set_selection_changed : (Gdome.element option -> unit) -> unit) =
 208  object
 209   inherit GMathView.math_view_signals obj
 210   method selection_changed = set_selection_changed
 211  end
 212 ;;
 213
 214 class multi_selection_math_view obj =
 215   object(self)
 216    inherit single_selection_math_view obj
 217    val mutable selected : Gdome.element list = []
 218
 219    method remove_selection (elem : Gdome.element) =
 220     if mem elem selected then
 221      selected <- remove elem selected ;
 222      self#unselect elem
 223
 224    method remove_selections =
 225     List.iter (fun e -> self#unselect e) selected ;
 226     selected <- [] ;
 227     match self#get_selection with
 228        None -> ()
 229      | Some e -> self#select e
 230
 231    method add_selection (elem : Gdome.element) =
 232     selected <- elem::(remove_descendants_of elem selected) ;
 233     self#select elem
 234
 235    method get_selections = selected
 236
 237    method set_selection elem =
 238     begin
 239      match root_selected with
 240         None -> ()
 241       | Some e -> self#unselect e ; List.iter (fun e -> self#select e) selected
 242     end;
 243     root_selected <- elem;
 244     match elem with
 245        None -> ()
 246      | Some e -> self#select e
 247
 248    initializer
 249     ignore
 250      (self#connect#select_begin
 251        (fun _ state ->
 252          if not (List.mem `CONTROL (Gdk.Convert.modifier state)) then self#remove_selections)) ;
 253
 254     ignore
 255      (self#connect#select_over
 256        (fun _ state ->
 257          Printf.printf "stable selections: %d\n" (List.length selected) ;
 258          Printf.printf "select_over with state: " ;
 259          let c =
 260           function
 261              `SHIFT -> "shift "
 262            | `LOCK -> "lock "
 263            | `CONTROL -> "control "
 264            | `MOD1 -> "mod1 "
 265            | _ -> ""
 266          in
 267           List.iter (fun x -> print_string (c x)) (Gdk.Convert.modifier state) ;
 268           print_char '\n' ;
 269           flush stdout)) ;
 270
 271     ignore
 272      (self#connect#select_end
 273        (fun _ state ->
 274          Printf.printf "select_end\n" ; flush stdout ;
 275          if not (List.mem `CONTROL (Gdk.Convert.modifier state)) then self#remove_selections ;
 276          match root_selected with
 277             None -> ()
 278           | Some e -> self#set_selection None ; self#add_selection e)) ;
 279
 280     ignore
 281      (self#connect#click
 282        (fun _ _ -> self#remove_selections))
 283    end
 284  ;;
 285
 286 let multi_selection_math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width
 287  ?width ?height ?packing ?show () =
 288  let w =
 289    GtkMathView.MathView.create
 290     ?adjustmenth:(Gaux.may_map ~f:GData.as_adjustment adjustmenth)
 291     ?adjustmentv:(Gaux.may_map ~f:GData.as_adjustment adjustmentv)
 292     ()
 293  in
 294   GtkBase.Container.set w ?border_width ?width ?height;
 295  let mathview = GObj.pack_return (new multi_selection_math_view w) ~packing ~show in
 296  begin
 297     match font_size with
 298     | Some size -> mathview#set_font_size size
 299     | None      -> ()
 300   end;
 301   begin
 302     match font_manager with
 303     | Some manager -> mathview#set_font_manager_type ~fm_type:manager
 304     | None         -> ()
 305   end;
 306   mathview
 307 ;;
 308