X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtkmathview%2Ftest%2Ftest.ml;fp=helm%2FDEVEL%2Flablgtkmathview%2Ftest%2Ftest.ml;h=0000000000000000000000000000000000000000;hp=e6bfc9d1d47f7020b63b268b9d1deb587d418833;hb=1696761e4b8576e8ed81caa905fd108717019226;hpb=5325734bc2e4927ed7ec146e35a6f0f2b49f50c1 diff --git a/helm/DEVEL/lablgtkmathview/test/test.ml b/helm/DEVEL/lablgtkmathview/test/test.ml deleted file mode 100644 index e6bfc9d1d..000000000 --- a/helm/DEVEL/lablgtkmathview/test/test.ml +++ /dev/null @@ -1,384 +0,0 @@ -(* Copyright (C) 2000-2003, Luca Padovani , - * Claudio Sacerdoti Coen . - * - * 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. - *) - -(******************************************************************************) -(* Claudio Sacerdoti Coen *) -(* 25/09/2000 *) -(* *) -(* This is a simple test for the OCaml (LablGtk indeed) binding of the *) -(* MathView widget *) -(******************************************************************************) - -let helmns = Gdome.domString "http://www.cs.unibo.it/helm";; - -(* -let choose_selection mmlwidget (element : Gdome.element option) = - let module G = Gdome in - let rec aux element = - if element#hasAttributeNS - ~namespaceURI:Misc.helmns - ~localName:(G.domString "xref") - then - mmlwidget#set_selection (Some element) - else - try - match element#get_parentNode with - None -> assert false - (*CSC: OCAML DIVERGES! - | Some p -> aux (new G.element_of_node p) - *) - | Some p -> aux (new Gdome.element_of_node p) - with - GdomeInit.DOMCastException _ -> - prerr_endline - "******* trying to select above the document root ********" - in - match element with - Some x -> aux x - | None -> mmlwidget#set_selection None -;; -*) - -(* Callbacks *) -let selection_changed mathview (element : Gdome.element option) = - let rec aux element = - if element#hasAttributeNS - ~namespaceURI:helmns - ~localName:(Gdome.domString "xref") - then - mathview#set_selection (Some element) - else - try - match element#get_parentNode with - None -> mathview#set_selection None - | Some p -> aux (new Gdome.element_of_node p) - with - GdomeInit.DOMCastException _ -> - prerr_endline "******* trying to select above the document root ********" - in - print_endline ("selection_changed: " ^ - (match element with - None -> "selection_changed on nothing" - | Some element -> element#get_tagName#to_string - ) - ) ; - match element with - None -> () - | Some el -> aux el; - flush stdout -;; - -let element_over mathview (element : Gdome.element option) _ = - print_endline ("element_over: " ^ - (match element with - None -> "element_over on nothing" - | Some element -> element#get_tagName#to_string - ) - ) ; - flush stdout -;; - -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 - | None -> assert false (* every element has a parent *) - else - begin - print_endline ("jump: " ^ attr) ; - flush stdout ; - true - end -;; - -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 click mathview (element : Gdome.element option) _ = - let module G = Gdome in - match element with - None -> print_string "CLICKED ON NOTHING\n" ; flush stdout - | Some element -> - if not (jump element) then - if not (mathview#action_toggle element) then - () -;; - - -let load_uri mathview () = - mathview#load_uri ~filename:"test.xml" ; - print_string "load: SEEMS TO WORK\n" ; - flush stdout -;; - -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 test_get_selection mathview () = - let selection = - match mathview#get_selection with - Some element -> element#get_tagName#to_string - | None -> "no selection!" - in - print_string ("selection: " ^ selection ^ "\n") ; - flush stdout -;; - -let test_set_selection mathview () = - 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 -;; - -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" ; - flush stdout -;; - -let get_width mathview () = - print_string ("width: " ^ string_of_int (mathview#get_width) ^ "\n") ; - flush stdout -;; - -let get_height mathview () = - print_string ("height: " ^ string_of_int (mathview#get_height) ^ "\n") ; - flush stdout -;; - -let get_top mathview () = - let (x,y) = mathview#get_top in - print_string ("top: ("^ string_of_int x ^ "," ^ string_of_int y ^ ")\n") ; - flush stdout -;; - -let set_top mathview () = - mathview#set_top 0 0; - print_string "set_top: SEEM TO WORK\n" ; - flush stdout -;; - -let set_adjustments mathview () = - let adj1 = GData.adjustment () in - let adj2 = GData.adjustment () in - mathview#set_adjustments adj1 adj2 ; - adj1#set_value ((adj1#lower +. adj1#upper) /. 2.0) ; - adj2#set_value ((adj2#lower +. adj2#upper) /. 2.0) ; - print_string "set_adjustments: SEEM TO WORK\n" ; - flush stdout -;; - -let get_hadjustment mathview () = - let adj = mathview#get_hadjustment in - adj#set_value ((adj#lower +. adj#upper) /. 2.0) ; - print_string "hadjustment: SEEM TO WORK\n" ; - flush stdout -;; - -let get_vadjustment mathview () = - let adj = mathview#get_vadjustment in - adj#set_value ((adj#lower +. adj#upper) /. 2.0) ; - print_string "vadjustment: SEEM TO WORK\n" ; - flush stdout -;; - -let get_buffer mathview () = - let buffer = mathview#get_buffer in - Gdk.Draw.rectangle buffer (Gdk.GC.create buffer) ~x:0 ~y:0 - ~width:50 ~height:50 ~filled:true () ; - print_string "buffer: SEEMS TO WORK (hint: force the widget redrawing)\n"; - flush stdout -;; - -let set_font_size mathview () = - mathview#set_font_size 24 ; - print_string "set_font_size: FONT IS NOW 24\n" ; - flush stdout -;; - -let get_font_size mathview () = - print_string ("font_size: " ^ string_of_int (mathview#get_font_size) ^ "\n") ; - flush stdout -;; - -let set_log_verbosity mathview () = - mathview#set_log_verbosity 3 ; - print_string "set_log_verbosity: NOW IS 3\n" ; - flush stdout -;; - -let get_log_verbosity mathview () = - print_string ("log_verbosity: " ^ - string_of_int mathview#get_log_verbosity ^ - "\n") ; - flush stdout -;; - -let x_coord = ref 0 -;; - -let get_element_at mathview () = - begin - match mathview#get_element_at !x_coord 10 with - None -> print_string ("there is no element at " ^ (string_of_int !x_coord) ^ " 10\n") - | Some e -> print_string ("at " ^ (string_of_int !x_coord) ^ " 10 found element " ^ (e#get_nodeName#to_string) ^ "\n") - end ; - x_coord := !x_coord + 10 ; - flush stdout -;; - -let get_drawing_area mathview () = - begin - let da = mathview#get_drawing_area in - print_string ("don't know what to do with the drawing area\n") - end ; - flush stdout -;; - -(* Widget creation *) -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= 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_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_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 -let button_set_top = GButton.button ~label:"set_top" ~packing:(table#attach ~left:3 ~top:1) () in -let button_set_adjustments = GButton.button ~label:"set_adjustments" ~packing:(table#attach ~left:4 ~top:1) () in -let button_get_hadjustment = GButton.button ~label:"get_hadjustment" ~packing:(table#attach ~left:0 ~top:2) () in -let button_get_vadjustment = GButton.button ~label:"get_vadjustment" ~packing:(table#attach ~left:1 ~top:2) () in -let button_get_buffer = GButton.button ~label:"get_buffer" ~packing:(table#attach ~left:2 ~top:2) () in -let button_set_font_size = GButton.button ~label:"set_font_size" ~packing:(table#attach ~left:4 ~top:2) () in -let button_get_font_size = GButton.button ~label:"get_font_size" ~packing:(table#attach ~left:0 ~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_load_dom = GButton.button ~label:"load from DOM" ~packing:(table#attach ~left:2 ~top:5) () in -let button_get_element_at = GButton.button ~label:"get_element_at" ~packing:(table#attach ~left:3 ~top:5) () in -let button_get_drawing_area = GButton.button ~label:"get_drawing_area" ~packing:(table#attach ~left:4 ~top:5) () in -(* Signals connection *) -ignore(button_load#connect#clicked (load_uri mathview)) ; -ignore(button_unload#connect#clicked (unload mathview)) ; -ignore(button_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)) ; -ignore(button_set_top#connect#clicked (set_top mathview)) ; -ignore(button_set_adjustments#connect#clicked (set_adjustments mathview)) ; -ignore(button_get_hadjustment#connect#clicked (get_hadjustment mathview)) ; -ignore(button_get_vadjustment#connect#clicked (get_vadjustment mathview)) ; -ignore(button_get_buffer#connect#clicked (get_buffer mathview)) ; -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_log_verbosity#connect#clicked (set_log_verbosity mathview)) ; -ignore(button_get_log_verbosity#connect#clicked (get_log_verbosity mathview)) ; -ignore(mathview#connect#click (click mathview)) ; -ignore(mathview#connect#selection_changed (selection_changed mathview)); -ignore(mathview#connect#element_over (element_over mathview)) ; -ignore(button_load_dom#connect#clicked (load_doc mathview)) ; -ignore(button_get_element_at#connect#clicked (get_element_at mathview)) ; -ignore(button_get_drawing_area#connect#clicked (get_drawing_area mathview)) ; -(* Main Loop *) -main_window#show () ; -GMain.Main.main () -;;