From e7bcb20821caa3e03bf1b77a7e9f329aeaacab07 Mon Sep 17 00:00:00 2001 From: Luca Padovani Date: Thu, 23 Jan 2003 16:14:40 +0000 Subject: [PATCH] * restored binding with gtkmathview 0.4.0 * added compatibility class for single selection and gtkmathview * added prototype of multiple selection gtkmathview (likely to change) --- helm/DEVEL/lablgtkmathview/.depend | 5 + helm/DEVEL/lablgtkmathview/Makefile.in | 8 +- helm/DEVEL/lablgtkmathview/configure.in | 4 +- helm/DEVEL/lablgtkmathview/gMathView.ml | 63 +++--- helm/DEVEL/lablgtkmathview/gMathView.mli | 35 ++-- helm/DEVEL/lablgtkmathview/gMathViewAux.ml | 196 +++++++++++++++++++ helm/DEVEL/lablgtkmathview/gMathViewAux.mli | 74 +++++++ helm/DEVEL/lablgtkmathview/gtkMathView.ml | 54 +++-- helm/DEVEL/lablgtkmathview/ml_gtk_mathview.c | 20 +- helm/DEVEL/lablgtkmathview/test/Makefile.in | 2 +- helm/DEVEL/lablgtkmathview/test/test.ml | 92 ++++++--- 11 files changed, 432 insertions(+), 121 deletions(-) create mode 100644 helm/DEVEL/lablgtkmathview/gMathViewAux.ml create mode 100644 helm/DEVEL/lablgtkmathview/gMathViewAux.mli diff --git a/helm/DEVEL/lablgtkmathview/.depend b/helm/DEVEL/lablgtkmathview/.depend index 3edb819d0..9d1c6ed82 100644 --- a/helm/DEVEL/lablgtkmathview/.depend +++ b/helm/DEVEL/lablgtkmathview/.depend @@ -1,5 +1,10 @@ gMathView.cmo: gtkMathView.cmo gtk_mathview.cmo gMathView.cmi gMathView.cmx: gtkMathView.cmx gtk_mathview.cmx gMathView.cmi +gMathViewAux.cmo: gMathView.cmi gtkMathView.cmo gtk_mathview.cmo \ + gMathViewAux.cmi +gMathViewAux.cmx: gMathView.cmx gtkMathView.cmx gtk_mathview.cmx \ + gMathViewAux.cmi gtkMathView.cmo: gtk_mathview.cmo gtkMathView.cmx: gtk_mathview.cmx gMathView.cmi: gtk_mathview.cmo +gMathViewAux.cmi: gMathView.cmi diff --git a/helm/DEVEL/lablgtkmathview/Makefile.in b/helm/DEVEL/lablgtkmathview/Makefile.in index bae76cfa9..2d0a519ea 100644 --- a/helm/DEVEL/lablgtkmathview/Makefile.in +++ b/helm/DEVEL/lablgtkmathview/Makefile.in @@ -3,11 +3,11 @@ VERSION = @VERSION@ INCLUDEDIR = @OCAML_INCLUDE_DIR@ PREFIX = OBJECTS_C = ml_gtk_mathview.o -OBJECTS = gtk_mathview.cmo gtkMathView.cmo gMathView.cmo -OBJECTS_OPT = gtkMathView.cmx gtk_mathview.cmx gMathView.cmx -INST = META gMathView.mli gMathView.cmi gtkMathView.cmi gtk_mathview.cmi +OBJECTS = gtk_mathview.cmo gtkMathView.cmo gMathView.cmo gMathViewAux.cmo +OBJECTS_OPT = gtkMathView.cmx gtk_mathview.cmx gMathView.cmx gMathViewAux.cmx +INST = META gMathView.mli gMathView.cmi gtkMathView.cmi gtk_mathview.cmi gMathViewAux.cmi DIST_FILES = \ - Makefile.in configure.in gMathView.ml gMathView.mli gtkMathView.ml \ + Makefile.in configure.in gMathView.ml gMathView.mli gMathViewAux.ml gtkMathView.ml \ gtk_mathview.ml ml_gtk_mathview.c META.in .depend debian/ test/ \ configure lablgtkmathview.spec lablgtkmathview.spec.in DIST_DIR = $(PACKAGE)-$(VERSION) diff --git a/helm/DEVEL/lablgtkmathview/configure.in b/helm/DEVEL/lablgtkmathview/configure.in index ad50a9ad1..c1cbfeb5b 100644 --- a/helm/DEVEL/lablgtkmathview/configure.in +++ b/helm/DEVEL/lablgtkmathview/configure.in @@ -3,8 +3,8 @@ AC_INIT(gMathView.ml) PACKAGE=lablgtkmathview LABLGTKMATHVIEW_MAJOR_VERSION=0 -LABLGTKMATHVIEW_MINOR_VERSION=3 -LABLGTKMATHVIEW_MICRO_VERSION=1 +LABLGTKMATHVIEW_MINOR_VERSION=4 +LABLGTKMATHVIEW_MICRO_VERSION=0 LABLGTKMATHVIEW_VERSION=$LABLGTKMATHVIEW_MAJOR_VERSION.$LABLGTKMATHVIEW_MINOR_VERSION.$LABLGTKMATHVIEW_MICRO_VERSION VERSION=$LABLGTKMATHVIEW_VERSION diff --git a/helm/DEVEL/lablgtkmathview/gMathView.ml b/helm/DEVEL/lablgtkmathview/gMathView.ml index 405962046..646d68b0a 100644 --- a/helm/DEVEL/lablgtkmathview/gMathView.ml +++ b/helm/DEVEL/lablgtkmathview/gMathView.ml @@ -45,17 +45,23 @@ class math_view_signals obj = object S.marshaller = new_marshaller } in GtkSignal.connect ~sgn:new_clicked obj ~after - method selection_changed = + method press_move = let module S = GtkSignal in - let new_selection_changed = + let new_press_move = let new_marshaller f x y = - MathView.Signals.selection_changed.S.marshaller - (function None -> f None | Some e -> f (Some (new Gdome.element e))) x y + MathView.Signals.press_move.S.marshaller + (fun x y -> + let option_element_of_option v = + match v with + None -> None + | Some v' -> Some (new Gdome.element v') + in + f (option_element_of_option x) (option_element_of_option y)) x y in - { S.name = "selection_changed"; S.classe = `math_view; + { S.name = "press_move"; S.classe = `math_view; S.marshaller = new_marshaller } in - GtkSignal.connect ~sgn:new_selection_changed obj ~after + GtkSignal.connect ~sgn:new_press_move obj ~after method element_changed = let module S = GtkSignal in let new_element_changed = @@ -69,26 +75,19 @@ class math_view_signals obj = object GtkSignal.connect ~sgn:new_element_changed obj ~after end -class math_view obj = object +class math_view_skel obj = object inherit GContainer.container (obj : Gtk_mathview.math_view obj) - method connect = new math_view_signals obj - method load ~filename = - if not (MathView.load obj ~filename) then raise (ErrorLoadingFile filename) - method load_tree ~dom = - if not (MathView.load_tree obj ~dom:((dom : Gdome.document)#as_Document)) then + method freeze = MathView.freeze obj + method thaw = MathView.thaw obj + method load_uri ~filename = + if not (MathView.load_uri obj ~filename) then raise (ErrorLoadingFile filename) + method load_doc ~dom = + if not (MathView.load_doc obj ~dom:((dom : Gdome.document)#as_Document)) then raise ErrorLoadingDOM method unload = MathView.unload obj - method get_selection = - match MathView.get_selection obj with - None -> None - | Some element -> Some (new Gdome.element element) - method set_selection element = - let element = - match element with - None -> None - | Some element -> Some ((element : Gdome.element)#as_Element) - in - MathView.set_selection obj element + method select element = MathView.select obj ((element : Gdome.element)#as_Element) + method unselect element = MathView.unselect obj ((element : Gdome.element)#as_Element) + method is_selected element = MathView.is_selected obj ((element : Gdome.element)#as_Element) method get_width = MathView.get_width obj method get_height = MathView.get_height obj method get_top = MathView.get_top obj @@ -105,8 +104,6 @@ class math_view obj = object method get_font_size = MathView.get_font_size obj method set_anti_aliasing = MathView.set_anti_aliasing obj method get_anti_aliasing = MathView.get_anti_aliasing obj - method set_kerning = MathView.set_kerning obj - method get_kerning = MathView.get_kerning obj method set_transparency = MathView.set_transparency obj method get_transparency = MathView.get_transparency obj method set_log_verbosity = MathView.set_log_verbosity obj @@ -120,17 +117,11 @@ class math_view obj = object if not result then raise (ErrorWritingFile filename) method get_font_manager_type = MathView.get_font_manager_type obj method set_font_manager_type ~fm_type = MathView.set_font_manager_type obj ~fm_type - method get_element = - match MathView.get_element obj with - None -> None - | Some element -> Some (new Gdome.element element) - method action_get_selected = MathView.action_get_selected obj - method action_set_selected = MathView.action_set_selected obj - method get_action = - match MathView.get_action obj with - None -> None - | Some ac -> Some (new Gdome.element ac) - method action_toggle = MathView.action_toggle obj +end + +class math_view obj = object + inherit math_view_skel (obj : Gtk_mathview.math_view obj) + method connect = new math_view_signals obj end let math_view ?adjustmenth ?adjustmentv ?font_size ?font_manager ?border_width diff --git a/helm/DEVEL/lablgtkmathview/gMathView.mli b/helm/DEVEL/lablgtkmathview/gMathView.mli index 4f5f0d4e2..0c380ad60 100644 --- a/helm/DEVEL/lablgtkmathview/gMathView.mli +++ b/helm/DEVEL/lablgtkmathview/gMathView.mli @@ -24,6 +24,7 @@ exception ErrorLoadingFile of string exception ErrorWritingFile of string exception ErrorLoadingDOM exception NoSelection + class math_view_signals : ([> `container | `widget | `base | `math_view] as 'b) Gtk.obj -> object ('a) @@ -32,54 +33,58 @@ class math_view_signals : method clicked : callback:(Gdome.element -> unit) -> GtkSignal.id method element_changed : callback:(Gdome.element option -> unit) -> GtkSignal.id - method selection_changed : - callback:(Gdome.element option -> unit) -> GtkSignal.id + method press_move : + callback:(Gdome.element option -> Gdome.element option -> unit) -> GtkSignal.id end -class math_view : + +class math_view_skel : (Gtk_mathview.math_view Gtk.obj as 'a)-> object inherit GContainer.container - method action_get_selected : int - method action_set_selected : int -> unit - method action_toggle : unit - method connect : math_view_signals + method freeze : unit + method thaw : unit method export_to_postscript : ?width:int -> ?height:int -> ?x_margin:int -> ?y_margin:int -> ?disable_colors:bool -> filename:string -> unit -> unit - method get_action : Gdome.element option method get_anti_aliasing : bool method get_buffer : Gdk.pixmap - method get_element : Gdome.element option method get_font_manager_type : [ `font_manager_gtk | `font_manager_t1] method get_font_size : int method get_frame : GBin.frame method get_hadjustment : GData.adjustment method get_height : int - method get_kerning : bool method get_log_verbosity : int - method get_selection : Gdome.element option method get_top : int * int method get_transparency : bool method get_vadjustment : GData.adjustment method get_width : int - method load : filename:string -> unit - method load_tree : dom:Gdome.document -> unit + method load_uri : filename:string -> unit + method load_doc : dom:Gdome.document -> unit method set_adjustments : GData.adjustment -> GData.adjustment -> unit method set_anti_aliasing : bool -> unit method set_font_manager_type : fm_type:[ `font_manager_gtk | `font_manager_t1] -> unit method set_font_size : int -> unit - method set_kerning : bool -> unit method set_log_verbosity : int -> unit - method set_selection : Gdome.element option -> unit + method select : Gdome.element -> unit + method unselect : Gdome.element -> unit + method is_selected : Gdome.element -> bool method set_top : int -> int -> unit method set_transparency : bool -> unit method unload : unit val obj : 'a end + +class math_view : + Gtk_mathview.math_view Gtk.obj -> + object + inherit math_view_skel + method connect : math_view_signals + end + val math_view : ?adjustmenth:GData.adjustment -> ?adjustmentv:GData.adjustment -> diff --git a/helm/DEVEL/lablgtkmathview/gMathViewAux.ml b/helm/DEVEL/lablgtkmathview/gMathViewAux.ml new file mode 100644 index 000000000..9fe2c80a5 --- /dev/null +++ b/helm/DEVEL/lablgtkmathview/gMathViewAux.ml @@ -0,0 +1,196 @@ +(* Copyright (C) 2000, Luca Padovani . + * + * 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 +;; + diff --git a/helm/DEVEL/lablgtkmathview/gMathViewAux.mli b/helm/DEVEL/lablgtkmathview/gMathViewAux.mli new file mode 100644 index 000000000..a5aabcfb4 --- /dev/null +++ b/helm/DEVEL/lablgtkmathview/gMathViewAux.mli @@ -0,0 +1,74 @@ +(* Copyright (C) 2000, Luca Padovani . + * + * 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. + *) + +class single_selection_math_view_signals : + ([> `container | `widget | `base | `math_view] as 'b) Gtk.obj -> + ((Gdome.element option -> unit) -> unit) -> + object + inherit GMathView.math_view_signals + method selection_changed : (Gdome.element_of_node option -> unit) -> unit + end + +class single_selection_math_view : + Gtk_mathview.math_view Gtk.obj -> + object + inherit GMathView.math_view_skel + method connect : single_selection_math_view_signals + method get_selection : Gdome.element option + method set_selection : Gdome.element option -> unit + end + +val single_selection_math_view : + ?adjustmenth:GData.adjustment -> + ?adjustmentv:GData.adjustment -> + ?font_size:int -> + ?font_manager:[ `font_manager_gtk | `font_manager_t1] -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(GObj.widget -> unit) -> + ?show:bool -> + unit -> single_selection_math_view + +class multi_selection_math_view : + Gtk_mathview.math_view Gtk.obj -> + object + inherit single_selection_math_view + method remove_selection : Gdome.element -> unit + method remove_selections : unit + method add_selection : Gdome.element -> unit + method get_selections : Gdome.element list + end + +val multi_selection_math_view : + ?adjustmenth:GData.adjustment -> + ?adjustmentv:GData.adjustment -> + ?font_size:int -> + ?font_manager:[ `font_manager_gtk | `font_manager_t1] -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(GObj.widget -> unit) -> + ?show:bool -> + unit -> multi_selection_math_view + + diff --git a/helm/DEVEL/lablgtkmathview/gtkMathView.ml b/helm/DEVEL/lablgtkmathview/gtkMathView.ml index 5d400bc59..ef2df0722 100644 --- a/helm/DEVEL/lablgtkmathview/gtkMathView.ml +++ b/helm/DEVEL/lablgtkmathview/gtkMathView.ml @@ -42,17 +42,25 @@ module MathView = struct math_view obj = "ml_gtk_math_view_new" let create ~adjustmenth ~adjustmentv () = create (optboxed adjustmenth) (optboxed adjustmentv) - external load : [>`math_view] obj -> filename:string -> bool = - "ml_gtk_math_view_load" - external load_tree : [>`math_view] obj -> dom:[> `Document] GdomeT.t -> bool = - "ml_gtk_math_view_load_tree" + external freeze : [>`math_view] obj -> unit = + "ml_gtk_math_view_freeze" + external thaw : [>`math_view] obj -> unit = + "ml_gtk_math_view_thaw" + external load_uri : [>`math_view] obj -> filename:string -> bool = + "ml_gtk_math_view_load_uri" + external load_doc : [>`math_view] obj -> dom:[> `Document] GdomeT.t -> bool = + "ml_gtk_math_view_load_doc" external unload : [>`math_view] obj -> unit = "ml_gtk_math_view_unload" - external get_selection : [>`math_view] obj -> TElement.t option = - "ml_gtk_math_view_get_selection" - external set_selection : - [>`math_view] obj -> [> `Element] GdomeT.t option -> unit= - "ml_gtk_math_view_set_selection" + external select : + [>`math_view] obj -> [> `Element] GdomeT.t -> unit = + "ml_gtk_math_view_select" + external unselect : + [>`math_view] obj -> [> `Element] GdomeT.t -> unit = + "ml_gtk_math_view_unselect" + external is_selected : + [>`math_view] obj -> [> `Element] GdomeT.t -> bool = + "ml_gtk_math_view_is_selected" external get_width : [>`math_view] obj -> int = "ml_gtk_math_view_get_width" external get_height : [>`math_view] obj -> int = @@ -79,10 +87,6 @@ module MathView = struct "ml_gtk_math_view_set_anti_aliasing" external get_anti_aliasing : [>`math_view] obj -> bool = "ml_gtk_math_view_get_anti_aliasing" - external set_kerning : [>`math_view] obj -> bool -> unit = - "ml_gtk_math_view_set_kerning" - external get_kerning : [>`math_view] obj -> bool = - "ml_gtk_math_view_get_kerning" external set_transparency : [>`math_view] obj -> bool -> unit = "ml_gtk_math_view_set_transparency" external get_transparency : [>`math_view] obj -> bool = @@ -100,16 +104,6 @@ module MathView = struct external set_font_manager_type : [>`math_view] obj -> fm_type:[`font_manager_gtk | `font_manager_t1] -> unit = "ml_gtk_math_view_set_font_manager_type" - external get_element : [>`math_view] obj -> TElement.t option = - "ml_gtk_math_view_get_element" - external action_get_selected : [>`math_view] obj -> int = - "ml_gtk_math_view_action_get_selected" - external action_set_selected : [>`math_view] obj -> int -> unit = - "ml_gtk_math_view_action_set_selected" - external get_action : [>`math_view] obj -> TElement.t option = - "ml_gtk_math_view_get_action" - external action_toggle : [>`math_view] obj -> unit = - "ml_gtk_math_view_action_toggle" module Signals = struct open GtkSignal @@ -122,14 +116,16 @@ module MathView = struct in { name = "clicked"; classe = `math_view; marshaller = marshal_clicked } - let selection_changed : ([>`math_view],_) t = - let marshal_selection_changed f _ = + let press_move : ([>`math_view],_) t = + let marshal_press_move f _ = function - [GtkArgv.POINTER element] -> f (gdome_element_option_of_boxed_option element) - | _ -> invalid_arg "GtkMathView.MathView.Signals.marshal_selection_changed" + [GtkArgv.POINTER first; GtkArgv.POINTER last] -> + f (gdome_element_option_of_boxed_option first) + (gdome_element_option_of_boxed_option last) + | _ -> invalid_arg "GtkMathView.MathView.Signals.marshal_press_move" in - { name = "selection_changed"; classe = `math_view; - marshaller = marshal_selection_changed } + { name = "press_move"; classe = `math_view; + marshaller = marshal_press_move } let element_changed : ([>`math_view],_) t = let marshal_element_changed f _ = diff --git a/helm/DEVEL/lablgtkmathview/ml_gtk_mathview.c b/helm/DEVEL/lablgtkmathview/ml_gtk_mathview.c index df4719b61..96278f2b8 100644 --- a/helm/DEVEL/lablgtkmathview/ml_gtk_mathview.c +++ b/helm/DEVEL/lablgtkmathview/ml_gtk_mathview.c @@ -30,7 +30,7 @@ #include #include -#include +#include #include #include @@ -77,11 +77,14 @@ value_of_font_manager_id(FontManagerId id) } ML_2 (gtk_math_view_new,GtkAdjustment_val, GtkAdjustment_val, Val_GtkWidget_sink) -ML_2 (gtk_math_view_load, GtkMathView_val, String_val, Val_bool) -ML_2 (gtk_math_view_load_tree, GtkMathView_val, Document_val, Val_bool) +ML_1 (gtk_math_view_freeze, GtkMathView_val, Unit) +ML_1 (gtk_math_view_thaw, GtkMathView_val, Unit) +ML_2 (gtk_math_view_load_uri, GtkMathView_val, String_val, Val_bool) +ML_2 (gtk_math_view_load_doc, GtkMathView_val, Document_val, Val_bool) ML_1 (gtk_math_view_unload, GtkMathView_val, Unit) -OML_1 (gtk_math_view_get_selection, GtkMathView_val, Val_Element) -ML_2O (gtk_math_view_set_selection, GtkMathView_val, Element_val, Unit) +ML_2 (gtk_math_view_select, GtkMathView_val, Element_val, Unit) +ML_2 (gtk_math_view_unselect, GtkMathView_val, Element_val, Unit) +ML_2 (gtk_math_view_is_selected, GtkMathView_val, Element_val, Val_bool) ML_1 (gtk_math_view_get_width, GtkMathView_val, Val_int) ML_1 (gtk_math_view_get_height, GtkMathView_val, Val_int) ML_3 (gtk_math_view_set_top, GtkMathView_val, Int_val, Int_val, Unit) @@ -94,19 +97,12 @@ ML_2 (gtk_math_view_set_font_size, GtkMathView_val, Int_val, Unit) ML_1 (gtk_math_view_get_font_size, GtkMathView_val, Val_int) ML_2 (gtk_math_view_set_anti_aliasing, GtkMathView_val, Bool_val, Unit) ML_1 (gtk_math_view_get_anti_aliasing, GtkMathView_val, Val_bool) -ML_2 (gtk_math_view_set_kerning, GtkMathView_val, Bool_val, Unit) -ML_1 (gtk_math_view_get_kerning, GtkMathView_val, Val_bool) ML_2 (gtk_math_view_set_transparency, GtkMathView_val, Bool_val, Unit) ML_1 (gtk_math_view_get_transparency, GtkMathView_val, Val_bool) ML_2 (gtk_math_view_set_log_verbosity, GtkMathView_val, Int_val, Unit) ML_1 (gtk_math_view_get_log_verbosity, GtkMathView_val, Val_int) ML_2 (gtk_math_view_set_font_manager_type, GtkMathView_val, font_manager_id_of_value, Unit) ML_1 (gtk_math_view_get_font_manager_type, GtkMathView_val, value_of_font_manager_id) -OML_1 (gtk_math_view_get_element, GtkMathView_val, Val_Element) -OML_1 (gtk_math_view_get_action, GtkMathView_val, Val_Element) -ML_1 (gtk_math_view_action_get_selected, GtkMathView_val, Val_int) -ML_2 (gtk_math_view_action_set_selected, GtkMathView_val, Int_val, Unit) -ML_1 (gtk_math_view_action_toggle, GtkMathView_val, Unit) value ml_gtk_math_view_export_to_postscript_native(value arg1, diff --git a/helm/DEVEL/lablgtkmathview/test/Makefile.in b/helm/DEVEL/lablgtkmathview/test/Makefile.in index 30f41c4f3..29ab71ffc 100644 --- a/helm/DEVEL/lablgtkmathview/test/Makefile.in +++ b/helm/DEVEL/lablgtkmathview/test/Makefile.in @@ -1,5 +1,5 @@ PACKAGE = @PACKAGE@ -MLFLAGS = +MLFLAGS = -predicates "init" OCAMLC = ocamlfind ocamlc $(MLFLAGS) OCAMLOPT = ocamlfind ocamlopt $(MLFLAGS) TMPDIR = .test diff --git a/helm/DEVEL/lablgtkmathview/test/test.ml b/helm/DEVEL/lablgtkmathview/test/test.ml index 655970cca..2bbdbb0b4 100644 --- a/helm/DEVEL/lablgtkmathview/test/test.ml +++ b/helm/DEVEL/lablgtkmathview/test/test.ml @@ -74,9 +74,39 @@ let rec jump (element : Gdome.element) = end ;; -let clicked (mathview : GMathView.math_view) (element : Gdome.element) = +let rec action mathview (element : Gdome.element) = + let module G = Gdome in + if element#get_tagName#to_string = "m:maction" then + let selection = + if element#hasAttribute ~name:(G.domString "selection") then + int_of_string (element#getAttribute ~name:(G.domString "selection"))#to_string + else + 1 + in + mathview#freeze ; + (* the widget will cast the index back into a reasonable range *) + element#setAttribute ~name:(G.domString "selection") ~value:(G.domString (string_of_int (selection + 1))) ; + mathview#thaw ; + true + else + match element#get_parentNode with + Some p -> + begin + try + action mathview (new Gdome.element_of_node p) + with + GdomeInit.DOMCastException _ -> + print_string "action: NO MACTION FOUND\n" ; + flush stdout ; + false + end + | None -> assert false (* every element has a parent *) + +let clicked mathview (element : Gdome.element) = let module G = Gdome in if not (jump element) then + if not (action mathview element) then + (* match mathview#get_action with Some n -> mathview#action_toggle ; @@ -91,17 +121,19 @@ let clicked (mathview : GMathView.math_view) (element : Gdome.element) = ) ^ "\n") ; print_endline ("clicked: " ^ element#get_tagName#to_string) ; flush stdout + *) + () ;; -let activate_t1 (mathview : GMathView.math_view) () = - mathview#set_font_manager_type `font_manager_t1; +let activate_t1 mathview () = + mathview#set_font_manager_type ~fm_type:`font_manager_t1; print_string "WIDGET SET WITH T1 FONTS\n" ; flush stdout ;; -let activate_gtk (mathview : GMathView.math_view) () = - mathview#set_font_manager_type `font_manager_gtk ; +let activate_gtk mathview () = + mathview#set_font_manager_type ~fm_type:`font_manager_gtk ; print_string "WIDGET SET WITH GTK FONTS\n" ; flush stdout ;; @@ -130,19 +162,19 @@ let set_transparency mathview () = ;; -let load (mathview : GMathView.math_view) () = - mathview#load "test.xml" ; +let load_uri mathview () = + mathview#load_uri ~filename:"test.xml" ; print_string "load: SEEMS TO WORK\n" ; flush stdout ;; -let load_dom (mathview : GMathView.math_view) () = - mathview#load_tree ((Gdome.domImplementation ())#createDocumentFromURI ~uri:"test.xml" ()) ; +let load_doc mathview () = + mathview#load_doc ~dom:((Gdome.domImplementation ())#createDocumentFromURI ~uri:"test.xml" ()) ; print_string "load from DOM: SEEMS TO WORK\n" ; flush stdout ;; -let get_selection (mathview : GMathView.math_view) () = +let test_get_selection mathview () = let selection = match mathview#get_selection with Some element -> element#get_tagName#to_string @@ -152,7 +184,7 @@ let get_selection (mathview : GMathView.math_view) () = flush stdout ;; -let set_selection (mathview : GMathView.math_view) () = +let test_set_selection mathview () = begin match mathview#get_selection with Some element -> @@ -176,6 +208,20 @@ let set_selection (mathview : GMathView.math_view) () = flush stdout ;; +let test_add_selection (mathview : GMathViewAux.multi_selection_math_view) () = + match mathview#get_selection with + Some e -> mathview#add_selection e + | None -> + begin + print_string "no selection to add\n" ; + flush stdout + end +;; + +let test_reset_selections (mathview : GMathViewAux.multi_selection_math_view) () = + mathview#set_selection None ; + mathview#remove_selections + let unload mathview () = mathview#unload ; print_string "unload: SEEMS TO WORK\n" ; @@ -267,6 +313,7 @@ let get_anti_aliasing mathview () = flush stdout ;; + (* let set_kerning mathview () = mathview#set_kerning true ; print_string "set_kerning: ON\n" ; @@ -279,6 +326,7 @@ let get_kerning mathview () = "\n") ; flush stdout ;; +*) let set_log_verbosity mathview () = mathview#set_log_verbosity 3 ; @@ -293,7 +341,7 @@ let get_log_verbosity mathview () = flush stdout ;; -let export_to_postscript (mathview : GMathView.math_view) () = +let export_to_postscript (mathview : GMathViewAux.multi_selection_math_view) () = mathview#export_to_postscript ~filename:"test.ps" (); print_string "expor_to_postscript: SEEMS TO WORK (hint: look at test.ps)\n"; flush stdout @@ -303,13 +351,15 @@ let export_to_postscript (mathview : GMathView.math_view) () = let main_window = GWindow.window ~title:"GtkMathView test" () in let vbox = GPack.vbox ~packing:main_window#add () in let sw = GBin.scrolled_window ~width:50 ~height:50 ~packing:vbox#pack () in -let mathview= GMathView.math_view ~packing:sw#add ~width:50 ~height:50 () in +let mathview= GMathViewAux.multi_selection_math_view ~packing:sw#add ~width:50 ~height:50 () in let table = GPack.table ~rows:6 ~columns:5 ~packing:vbox#pack () in let button_gtk=GButton.button ~label:"activate Gtk fonts" ~packing:(table#attach ~left:0 ~top:0) () in let button_load = GButton.button ~label:"load" ~packing:(table#attach ~left:1 ~top:0) () in let button_unload = GButton.button ~label:"unload" ~packing:(table#attach ~left:2 ~top:0) () in let button_get_selection = GButton.button ~label:"get_selection" ~packing:(table#attach ~left:3 ~top:0) () in let button_set_selection = GButton.button ~label:"set_selection" ~packing:(table#attach ~left:4 ~top:0) () in +let button_add_selection = GButton.button ~label:"add_selection" ~packing:(table#attach ~left:3 ~top:3) () in +let button_reset_selections = GButton.button ~label:"reset_selections" ~packing:(table#attach ~left:4 ~top:3) () in let button_get_width = GButton.button ~label:"get_width" ~packing:(table#attach ~left:0 ~top:1) () in let button_get_height = GButton.button ~label:"get_height" ~packing:(table#attach ~left:1 ~top:1) () in let button_get_top = GButton.button ~label:"get_top" ~packing:(table#attach ~left:2 ~top:1) () in @@ -323,8 +373,6 @@ let button_set_font_size = GButton.button ~label:"set_font_size" ~packing:(table let button_get_font_size = GButton.button ~label:"get_font_size" ~packing:(table#attach ~left:0 ~top:3) () in let button_set_anti_aliasing = GButton.button ~label:"set_anti_aliasing" ~packing:(table#attach ~left:1 ~top:3) () in let button_get_anti_aliasing = GButton.button ~label:"get_anti_aliasing" ~packing:(table#attach ~left:2 ~top:3) () in -let button_set_kerning = GButton.button ~label:"set_kerning" ~packing:(table#attach ~left:3 ~top:3) () in -let button_get_kerning = GButton.button ~label:"get_kerning" ~packing:(table#attach ~left:4 ~top:3) () in let button_set_log_verbosity = GButton.button ~label:"set_log_verbosity" ~packing:(table#attach ~left:0 ~top:4) () in let button_get_log_verbosity = GButton.button ~label:"get_log_verbosity" ~packing:(table#attach ~left:1 ~top:4) () in let button_export_to_postscript = GButton.button ~label:"export_to_postscript" ~packing:(table#attach ~left:2 ~top:4) () in @@ -335,10 +383,12 @@ let button_set_transparency = GButton.button ~label:"set_transparency" ~packing: let button_load_dom = GButton.button ~label:"load from DOM" ~packing:(table#attach ~left:2 ~top:5) () in (* Signals connection *) ignore(button_gtk#connect#clicked (activate_gtk mathview)) ; -ignore(button_load#connect#clicked (load mathview)) ; +ignore(button_load#connect#clicked (load_uri mathview)) ; ignore(button_unload#connect#clicked (unload mathview)) ; -ignore(button_get_selection#connect#clicked (get_selection mathview)) ; -ignore(button_set_selection#connect#clicked (set_selection mathview)) ; +ignore(button_get_selection#connect#clicked (test_get_selection mathview)) ; +ignore(button_set_selection#connect#clicked (test_set_selection mathview)) ; +ignore(button_add_selection#connect#clicked (test_add_selection mathview)) ; +ignore(button_reset_selections#connect#clicked (test_reset_selections mathview)) ; ignore(button_get_width#connect#clicked (get_width mathview)) ; ignore(button_get_height#connect#clicked (get_height mathview)) ; ignore(button_get_top#connect#clicked (get_top mathview)) ; @@ -352,8 +402,6 @@ ignore(button_set_font_size#connect#clicked (set_font_size mathview)) ; ignore(button_get_font_size#connect#clicked (get_font_size mathview)) ; ignore(button_set_anti_aliasing#connect#clicked (set_anti_aliasing mathview)) ; ignore(button_get_anti_aliasing#connect#clicked (get_anti_aliasing mathview)) ; -ignore(button_set_kerning#connect#clicked (set_kerning mathview)) ; -ignore(button_get_kerning#connect#clicked (get_kerning mathview)) ; ignore(button_set_log_verbosity#connect#clicked (set_log_verbosity mathview)) ; ignore(button_get_log_verbosity#connect#clicked (get_log_verbosity mathview)) ; ignore(button_export_to_postscript#connect#clicked (export_to_postscript mathview)) ; @@ -362,9 +410,9 @@ ignore(button_get_font_manager_type#connect#clicked (get_font_manager_type mathv ignore(button_get_transparency#connect#clicked (get_transparency mathview)) ; ignore(button_set_transparency#connect#clicked (set_transparency mathview)) ; ignore(mathview#connect#clicked (clicked mathview)) ; -ignore(mathview#connect#selection_changed (selection_changed mathview)) ; +ignore(mathview#connect#selection_changed (selection_changed mathview)); ignore(mathview#connect#element_changed (element_changed mathview)) ; -ignore(button_load_dom#connect#clicked (load_dom mathview)) ; +ignore(button_load_dom#connect#clicked (load_doc mathview)) ; (* Main Loop *) main_window#show () ; GMain.Main.main () -- 2.39.2