--- /dev/null
+(* Copyright (C) 2000, Luca Padovani <luca.padovani@cs.unibo.it>.
+ *
+ * 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.
+ *
+ * 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.
+ *
+ * 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.
+ *
+ * For details, send a mail to the author.
+ *)
+
+(* finds the common node ancestor of two nodes *)
+let common_ancestor (first : Gdome.node) (last : Gdome.node) =
+ let rec path n =
+ match n#get_parentNode with
+ None -> [n]
+ | Some p -> n::(path p)
+ in
+ let rec last_common =
+ function
+ _, hd1::tl1, hd2::tl2 when hd1#isSameNode hd2 -> (last_common ((Some hd1),tl1,tl2))
+ | Some e, _, _ -> e
+ | _,_,_ -> assert false
+ in
+ (last_common (None,(List.rev (path first)),(List.rev (path last))))
+
+(* 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
+ else
+ match n1#get_parentNode with
+ None -> false
+ | Some n1' -> descendant_of n1' n2
+
+(* mem el l = true if the node n is stored in the list l *)
+let mem (el : Gdome.element) =
+ let rec mem_aux =
+ function
+ hd::_ when (hd :> Gdome.node)#isSameNode (el :> Gdome.node) -> true
+ | _::tl -> mem_aux tl
+ | _ -> false
+ in
+ mem_aux
+
+(* remove el l = l' where l' has the same nodes as l except that all
+ * the occurrences of n have been removed *)
+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 -> hd::(remove_aux tl)
+ | [] -> []
+ in
+ remove_aux
+
+class single_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
+ end
+;;
+
+class single_selection_math_view obj =
+ object(self)
+ inherit GMathView.math_view_skel obj
+ val mutable root_selection = None
+ val mutable selection_changed = (fun _ -> ())
+
+ method set_selection root_selection' =
+ begin
+ match root_selection with
+ None -> ()
+ | Some e -> self#unselect e
+ end;
+ root_selection <- root_selection';
+ match root_selection' with
+ None -> ()
+ | Some e -> self#select e
+
+ method get_selection = root_selection
+
+ method connect =
+ new single_selection_math_view_signals obj (function f -> selection_changed <- f)
+
+ initializer
+ 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))
+ 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
+;;
+
+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
+ end
+;;
+
+class multi_selection_math_view obj =
+ object(self)
+ inherit single_selection_math_view obj
+ val mutable selected : Gdome.element list = []
+
+ method remove_selection (elem : Gdome.element) =
+ if mem elem selected then
+ selected <- remove elem selected ;
+ self#unselect elem
+
+ method remove_selections =
+ List.iter (fun e -> self#unselect e) selected ;
+ selected <- []
+
+ method add_selection (elem : Gdome.element) =
+ if not (mem elem selected) then
+ selected <- elem::selected ;
+ self#select elem
+
+ method get_selections = selected
+
+ method set_selection root_selection' =
+ begin
+ match root_selection 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
+;;
+
+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
+;;
+
projects / helm.git / blobdiff