]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkThread.ml
- DoubleTypeInference.does_not_occur exposed
[helm.git] / 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)