1 /* -*-C-*-
2
3 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
4 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
5 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts
6 Institute of Technology
7
8 This file is part of MIT/GNU Scheme.
9
10 MIT/GNU Scheme is free software; you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation; either version 2 of the License, or (at
13 your option) any later version.
14
15 MIT/GNU Scheme is distributed in the hope that it will be useful, but
16 WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 General Public License for more details.
19
20 You should have received a copy of the GNU General Public License
21 along with MIT/GNU Scheme; if not, write to the Free Software
22 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
23 USA.
24
25 */
26
27 /* Primitives to control terminal devices. */
28
29 #include "scheme.h"
30 #include "prims.h"
31 #include "osscheme.h"
32 #include "osterm.h"
33 #include "osio.h"
34
35 Tchannel
arg_terminal(int argument_number)36 arg_terminal (int argument_number)
37 {
38 Tchannel channel = (arg_channel (argument_number));
39 enum channel_type type = (OS_channel_type (channel));
40 if (! ((type == channel_type_terminal)
41 || (type == channel_type_unix_pty_master)
42 || (type == channel_type_os2_console)))
43 error_bad_range_arg (argument_number);
44 return (channel);
45 }
46
47 DEFINE_PRIMITIVE ("TERMINAL-GET-ISPEED", Prim_terminal_get_ispeed, 1, 1, 0)
48 {
49 PRIMITIVE_HEADER (1);
50 PRIMITIVE_RETURN
51 (long_to_integer (OS_terminal_get_ispeed (arg_terminal (1))));
52 }
53
54 DEFINE_PRIMITIVE ("TERMINAL-GET-OSPEED", Prim_terminal_get_ospeed, 1, 1, 0)
55 {
56 PRIMITIVE_HEADER (1);
57 PRIMITIVE_RETURN
58 (long_to_integer (OS_terminal_get_ospeed (arg_terminal (1))));
59 }
60
61 DEFINE_PRIMITIVE ("TERMINAL-SET-ISPEED", Prim_terminal_set_ispeed, 2, 2, 0)
62 {
63 PRIMITIVE_HEADER (2);
64 OS_terminal_set_ispeed ((arg_terminal (1)), (arg_baud_index (2)));
65 PRIMITIVE_RETURN (UNSPECIFIC);
66 }
67
68 DEFINE_PRIMITIVE ("TERMINAL-SET-OSPEED", Prim_terminal_set_ospeed, 2, 2, 0)
69 {
70 PRIMITIVE_HEADER (2);
71 OS_terminal_set_ospeed ((arg_terminal (1)), (arg_baud_index (2)));
72 PRIMITIVE_RETURN (UNSPECIFIC);
73 }
74
75 DEFINE_PRIMITIVE ("BAUD-INDEX->RATE", Prim_baud_index_to_rate, 1, 1, 0)
76 {
77 PRIMITIVE_HEADER (1);
78 PRIMITIVE_RETURN
79 (long_to_integer (OS_baud_index_to_rate (arg_baud_index (1))));
80 }
81
82 DEFINE_PRIMITIVE ("BAUD-RATE->INDEX", Prim_baud_rate_to_index, 1, 1, 0)
83 {
84 PRIMITIVE_HEADER (1);
85 {
86 int index = (OS_baud_rate_to_index (arg_nonnegative_integer (1)));
87 if (index < 0)
88 error_bad_range_arg (1);
89 PRIMITIVE_RETURN (long_to_integer (index));
90 }
91 }
92
93 DEFINE_PRIMITIVE ("TERMINAL-GET-STATE", Prim_terminal_get_state, 1, 1, 0)
94 {
95 PRIMITIVE_HEADER (1);
96 {
97 SCHEME_OBJECT result = (allocate_string (OS_terminal_state_size ()));
98 OS_terminal_get_state ((arg_terminal (1)), (STRING_POINTER (result)));
99 PRIMITIVE_RETURN (result);
100 }
101 }
102
103 DEFINE_PRIMITIVE ("TERMINAL-SET-STATE", Prim_terminal_set_state, 2, 2, 0)
104 {
105 PRIMITIVE_HEADER (2);
106 CHECK_ARG (2, STRING_P);
107 {
108 SCHEME_OBJECT state = (ARG_REF (2));
109 if (((unsigned int) (STRING_LENGTH (state)))
110 != (OS_terminal_state_size ()))
111 error_bad_range_arg (2);
112 OS_terminal_set_state ((arg_terminal (1)), (STRING_POINTER (state)));
113 }
114 PRIMITIVE_RETURN (UNSPECIFIC);
115 }
116
117 DEFINE_PRIMITIVE ("TERMINAL-COOKED-OUTPUT?", Prim_terminal_cooked_output_p, 1, 1,
118 "Return #F iff TERMINAL is not in cooked output mode.")
119 {
120 PRIMITIVE_HEADER (1);
121 PRIMITIVE_RETURN
122 (BOOLEAN_TO_OBJECT (OS_terminal_cooked_output_p (arg_terminal (1))));
123 }
124
125 DEFINE_PRIMITIVE ("TERMINAL-RAW-OUTPUT", Prim_terminal_raw_output, 1, 1,
126 "Put TERMINAL into raw output mode.")
127 {
128 PRIMITIVE_HEADER (1);
129 OS_terminal_raw_output (arg_terminal (1));
130 PRIMITIVE_RETURN (UNSPECIFIC);
131 }
132
133 DEFINE_PRIMITIVE ("TERMINAL-COOKED-OUTPUT", Prim_terminal_cooked_output, 1, 1,
134 "Put TERMINAL into cooked output mode.")
135 {
136 PRIMITIVE_HEADER (1);
137 OS_terminal_cooked_output (arg_terminal (1));
138 PRIMITIVE_RETURN (UNSPECIFIC);
139 }
140
141 DEFINE_PRIMITIVE ("TERMINAL-BUFFERED?", Prim_terminal_buffered_p, 1, 1,
142 "Return #F iff TERMINAL is not in buffered mode.")
143 {
144 PRIMITIVE_HEADER (1);
145 PRIMITIVE_RETURN
146 (BOOLEAN_TO_OBJECT (OS_terminal_buffered_p (arg_terminal (1))));
147 }
148
149 DEFINE_PRIMITIVE ("TERMINAL-BUFFERED", Prim_terminal_buffered, 1, 1,
150 "Put TERMINAL into buffered mode.")
151 {
152 PRIMITIVE_HEADER (1);
153 OS_terminal_buffered (arg_terminal (1));
154 PRIMITIVE_RETURN (UNSPECIFIC);
155 }
156
157 DEFINE_PRIMITIVE ("TERMINAL-NONBUFFERED", Prim_terminal_nonbuffered, 1, 1,
158 "Put TERMINAL into nonbuffered mode.")
159 {
160 PRIMITIVE_HEADER (1);
161 OS_terminal_nonbuffered (arg_terminal (1));
162 PRIMITIVE_RETURN (UNSPECIFIC);
163 }
164
165 DEFINE_PRIMITIVE ("TERMINAL-FLUSH-INPUT", Prim_terminal_flush_input, 1, 1,
166 "Discard any characters in TERMINAL's input buffer.")
167 {
168 PRIMITIVE_HEADER (1);
169 OS_terminal_flush_input (arg_terminal (1));
170 PRIMITIVE_RETURN (UNSPECIFIC);
171 }
172
173 DEFINE_PRIMITIVE ("TERMINAL-FLUSH-OUTPUT", Prim_terminal_flush_output, 1, 1,
174 "Discard any characters in TERMINAL's output buffer.")
175 {
176 PRIMITIVE_HEADER (1);
177 OS_terminal_flush_output (arg_terminal (1));
178 PRIMITIVE_RETURN (UNSPECIFIC);
179 }
180
181 DEFINE_PRIMITIVE ("TERMINAL-DRAIN-OUTPUT", Prim_terminal_drain_output, 1, 1,
182 "Wait until all characters in TERMINAL's output buffer have been sent.")
183 {
184 PRIMITIVE_HEADER (1);
185 OS_terminal_drain_output (arg_terminal (1));
186 PRIMITIVE_RETURN (UNSPECIFIC);
187 }
188
189 DEFINE_PRIMITIVE ("OS-JOB-CONTROL?", Prim_os_job_control_p, 0, 0, 0)
190 {
191 PRIMITIVE_HEADER (0);
192 PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (OS_job_control_p ()));
193 }
194
195 DEFINE_PRIMITIVE ("HAVE-PTYS?", Prim_have_ptys_p, 0, 0, 0)
196 {
197 PRIMITIVE_HEADER (0);
198 PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (OS_have_ptys_p ()));
199 }
200