X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtkmathview%2FgMathViewAux.ml;h=45bc5d90ce3a5df474a2d17247e57e0db36e8149;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=9fe2c80a5d782ba2dfc6d95c020c7e53c3d6961d;hpb=e7bcb20821caa3e03bf1b77a7e9f329aeaacab07;p=helm.git diff --git a/helm/DEVEL/lablgtkmathview/gMathViewAux.ml b/helm/DEVEL/lablgtkmathview/gMathViewAux.ml index 9fe2c80a5..45bc5d90c 100644 --- a/helm/DEVEL/lablgtkmathview/gMathViewAux.ml +++ b/helm/DEVEL/lablgtkmathview/gMathViewAux.ml @@ -1,23 +1,27 @@ -(* Copyright (C) 2000, Luca Padovani . +(* Copyright (C) 2000-2005, + * Luca Padovani + * Claudio Sacerdoti Coen + * Stefano Zacchiroli * - * This file is part of lablgtkmathview, the Ocaml binding - * for the GtkMathView widget. + * This file is part of lablgtkmathview, the Ocaml binding for the + * GtkMathView widget. * * lablgtkmathview is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. + * modify it under the terms of the GNU General Public License as + * published by the Free Software Foundation; either version 2 of the + * License, or (at your option) any later version. * * lablgtkmathview is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with lablgtkmathview; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA + * 02111-1307, USA. * - * For details, send a mail to the author. + * For details, send a mail to the authors. *) (* finds the common node ancestor of two nodes *) @@ -35,6 +39,12 @@ let common_ancestor (first : Gdome.node) (last : Gdome.node) = in (last_common (None,(List.rev (path first)),(List.rev (path last)))) +let same_element (e1 : Gdome.element option) (e2 : Gdome.element option) = + match e1, e2 with + None, None -> true + | Some e1, Some e2 when (e1 :> Gdome.node)#isSameNode (e2 :> Gdome.node) -> true + | _ -> false + (* true if n1 is n2 or one of n2's descendants *) let rec descendant_of (n1 : Gdome.node) (n2 : Gdome.node) = if n1#isSameNode n2 then true @@ -43,6 +53,15 @@ let rec descendant_of (n1 : Gdome.node) (n2 : Gdome.node) = None -> false | Some n1' -> descendant_of n1' n2 +let remove_descendants_of (el : Gdome.element) = + let rec aux = + function + [] -> [] + | hd::tl when descendant_of (hd :> Gdome.node) (el :> Gdome.node) -> aux tl + | hd::tl -> hd::(aux tl) + in + aux + (* mem el l = true if the node n is stored in the list l *) let mem (el : Gdome.element) = let rec mem_aux = @@ -58,7 +77,8 @@ let mem (el : Gdome.element) = let remove (el : Gdome.element) = let rec remove_aux = function - hd::tl when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) -> remove_aux tl + hd::tl when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) -> + remove_aux tl | hd::tl -> hd::(remove_aux tl) | [] -> [] in @@ -74,63 +94,114 @@ class single_selection_math_view_signals obj (set_selection_changed : (Gdome.ele class single_selection_math_view obj = object(self) inherit GMathView.math_view_skel obj - val mutable root_selection = None + val mutable first_selected = None + val mutable root_selected = None val mutable selection_changed = (fun _ -> ()) - method set_selection root_selection' = + method set_selection elem = + self#freeze ; begin - match root_selection with + match root_selected with None -> () | Some e -> self#unselect e end; - root_selection <- root_selection'; - match root_selection' with - None -> () - | Some e -> self#select e + root_selected <- elem ; + begin + match elem with + None -> () + | Some e -> self#select e + end ; + self#thaw - method get_selection = root_selection + method get_selection = root_selected method connect = - new single_selection_math_view_signals obj (function f -> selection_changed <- f) + new + single_selection_math_view_signals obj + (function f -> selection_changed <- f) + method action_toggle (elem : Gdome.element) = + match elem#get_namespaceURI, elem#get_localName with + Some ns, Some ln + when + (ns#to_string = "http://www.w3.org/1998/Math/MathML" && ln#to_string = "maction") || + (ns#to_string = "http://helm.cs.unibo.it/2003/BoxML" && ln#to_string = "action") + -> + begin + let selection_attr = Gdome.domString "selection" in + let selection = + if elem#hasAttribute ~name:selection_attr then + int_of_string (elem#getAttribute ~name:selection_attr)#to_string + else + 1 + in + self#freeze ; + (* the widget will cast the index back into a valid range *) + elem#setAttribute ~name:selection_attr + ~value:(Gdome.domString (string_of_int (selection + 1))) ; + self#thaw ; + true + end + | _ -> + begin + match elem#get_parentNode with + Some p -> + begin + try + self#action_toggle (new Gdome.element_of_node p) + with + GdomeInit.DOMCastException _ -> false + end + | None -> assert false (* every element has a parent *) + end + initializer + selection_changed <- self#set_selection ; + + ignore + (self#connect#select_begin + (fun ((elem : Gdome.element option), _, _, _) -> + if not (same_element root_selected elem) then selection_changed elem ; + first_selected <- elem)) ; + + ignore + (self#connect#select_over + (fun ((elem : Gdome.element option), _, _, _) -> + let new_selected = + match first_selected, elem with + Some first', Some last' -> + (Some + (new Gdome.element_of_node + (common_ancestor (first' :> Gdome.node) (last' :> Gdome.node)))) + | _ -> None + in + if not (same_element root_selected new_selected) then + selection_changed new_selected)) ; + + ignore + (self#connect#select_end + (fun ((elem : Gdome.element option), _, _, _) -> first_selected <- None)) ; + ignore - (self#connect#press_move - (fun (first: Gdome.element option) (last: Gdome.element option) -> - match first, last with - None, _ - | _, None -> selection_changed None - | Some first', Some last' -> - selection_changed - (Some (new Gdome.element_of_node (common_ancestor (first' :> Gdome.node) (last' :> Gdome.node)))))) ; - ignore (self#connect#clicked (fun _ -> self#set_selection None)) + (self#connect#select_abort + (fun () -> + first_selected <- None ; + selection_changed None)) ; + + ignore (self#connect#click (fun _ -> self#set_selection None)) end ;; -let single_selection_math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width - ?width ?height ?packing ?show () = - let w = - GtkMathView.MathView.create - ?adjustmenth:(Gaux.may_map ~f:GData.as_adjustment adjustmenth) - ?adjustmentv:(Gaux.may_map ~f:GData.as_adjustment adjustmentv) - () - in - GtkBase.Container.set w ?border_width ?width ?height; - let mathview = GObj.pack_return (new single_selection_math_view w) ~packing ~show in - begin - match font_size with - | Some size -> mathview#set_font_size size - | None -> () - end; - begin - match font_manager with - | Some manager -> mathview#set_font_manager_type ~fm_type:manager - | None -> () - end; - mathview +let single_selection_math_view ?hadjustment ?vadjustment ?font_size ?log_verbosity = + GtkBase.Widget.size_params ~cont:( + OgtkMathViewProps.pack_return + (fun p -> OgtkMathViewProps.set_params (new single_selection_math_view + (GtkMathViewProps.MathView_GMetaDOM.create p)) ~font_size ~log_verbosity)) [] ;; -class multi_selection_math_view_signals obj (set_selection_changed : (Gdome.element option -> unit) -> unit) = +class multi_selection_math_view_signals obj + (set_selection_changed : (Gdome.element option -> unit) -> unit) += object inherit GMathView.math_view_signals obj method selection_changed = set_selection_changed @@ -148,49 +219,63 @@ class multi_selection_math_view obj = self#unselect elem method remove_selections = + self#freeze ; List.iter (fun e -> self#unselect e) selected ; - selected <- [] + selected <- [] ; + begin + match self#get_selection with + None -> () + | Some e -> self#select e + end ; + self#thaw method add_selection (elem : Gdome.element) = - if not (mem elem selected) then - selected <- elem::selected ; - self#select elem + List.iter self#unselect selected ; + selected <- elem::(remove_descendants_of elem selected) ; + List.iter self#select selected method get_selections = selected - method set_selection root_selection' = + method set_selection elem = + self#freeze ; begin - match root_selection with + match root_selected with None -> () | Some e -> self#unselect e ; List.iter (fun e -> self#select e) selected end; - root_selection <- root_selection'; - match root_selection' with - None -> () - | Some e -> self#select e - end -;; + root_selected <- elem; + begin + match elem with + None -> () + | Some e -> self#select e + end ; + self#thaw -let multi_selection_math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width - ?width ?height ?packing ?show () = - let w = - GtkMathView.MathView.create - ?adjustmenth:(Gaux.may_map ~f:GData.as_adjustment adjustmenth) - ?adjustmentv:(Gaux.may_map ~f:GData.as_adjustment adjustmentv) - () - in - GtkBase.Container.set w ?border_width ?width ?height; - let mathview = GObj.pack_return (new multi_selection_math_view w) ~packing ~show in - begin - match font_size with - | Some size -> mathview#set_font_size size - | None -> () - end; - begin - match font_manager with - | Some manager -> mathview#set_font_manager_type ~fm_type:manager - | None -> () - end; - mathview -;; + initializer + ignore + (self#connect#select_begin + (fun (_,_,_,state) -> + if not (List.mem `CONTROL (Gdk.Convert.modifier state)) then + self#remove_selections)) ; + + ignore + (self#connect#select_end + (fun (_,_,_,state) -> + if not (List.mem `CONTROL (Gdk.Convert.modifier state)) then + self#remove_selections ; + match root_selected with + None -> () + | Some e -> self#set_selection None ; self#add_selection e)) ; + ignore + (self#connect#click + (fun _ -> self#remove_selections)) + end + ;; + +let multi_selection_math_view ?hadjustment ?vadjustment ?font_size ?log_verbosity = + GtkBase.Widget.size_params ~cont:( + OgtkMathViewProps.pack_return + (fun p -> OgtkMathViewProps.set_params (new multi_selection_math_view + (GtkMathViewProps.MathView_GMetaDOM.create p)) ~font_size ~log_verbosity)) [] +;;