helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkThread.ml

   1 (* $Id$ *)
   2
   3 open GtkMain
   4
   5 (* We check first whether there are some event pending, and run
   6    some iterations. We then need to delay, thus focing a thread switch. *)
   7
   8 let main () =
   9   try
  10     let loop = (Glib.Main.create true) in
  11     Main.loops := loop :: !Main.loops;
  12     while Glib.Main.is_running loop do
  13       let i = ref 0 in
  14       while !i < 100 && Glib.Main.pending () do
  15         Glib.Main.iteration true;
  16         incr i
  17       done;
  18       Thread.delay 0.001
  19     done;
  20     Main.loops := List.tl !Main.loops
  21   with exn ->
  22     Main.loops := List.tl !Main.loops;
  23     raise exn
  24
  25 let start = Thread.create main
  26
  27 let _ =
  28   let mutex = Mutex.create () in
  29   let depth = ref 0 in
  30   GtkSignal.enter_callback :=
  31     (fun () -> if !depth = 0 then Mutex.lock mutex; incr depth);
  32   GtkSignal.exit_callback :=
  33     (fun () -> decr depth; if !depth = 0 then Mutex.unlock mutex)