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