1 (* Copyright (C) 2000, Luca Padovani <luca.padovani@cs.unibo.it>.
3 * This file is part of lablgtkmathview, the Ocaml binding
4 * for the GtkMathView widget.
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.
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.
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.
20 * For details, send a mail to the author.
23 (* finds the common node ancestor of two nodes *)
24 let common_ancestor (first : Gdome.node) (last : Gdome.node) =
26 match n#get_parentNode with
28 | Some p -> n::(path p)
32 _, hd1::tl1, hd2::tl2 when hd1#isSameNode hd2 -> (last_common ((Some hd1),tl1,tl2))
34 | _,_,_ -> assert false
36 (last_common (None,(List.rev (path first)),(List.rev (path last))))
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
42 match n1#get_parentNode with
44 | Some n1' -> descendant_of n1' n2
46 let remove_descendants_of (el : Gdome.element) =
50 | hd::tl when descendant_of (hd :> Gdome.node) (el :> Gdome.node) -> aux tl
51 | hd::tl -> hd::(aux tl)
55 (* mem el l = true if the node n is stored in the list l *)
56 let mem (el : Gdome.element) =
59 hd::_ when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) -> true
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) =
70 hd::tl when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) -> remove_aux tl
71 | hd::tl -> hd::(remove_aux tl)
76 class single_selection_math_view_signals obj (set_selection_changed : (Gdome.element option -> unit) -> unit) =
78 inherit GMathView.math_view_signals obj
79 method selection_changed = set_selection_changed
83 class single_selection_math_view obj =
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 _ -> ())
90 method set_selection elem =
92 match root_selected with
94 | Some e -> self#unselect e
96 root_selected <- elem;
99 | Some e -> self#select e
101 method get_selection = root_selected
104 new single_selection_math_view_signals obj (function f -> selection_changed <- f)
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" ->
111 let selection_attr = Gdome.domString "selection" in
113 if elem#hasAttribute ~name:selection_attr then
114 int_of_string (elem#getAttribute ~name:selection_attr)#to_string
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))) ;
126 match elem#get_parentNode with
130 self#action_toggle (new Gdome.element_of_node p)
132 GdomeInit.DOMCastException _ -> false
134 | None -> assert false (* every element has a parent *)
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)) ;
145 (self#connect#select_over
146 (fun (elem : Gdome.element option) _ ->
147 match first_selected, elem with
149 | _, None -> selection_changed None
150 | Some first', Some last' ->
152 (Some (new Gdome.element_of_node (common_ancestor (first' :> Gdome.node) (last' :> Gdome.node)))))) ;
155 (self#connect#select_end
156 (fun (elem : Gdome.element option) _ -> first_selected <- None)) ;
159 (self#connect#select_abort
161 first_selected <- None ;
162 selection_changed None)) ;
164 ignore (self#connect#click (fun _ _ -> self#set_selection None))
168 let single_selection_math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width
169 ?width ?height ?packing ?show () =
171 GtkMathView.MathView.create
172 ?adjustmenth:(Gaux.may_map ~f:GData.as_adjustment adjustmenth)
173 ?adjustmentv:(Gaux.may_map ~f:GData.as_adjustment adjustmentv)
176 GtkBase.Container.set w ?border_width ?width ?height;
177 let mathview = GObj.pack_return (new single_selection_math_view w) ~packing ~show in
180 | Some size -> mathview#set_font_size size
184 match font_manager with
185 | Some manager -> mathview#set_font_manager_type ~fm_type:manager
191 class multi_selection_math_view_signals obj (set_selection_changed : (Gdome.element option -> unit) -> unit) =
193 inherit GMathView.math_view_signals obj
194 method selection_changed = set_selection_changed
198 class multi_selection_math_view obj =
200 inherit single_selection_math_view obj
201 val mutable selected : Gdome.element list = []
203 method remove_selection (elem : Gdome.element) =
204 if mem elem selected then
205 selected <- remove elem selected ;
208 method remove_selections =
209 List.iter (fun e -> self#unselect e) selected ;
211 match self#get_selection with
213 | Some e -> self#select e
215 method add_selection (elem : Gdome.element) =
216 selected <- elem::(remove_descendants_of elem selected) ;
219 method get_selections = selected
221 method set_selection elem =
223 match root_selected with
225 | Some e -> self#unselect e ; List.iter (fun e -> self#select e) selected
227 root_selected <- elem;
230 | Some e -> self#select e
234 (self#connect#select_begin
236 if not (List.mem `CONTROL (Gdk.Convert.modifier state)) then self#remove_selections)) ;
239 (self#connect#select_over
241 Printf.printf "stable selections: %d\n" (List.length selected) ;
242 Printf.printf "select_over with state: " ;
247 | `CONTROL -> "control "
251 List.iter (fun x -> print_string (c x)) (Gdk.Convert.modifier state) ;
256 (self#connect#select_end
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
262 | Some e -> self#set_selection None ; self#add_selection e))
267 let multi_selection_math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width
268 ?width ?height ?packing ?show () =
270 GtkMathView.MathView.create
271 ?adjustmenth:(Gaux.may_map ~f:GData.as_adjustment adjustmenth)
272 ?adjustmentv:(Gaux.may_map ~f:GData.as_adjustment adjustmentv)
275 GtkBase.Container.set w ?border_width ?width ?height;
276 let mathview = GObj.pack_return (new multi_selection_math_view w) ~packing ~show in
279 | Some size -> mathview#set_font_size size
283 match font_manager with
284 | Some manager -> mathview#set_font_manager_type ~fm_type:manager