diff options
| author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2005-12-21 05:29:08 +0000 |
|---|---|---|
| committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2005-12-21 05:29:08 +0000 |
| commit | 996e13181d3829bf8b12c09b4431bfeeac73cec2 (patch) | |
| tree | 48a6d1ebadb7fb096c28d4d2d24f6ed0bb312b3d /otherlibs | |
| parent | 3088c148763eb2ce37e61742e12cbff77441635b (diff) | |
simplify interactive use
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7283 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'otherlibs')
| -rw-r--r-- | otherlibs/labltk/Changes | 6 | ||||
| -rw-r--r-- | otherlibs/labltk/support/protocol.ml | 18 | ||||
| -rw-r--r-- | otherlibs/labltk/support/protocol.mli | 9 |
3 files changed, 23 insertions, 10 deletions
diff --git a/otherlibs/labltk/Changes b/otherlibs/labltk/Changes index bd671fdb6..e98ed2736 100644 --- a/otherlibs/labltk/Changes +++ b/otherlibs/labltk/Changes @@ -1,5 +1,9 @@ -version 1.0a1 +2005-12-20: +----------- +* Add Protocol.do_one_event and Protocol.do_pending. +2002-05-03: +----------- General Changes * Merging CamlTk and LablTk API interfaces * Activate and Deactivate Events are added diff --git a/otherlibs/labltk/support/protocol.ml b/otherlibs/labltk/support/protocol.ml index 6e3208cfe..d7af4dbac 100644 --- a/otherlibs/labltk/support/protocol.ml +++ b/otherlibs/labltk/support/protocol.ml @@ -51,6 +51,12 @@ external finalizeTk : unit -> unit let tcl_command s = ignore (tcl_eval s);; +type event_flag = + DONT_WAIT | X_EVENTS | FILE_EVENTS | TIMER_EVENTS | IDLE_EVENTS | ALL_EVENTS +external do_one_event : event_flag list -> bool = "camltk_dooneevent" + +let do_pending () = while do_one_event [DONT_WAIT] do () done + exception TkError of string (* Raised by the communication functions *) let () = Callback.register_exception "tkerror" (TkError "") @@ -176,15 +182,9 @@ let dispatch_callback id args = let protected_dispatch id args = try dispatch_callback id args - with - | e -> - try - Printf.eprintf "Uncaught exception: %s\n" (Printexc.to_string e); - flush stderr; - (* raise x *) - with - Out_of_memory -> raise Out_of_memory - | Sys.Break -> raise Sys.Break + with e -> + Printf.eprintf "Uncaught exception: %s\n" (Printexc.to_string e); + flush stderr let _ = Callback.register "camlcb" protected_dispatch diff --git a/otherlibs/labltk/support/protocol.mli b/otherlibs/labltk/support/protocol.mli index fe3ff794f..2e4edc359 100644 --- a/otherlibs/labltk/support/protocol.mli +++ b/otherlibs/labltk/support/protocol.mli @@ -73,6 +73,15 @@ val finalizeTk : unit -> unit called when you call [Pervasives.exit ()] *) val mainLoop : unit -> unit + (* Start the event loop *) + +type event_flag = + DONT_WAIT | X_EVENTS | FILE_EVENTS | TIMER_EVENTS | IDLE_EVENTS | ALL_EVENTS +val do_one_event : event_flag list -> bool + (* Process a single event *) +val do_pending : unit -> unit + (* Process all pending events, without waiting. + This lets you use Tk from the toplevel, for instance. *) (* Direct evaluation of tcl code *) |