1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)
6 (* OCaml port by John Malecki and Xavier Leroy *)
7 (* *)
8 (* Copyright 1996 Institut National de Recherche en Informatique et *)
9 (* en Automatique. *)
10 (* *)
11 (* All rights reserved. This file is distributed under the terms of *)
12 (* the GNU Lesser General Public License version 2.1, with the *)
13 (* special exception on linking described in the file LICENSE. *)
14 (* *)
15 (**************************************************************************)
16
17 (**************************** Input control ****************************)
18
19 open Unix
20 open Primitives
21
22 (*** Actives files. ***)
23
24 (* List of the actives files. *)
25 let active_files =
26 ref ([] : (file_descr * ((io_channel -> unit) * io_channel)) list)
27
28 (* Add a file to the list of actives files. *)
29 let add_file file controller =
30 active_files := (file.io_fd, (controller, file))::!active_files
31
32 (* Remove a file from the list of actives files. *)
33 let remove_file file =
34 active_files := List.remove_assoc file.io_fd !active_files
35
36 (* Change the controller for the given file. *)
37 let change_controller file controller =
38 remove_file file; add_file file controller
39
40 (* Return the controller currently attached to the given file. *)
41 let current_controller file =
42 fst (List.assoc file.io_fd !active_files)
43
44 (* Execute a function with `controller' attached to `file'. *)
45 (* ### controller file funct *)
46 let execute_with_other_controller controller file funct =
47 let old_controller = current_controller file in
48 change_controller file controller;
49 try
50 let result = funct () in
51 change_controller file old_controller;
52 result
53 with
54 x ->
55 change_controller file old_controller;
56 raise x
57
58 (*** The "Main Loop" ***)
59
60 let continue_main_loop =
61 ref true
62
63 let exit_main_loop _ =
64 continue_main_loop := false
65
66 (* Handle active files until `continue_main_loop' is false. *)
67 let main_loop () =
68 let old_state = !continue_main_loop in
69 try
70 continue_main_loop := true;
71 while !continue_main_loop do
72 try
73 let (input, _, _) =
74 select (List.map fst !active_files) [] [] (-1.)
75 in
76 List.iter
77 (function fd ->
78 let (funct, iochan) = (List.assoc fd !active_files) in
79 funct iochan)
80 input
81 with
82 Unix_error (EINTR, _, _) -> ()
83 done;
84 continue_main_loop := old_state
85 with
86 x ->
87 continue_main_loop := old_state;
88 raise x
89
90 (*** Managing user inputs ***)
91
92 (* Are we in interactive mode ? *)
93 let interactif = ref true
94
95 let current_prompt = ref ""
96
97 (* Where the user input come from. *)
98 let user_channel = ref std_io
99
100 let read_user_input buffer length =
101 main_loop ();
102 input !user_channel.io_in buffer 0 length
103
104 (* Stop reading user input. *)
105 let stop_user_input () =
106 remove_file !user_channel
107
108 (* Resume reading user input. *)
109 let resume_user_input () =
110 if not (List.mem_assoc !user_channel.io_fd !active_files) then begin
111 if !interactif && !Parameters.prompt then begin
112 print_string !current_prompt;
113 flush Stdlib.stdout
114 end;
115 add_file !user_channel exit_main_loop
116 end
117