diff options
| author | Pierre Weis <Pierre.Weis@inria.fr> | 2000-02-15 10:12:37 +0000 |
|---|---|---|
| committer | Pierre Weis <Pierre.Weis@inria.fr> | 2000-02-15 10:12:37 +0000 |
| commit | 005eba2464c71b33d9949aad5e11f75152f475c6 (patch) | |
| tree | 27603d5fc6038c387441250aa9976dfcf00ba41e /otherlibs/labltk | |
| parent | abc7c21d330ed373b9a7cefd24426c8e0a15f9b2 (diff) | |
Gestion des warnings: différence tkEval tkCommand, introduction de timer.set.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2822 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'otherlibs/labltk')
| -rw-r--r-- | otherlibs/labltk/support/Makefile.common | 2 | ||||
| -rw-r--r-- | otherlibs/labltk/support/protocol.ml | 15 | ||||
| -rw-r--r-- | otherlibs/labltk/support/protocol.mli | 2 | ||||
| -rw-r--r-- | otherlibs/labltk/support/timer.ml | 2 | ||||
| -rw-r--r-- | otherlibs/labltk/support/timer.mli | 5 |
5 files changed, 17 insertions, 9 deletions
diff --git a/otherlibs/labltk/support/Makefile.common b/otherlibs/labltk/support/Makefile.common index 6171902b9..24a2964bb 100644 --- a/otherlibs/labltk/support/Makefile.common +++ b/otherlibs/labltk/support/Makefile.common @@ -14,7 +14,7 @@ TKLINKOPT=$(STATIC) -ccopt -L../support -cclib -llabltk41 \ CAMLRUN=$(TOPDIR)/boot/ocamlrun LABLC=$(CAMLRUN) $(TOPDIR)/ocamlc -I $(TOPDIR)/stdlib -LABLCOMP=$(LABLC) -w s -modern -c +LABLCOMP=$(LABLC) -modern -c LABLYACC=$(TOPDIR)/boot/ocamlyacc -v LABLLEX=$(CAMLRUN) $(TOPDIR)/boot/ocamllex LABLLIBR=$(LABLC) -a diff --git a/otherlibs/labltk/support/protocol.ml b/otherlibs/labltk/support/protocol.ml index a61d461fb..522eab8c1 100644 --- a/otherlibs/labltk/support/protocol.ml +++ b/otherlibs/labltk/support/protocol.ml @@ -42,13 +42,15 @@ external tkreturn : string -> unit external callback_init : unit -> unit = "camltk_init" +let tcl_command s = ignore (tcl_eval s);; + exception TkError of string (* Raised by the communication functions *) let _ = Callback.register_exception "tkerror" (TkError "") (* Debugging support *) let debug = - ref (try Sys.getenv "CAMLTKDEBUG"; true + ref (try ignore (Sys.getenv "CAMLTKDEBUG"); true with Not_found -> false) (* This is approximative, since we don't quote what needs to be quoted *) @@ -75,6 +77,8 @@ let tkEval args = end; res +let tkCommand args = ignore (tkEval args) + (* * Callbacks *) @@ -141,7 +145,7 @@ let install_cleanup () = let fid = new_function_id () in Hashtbl.add callback_naming_table key:fid data:call_destroy_hooks; (* setup general destroy callback *) - tcl_eval ("bind all <Destroy> {camlcb " ^ (string_of_cbid fid) ^" %W}") + tcl_command ("bind all <Destroy> {camlcb " ^ (string_of_cbid fid) ^" %W}") let prerr_cbid id = @@ -179,7 +183,7 @@ let openTk ?(:display = "") ?(:class = "LablTk") () = (* Destroy all widgets, thus cleaning up table and exiting the loop *) let closeTk () = - tcl_eval "destroy ."; () + tcl_command "destroy ." let mainLoop = tk_mainloop @@ -189,7 +193,6 @@ let mainLoop = name [tclname] *) let register tclname callback:cb = let s = register_callback Widget.default_toplevel callback:cb in - tcl_eval (Printf.sprintf "proc %s {args} {eval {camlcb %s} $args}" - tclname s); - () + tcl_command (Printf.sprintf "proc %s {args} {eval {camlcb %s} $args}" + tclname s) diff --git a/otherlibs/labltk/support/protocol.mli b/otherlibs/labltk/support/protocol.mli index d7107b239..a16828467 100644 --- a/otherlibs/labltk/support/protocol.mli +++ b/otherlibs/labltk/support/protocol.mli @@ -46,6 +46,8 @@ val mainLoop : unit -> unit (* Direct evaluation of tcl code *) val tkEval : tkArgs array -> string +val tkCommand : tkArgs array -> unit + (* Returning a value from a Tcl callback *) val tkreturn: string -> unit diff --git a/otherlibs/labltk/support/timer.ml b/otherlibs/labltk/support/timer.ml index 115037712..14a17f0f7 100644 --- a/otherlibs/labltk/support/timer.ml +++ b/otherlibs/labltk/support/timer.ml @@ -40,6 +40,8 @@ let add ms:milli callback:f = let t = internal_add_timer milli id in t,id +let set ms:milli callback:f = ignore (add ms:milli callback:f);; + (* If the timer has never been used, there is a small space leak in the C heap, where a copy of id has been stored *) let remove (tkTimer, id) = diff --git a/otherlibs/labltk/support/timer.mli b/otherlibs/labltk/support/timer.mli index c1d4be43f..e94b4005b 100644 --- a/otherlibs/labltk/support/timer.mli +++ b/otherlibs/labltk/support/timer.mli @@ -17,5 +17,6 @@ type t -val add : ms:int -> callback:(unit -> unit) -> t -val remove : t -> unit +val add : ms:int -> callback:(unit -> unit) -> t +val set : ms:int -> callback:(unit -> unit) -> unit +val remove : t -> unit |