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