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