1 (* Copyright (C) 2000-2003, Luca Padovani <luca.padovani@cs.unibo.it>,
2 * Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>.
4 * This file is part of lablgtkmathview, the Ocaml binding
5 * for the GtkMathView widget.
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.
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.
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.
21 * For details, send a mail to the author.
24 (* finds the common node ancestor of two nodes *)
25 let common_ancestor (first : Gdome.node) (last : Gdome.node) =
27 match n#get_parentNode with
29 | Some p -> n::(path p)
33 _, hd1::tl1, hd2::tl2 when hd1#isSameNode hd2 -> (last_common ((Some hd1),tl1,tl2))
35 | _,_,_ -> assert false
37 (last_common (None,(List.rev (path first)),(List.rev (path last))))
39 let same_element (e1 : Gdome.element option) (e2 : Gdome.element option) =
42 | Some e1, Some e2 when (e1 :> Gdome.node)#isSameNode (e2 :> Gdome.node) -> true
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
49 match n1#get_parentNode with
51 | Some n1' -> descendant_of n1' n2
53 let remove_descendants_of (el : Gdome.element) =
57 | hd::tl when descendant_of (hd :> Gdome.node) (el :> Gdome.node) -> aux tl
58 | hd::tl -> hd::(aux tl)
62 (* mem el l = true if the node n is stored in the list l *)
63 let mem (el : Gdome.element) =
66 hd::_ when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) -> true
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) =
77 hd::tl when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) ->
79 | hd::tl -> hd::(remove_aux tl)
84 class single_selection_math_view_signals obj (set_selection_changed : (Gdome.element option -> unit) -> unit) =
86 inherit GMathView.math_view_signals obj
87 method selection_changed = set_selection_changed
91 class single_selection_math_view obj =
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 _ -> ())
98 method set_selection elem =
101 match root_selected with
103 | Some e -> self#unselect e
105 root_selected <- elem ;
109 | Some e -> self#select e
113 method get_selection = root_selected
117 single_selection_math_view_signals obj
118 (function f -> selection_changed <- f)
120 method action_toggle (elem : Gdome.element) =
121 match elem#get_namespaceURI, elem#get_localName with
123 when ns#to_string = "http://www.w3.org/1998/Math/MathML" &&
124 ln#to_string = "maction"
127 let selection_attr = Gdome.domString "selection" in
129 if elem#hasAttribute ~name:selection_attr then
130 int_of_string (elem#getAttribute ~name:selection_attr)#to_string
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))) ;
143 match elem#get_parentNode with
147 self#action_toggle (new Gdome.element_of_node p)
149 GdomeInit.DOMCastException _ -> false
151 | None -> assert false (* every element has a parent *)
155 selection_changed <- self#set_selection ;
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)) ;
164 (self#connect#select_over
165 (fun (elem : Gdome.element option) _ ->
167 match first_selected, elem with
168 Some first', Some last' ->
170 (new Gdome.element_of_node
171 (common_ancestor (first' :> Gdome.node) (last' :> Gdome.node))))
174 if not (same_element root_selected new_selected) then
175 selection_changed new_selected)) ;
178 (self#connect#select_end
179 (fun (elem : Gdome.element option) _ -> first_selected <- None)) ;
182 (self#connect#select_abort
184 first_selected <- None ;
185 selection_changed None)) ;
187 ignore (self#connect#click (fun _ _ -> self#set_selection None))
191 let single_selection_math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width
192 ?width ?height ?packing ?show () =
194 GtkMathView.MathView.create
195 ?adjustmenth:(Gaux.may_map ~f:GData.as_adjustment adjustmenth)
196 ?adjustmentv:(Gaux.may_map ~f:GData.as_adjustment adjustmentv)
199 GtkBase.Container.set w ?border_width ?width ?height;
201 GObj.pack_return (new single_selection_math_view w) ~packing ~show
205 | Some size -> mathview#set_font_size size
209 match font_manager with
210 | Some manager -> mathview#set_font_manager_type ~fm_type:manager
216 class multi_selection_math_view_signals obj
217 (set_selection_changed : (Gdome.element option -> unit) -> unit)
220 inherit GMathView.math_view_signals obj
221 method selection_changed = set_selection_changed
225 class multi_selection_math_view obj =
227 inherit single_selection_math_view obj
228 val mutable selected : Gdome.element list = []
230 method remove_selection (elem : Gdome.element) =
231 if mem elem selected then
232 selected <- remove elem selected ;
235 method remove_selections =
237 List.iter (fun e -> self#unselect e) selected ;
240 match self#get_selection with
242 | Some e -> self#select e
246 method add_selection (elem : Gdome.element) =
247 selected <- elem::(remove_descendants_of elem selected) ;
250 method get_selections = selected
252 method set_selection elem =
255 match root_selected with
257 | Some e -> self#unselect e ; List.iter (fun e -> self#select e) selected
259 root_selected <- elem;
263 | Some e -> self#select e
269 (self#connect#select_begin
271 if not (List.mem `CONTROL (Gdk.Convert.modifier state)) then
272 self#remove_selections)) ;
275 (self#connect#select_over
277 Printf.printf "stable selections: %d\n" (List.length selected) ;
278 Printf.printf "select_over with state: " ;
283 | `CONTROL -> "control "
287 List.iter (fun x -> print_string (c x)) (Gdk.Convert.modifier state) ;
292 (self#connect#select_end
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
299 | Some e -> self#set_selection None ; self#add_selection e)) ;
303 (fun _ _ -> self#remove_selections))
307 let multi_selection_math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width
308 ?width ?height ?packing ?show () =
310 GtkMathView.MathView.create
311 ?adjustmenth:(Gaux.may_map ~f:GData.as_adjustment adjustmenth)
312 ?adjustmentv:(Gaux.may_map ~f:GData.as_adjustment adjustmentv)
315 GtkBase.Container.set w ?border_width ?width ?height;
316 let mathview = GObj.pack_return (new multi_selection_math_view w) ~packing ~show in
319 | Some size -> mathview#set_font_size size
323 match font_manager with
324 | Some manager -> mathview#set_font_manager_type ~fm_type:manager