X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtkmathview%2Ftest%2Ftest.ml;h=655970cca5a1974e7c6aa0db5cb3c19106839123;hb=89262281b6e83bd2321150f81f1a0583645eb0c8;hp=855ce95846c80f32697d4dd6d2595cd1da4df84f;hpb=aa4eb8949201e7a7b54e3459ec0fe271e126049c;p=helm.git diff --git a/helm/DEVEL/lablgtkmathview/test/test.ml b/helm/DEVEL/lablgtkmathview/test/test.ml index 855ce9584..655970cca 100644 --- a/helm/DEVEL/lablgtkmathview/test/test.ml +++ b/helm/DEVEL/lablgtkmathview/test/test.ml @@ -29,44 +29,54 @@ (******************************************************************************) (* Callbacks *) -let selection_changed mathview (node : Ominidom.o_mDOMNode option) = - let module O = Ominidom in - print_string ("selection_changed: " ^ - (match node with - None -> "selection_changed on nothing" - | Some node -> - match node#get_name with - | Some x -> x#get_string - | None -> "on element without name" - ) ^ "\n"); - mathview#set_selection node; - flush stdout +let selection_changed mathview (element : Gdome.element option) = + print_endline ("selection_changed: " ^ + (match element with + None -> "selection_changed on nothing" + | Some element -> element#get_tagName#to_string + ) + ) ; + mathview#set_selection element; + flush stdout ;; +let element_changed mathview (element : Gdome.element option) = + print_endline ("element_changed: " ^ + (match element with + None -> "element_changed on nothing" + | Some element -> element#get_tagName#to_string + ) + ) ; + flush stdout +;; -let rec jump (node : Ominidom.o_mDOMNode) = - let module O = Ominidom in - match node#get_attribute (O.o_mDOMString_of_string "href") with - None -> - begin - try - let p = node#get_parent in - jump p - with - O.Node_has_no_parent -> +let rec jump (element : Gdome.element) = + let module G = Gdome in + let attr = (element#getAttribute ~name:(G.domString "href"))#to_string in + if attr = "" then + match element#get_parentNode with + Some p -> + begin + try + jump (new Gdome.element_of_node p) + with + GdomeInit.DOMCastException _ -> print_string "jump: NO HREF FOR THIS NODE\n" ; flush stdout ; false - end - | Some x -> - print_string ("jump: " ^ x#get_string ^ "\n") ; - flush stdout ; - true + end + | None -> assert false (* every element has a parent *) + else + begin + print_endline ("jump: " ^ attr) ; + flush stdout ; + true + end ;; -let clicked mathview (node : Ominidom.o_mDOMNode) = - let module O = Ominidom in - if not (jump node) then +let clicked (mathview : GMathView.math_view) (element : Gdome.element) = + let module G = Gdome in + if not (jump element) then match mathview#get_action with Some n -> mathview#action_toggle ; @@ -75,31 +85,23 @@ let clicked mathview (node : Ominidom.o_mDOMNode) = flush stdout ; | None -> print_string ("mouse is on: " ^ - (match (mathview#get_element : Ominidom.o_mDOMNode option) with - Some e -> - (match e#get_name with - Some x -> x#get_string - | None -> "no name" - ) + (match (mathview#get_element : Gdome.element option) with + Some e -> e#get_tagName#to_string | None -> "NO ELEMENT!\n" ) ^ "\n") ; - print_string ("clicked: " ^ - (match node#get_name with - Some x -> x#get_string - | None -> "no name" - ) ^ "\n") ; + print_endline ("clicked: " ^ element#get_tagName#to_string) ; flush stdout ;; -let activate_t1 mathview () = +let activate_t1 (mathview : GMathView.math_view) () = mathview#set_font_manager_type `font_manager_t1; print_string "WIDGET SET WITH T1 FONTS\n" ; flush stdout ;; -let activate_gtk mathview () = - mathview#set_font_manager_type `font_manager_gtk; +let activate_gtk (mathview : GMathView.math_view) () = + mathview#set_font_manager_type `font_manager_gtk ; print_string "WIDGET SET WITH GTK FONTS\n" ; flush stdout ;; @@ -128,52 +130,50 @@ let set_transparency mathview () = ;; -let load mathview () = +let load (mathview : GMathView.math_view) () = mathview#load "test.xml" ; print_string "load: SEEMS TO WORK\n" ; flush stdout ;; -let load_dom mathview () = - mathview#load_tree (new Ominidom.o_mDOMDoc (Minidom.doc_load "test.xml")) ; +let load_dom (mathview : GMathView.math_view) () = + mathview#load_tree ((Gdome.domImplementation ())#createDocumentFromURI ~uri:"test.xml" ()) ; print_string "load from DOM: SEEMS TO WORK\n" ; flush stdout ;; -let get_selection mathview () = - let module O = Ominidom in - let selection = - match mathview#get_selection with - | Some node -> - begin - match node#get_name with - | Some name -> name#get_string - | None -> "element with no name!" - end - | None -> "no selection!" - in - print_string ("get_selection: " ^ selection ^ "\n") ; - flush stdout +let get_selection (mathview : GMathView.math_view) () = + let selection = + match mathview#get_selection with + Some element -> element#get_tagName#to_string + | None -> "no selection!" + in + print_string ("get_selection: " ^ selection ^ "\n") ; + flush stdout ;; -let set_selection mathview () = - let module O = Ominidom in - begin - match mathview#get_selection with - | Some node -> - begin - try - let parent_node = node#get_parent in - mathview#set_selection (Some parent_node); - print_string "set selection: SEEMS TO WORK\n" - with - _ -> print_string "EXCEPTION: no parent\n" - end +let set_selection (mathview : GMathView.math_view) () = + begin + match mathview#get_selection with + Some element -> + begin + match element#get_parentNode with + Some p -> + begin + try + mathview#set_selection (Some (new Gdome.element_of_node p)); + print_string "set selection: SEEMS TO WORK\n" + with + GdomeInit.DOMCastException _ -> + print_string "EXCEPTION: no parent\n" + end + | None -> assert false (* every element has a parent *) + end | None -> - mathview#set_selection None; - print_string "no selection\n" - end ; - flush stdout + mathview#set_selection None; + print_string "no selection\n" + end ; + flush stdout ;; let unload mathview () = @@ -363,6 +363,7 @@ 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#element_changed (element_changed mathview)) ; ignore(button_load_dom#connect#clicked (load_dom mathview)) ; (* Main Loop *) main_window#show () ;