]> rtime.felk.cvut.cz Git - l4.git/blob - l4/pkg/ocaml/contrib/otherlibs/labltk/frx/frx_fileinput.ml
update
[l4.git] / l4 / pkg / ocaml / contrib / otherlibs / labltk / frx / frx_fileinput.ml
1 (***********************************************************************)
2 (*                                                                     *)
3 (*                 MLTk, Tcl/Tk interface of Objective Caml            *)
4 (*                                                                     *)
5 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
6 (*               projet Cristal, INRIA Rocquencourt                    *)
7 (*            Jacques Garrigue, Kyoto University RIMS                  *)
8 (*                                                                     *)
9 (*  Copyright 2002 Institut National de Recherche en Informatique et   *)
10 (*  en Automatique and Kyoto University.  All rights reserved.         *)
11 (*  This file is distributed under the terms of the GNU Library        *)
12 (*  General Public License, with the special exception on linking      *)
13 (*  described in file LICENSE found in the Objective Caml source tree. *)
14 (*                                                                     *)
15 (***********************************************************************)
16 open Camltk
17
18 let version = "$Id: frx_fileinput.ml 4745 2002-04-26 12:16:26Z furuse $"
19
20 (*
21  * Simple spooling for fileinput callbacks
22  *)
23
24 let waiting_list = Queue. new()
25 and waiting = ref 0
26 and max_open = ref 10
27 and cur_open = ref 0
28
29 let add fd f =
30   if !cur_open < !max_open then begin
31     incr cur_open;
32     add_fileinput fd f
33     end
34   else begin
35     incr waiting;
36     Queue.add (fd,f) waiting_list
37   end
38
39 let remove fd =
40