|
0
|
1 /* The console object.
|
|
|
2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
|
|
|
3 Copyright (C) 1996 Ben Wing.
|
|
|
4
|
|
|
5 This file is part of XEmacs.
|
|
|
6
|
|
|
7 XEmacs is free software; you can redistribute it and/or modify it
|
|
|
8 under the terms of the GNU General Public License as published by the
|
|
|
9 Free Software Foundation; either version 2, or (at your option) any
|
|
|
10 later version.
|
|
|
11
|
|
|
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
|
|
|
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
15 for more details.
|
|
|
16
|
|
|
17 You should have received a copy of the GNU General Public License
|
|
|
18 along with XEmacs; see the file COPYING. If not, write to
|
|
|
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
20 Boston, MA 02111-1307, USA. */
|
|
|
21
|
|
|
22 /* Synched up with: Not in FSF. */
|
|
|
23
|
|
|
24 /* Written by Ben Wing. */
|
|
|
25
|
|
|
26 #include <config.h>
|
|
|
27 #include "lisp.h"
|
|
|
28
|
|
|
29 #include "buffer.h"
|
|
|
30 #include "console-tty.h"
|
|
|
31 #include "events.h"
|
|
|
32 #include "frame.h"
|
|
|
33 #include "redisplay.h"
|
|
|
34 #include "sysdep.h"
|
|
|
35 #include "window.h"
|
|
|
36
|
|
|
37 Lisp_Object Vconsole_list, Vselected_console;
|
|
|
38
|
|
|
39 Lisp_Object Vcreate_console_hook, Vdelete_console_hook;
|
|
|
40
|
|
|
41 Lisp_Object Qconsolep, Qconsole_live_p;
|
|
|
42 Lisp_Object Qcreate_console_hook;
|
|
|
43 Lisp_Object Qdelete_console_hook;
|
|
|
44
|
|
|
45 Lisp_Object Qsuspend_hook;
|
|
|
46 Lisp_Object Qsuspend_resume_hook;
|
|
|
47
|
|
|
48 /* This structure holds the default values of the console-local
|
|
|
49 variables defined with DEFVAR_CONSOLE_LOCAL, that have special
|
|
|
50 slots in each console. The default value occupies the same slot
|
|
|
51 in this structure as an individual console's value occupies in
|
|
|
52 that console. Setting the default value also goes through the alist
|
|
|
53 of consoles and stores into each console that does not say it has a
|
|
|
54 local value. */
|
|
|
55 Lisp_Object Vconsole_defaults;
|
|
|
56
|
|
|
57 /* This structure marks which slots in a console have corresponding
|
|
|
58 default values in console_defaults.
|
|
|
59 Each such slot has a nonzero value in this structure.
|
|
|
60 The value has only one nonzero bit.
|
|
|
61
|
|
|
62 When a console has its own local value for a slot,
|
|
|
63 the bit for that slot (found in the same slot in this structure)
|
|
|
64 is turned on in the console's local_var_flags slot.
|
|
|
65
|
|
|
66 If a slot in this structure is 0, then there is a DEFVAR_CONSOLE_LOCAL
|
|
|
67 for the slot, but there is no default value for it; the corresponding
|
|
|
68 slot in console_defaults is not used except to initialize newly-created
|
|
|
69 consoles.
|
|
|
70
|
|
|
71 If a slot is -1, then there is a DEFVAR_CONSOLE_LOCAL for it
|
|
|
72 as well as a default value which is used to initialize newly-created
|
|
|
73 consoles and as a reset-value when local-vars are killed.
|
|
|
74
|
|
|
75 If a slot is -2, there is no DEFVAR_CONSOLE_LOCAL for it.
|
|
|
76 (The slot is always local, but there's no lisp variable for it.)
|
|
|
77 The default value is only used to initialize newly-creation consoles.
|
|
|
78
|
|
|
79 If a slot is -3, then there is no DEFVAR_CONSOLE_LOCAL for it but
|
|
|
80 there is a default which is used to initialize newly-creation
|
|
|
81 consoles and as a reset-value when local-vars are killed.
|
|
|
82
|
|
|
83
|
|
|
84 */
|
|
|
85 struct console console_local_flags;
|
|
|
86
|
|
|
87 /* This structure holds the names of symbols whose values may be
|
|
|
88 console-local. It is indexed and accessed in the same way as the above. */
|
|
|
89 static Lisp_Object Vconsole_local_symbols;
|
|
|
90
|
|
|
91 DEFINE_CONSOLE_TYPE (dead);
|
|
|
92
|
|
|
93 Lisp_Object Vconsole_type_list;
|
|
|
94
|
|
|
95 MAC_DEFINE (struct console *, MTconsole_data)
|
|
|
96 MAC_DEFINE (struct console_methods *, MTcontype_meth_or_given)
|
|
|
97
|
|
|
98 console_type_entry_dynarr *the_console_type_entry_dynarr;
|
|
|
99
|
|
|
100
|
|
|
101 static Lisp_Object mark_console (Lisp_Object, void (*) (Lisp_Object));
|
|
|
102 static void print_console (Lisp_Object, Lisp_Object, int);
|
|
|
103 DEFINE_LRECORD_IMPLEMENTATION ("console", console,
|
|
|
104 mark_console, print_console, 0, 0, 0,
|
|
|
105 struct console);
|
|
|
106
|
|
|
107 static Lisp_Object
|
|
|
108 mark_console (Lisp_Object obj, void (*markobj) (Lisp_Object))
|
|
|
109 {
|
|
|
110 struct console *con = XCONSOLE (obj);
|
|
|
111
|
|
|
112 #define MARKED_SLOT(x) ((markobj) (con->x));
|
|
|
113 #include "conslots.h"
|
|
|
114 #undef MARKED_SLOT
|
|
|
115
|
|
|
116 /* Can be zero for Vconsole_defaults, Vconsole_local_symbols */
|
|
|
117 if (con->conmeths)
|
|
|
118 {
|
|
|
119 ((markobj) (con->conmeths->symbol));
|
|
|
120 MAYBE_CONMETH (con, mark_console, (con, markobj));
|
|
|
121 }
|
|
|
122
|
|
|
123 return Qnil;
|
|
|
124 }
|
|
|
125
|
|
|
126 static void
|
|
|
127 print_console (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
|
|
|
128 {
|
|
|
129 struct console *con = XCONSOLE (obj);
|
|
|
130 char buf[256];
|
|
|
131
|
|
|
132 if (print_readably)
|
|
|
133 error ("printing unreadable object #<console %s 0x%x>",
|
|
|
134 string_data (XSTRING (con->name)), con->header.uid);
|
|
|
135
|
|
|
136 sprintf (buf, "#<%s-console", !CONSOLE_LIVE_P (con) ? "dead" :
|
|
|
137 CONSOLE_TYPE_NAME (con));
|
|
|
138 write_c_string (buf, printcharfun);
|
|
|
139 if (CONSOLE_LIVE_P (con))
|
|
|
140 {
|
|
|
141 write_c_string (" on ", printcharfun);
|
|
|
142 print_internal (CONSOLE_CONNECTION (con), printcharfun, 1);
|
|
|
143 }
|
|
|
144 sprintf (buf, " 0x%x>", con->header.uid);
|
|
|
145 write_c_string (buf, printcharfun);
|
|
|
146 }
|
|
|
147
|
|
|
148
|
|
|
149 static struct console *
|
|
|
150 allocate_console (void)
|
|
|
151 {
|
|
|
152 Lisp_Object console = Qnil;
|
|
|
153 struct console *con = alloc_lcrecord (sizeof (struct console),
|
|
|
154 lrecord_console);
|
|
|
155 struct gcpro gcpro1;
|
|
|
156
|
|
|
157 copy_lcrecord (con, XCONSOLE (Vconsole_defaults));
|
|
|
158
|
|
|
159 XSETCONSOLE (console, con);
|
|
|
160 GCPRO1 (console);
|
|
|
161
|
|
|
162 con->quit_char = 7; /* C-g */
|
|
|
163 con->command_builder = allocate_command_builder (console);
|
|
|
164 con->function_key_map = Fmake_sparse_keymap (Qnil);
|
|
|
165
|
|
|
166 UNGCPRO;
|
|
|
167 return con;
|
|
|
168 }
|
|
|
169
|
|
|
170 struct console *
|
|
|
171 decode_console (Lisp_Object console)
|
|
|
172 {
|
|
|
173 if (NILP (console))
|
|
|
174 console = Fselected_console ();
|
|
|
175 /* quietly accept devices and frames for the console arg */
|
|
|
176 if (DEVICEP (console) || FRAMEP (console))
|
|
|
177 console = DEVICE_CONSOLE (decode_device (console));
|
|
|
178 CHECK_LIVE_CONSOLE (console);
|
|
|
179 return XCONSOLE (console);
|
|
|
180 }
|
|
|
181
|
|
|
182
|
|
|
183 struct console_methods *
|
|
|
184 decode_console_type (Lisp_Object type, Error_behavior errb)
|
|
|
185 {
|
|
|
186 int i;
|
|
|
187
|
|
|
188 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
|
|
|
189 {
|
|
|
190 if (EQ (type, Dynarr_at (the_console_type_entry_dynarr, i).symbol))
|
|
|
191 return Dynarr_at (the_console_type_entry_dynarr, i).meths;
|
|
|
192 }
|
|
|
193
|
|
|
194 maybe_signal_simple_error ("Invalid console type", type, Qconsole, errb);
|
|
|
195
|
|
|
196 return 0;
|
|
|
197 }
|
|
|
198
|
|
|
199 int
|
|
|
200 valid_console_type_p (Lisp_Object type)
|
|
|
201 {
|
|
|
202 if (decode_console_type (type, ERROR_ME_NOT))
|
|
|
203 return 1;
|
|
|
204 return 0;
|
|
|
205 }
|
|
|
206
|
|
|
207 DEFUN ("valid-console-type-p", Fvalid_console_type_p, Svalid_console_type_p,
|
|
|
208 1, 1, 0 /*
|
|
|
209 Given a CONSOLE-TYPE, return t if it is valid.
|
|
|
210 Valid types are 'x, 'tty, and 'stream.
|
|
|
211 */ )
|
|
|
212 (console_type)
|
|
|
213 Lisp_Object console_type;
|
|
|
214 {
|
|
|
215 if (valid_console_type_p (console_type))
|
|
|
216 return Qt;
|
|
|
217 else
|
|
|
218 return Qnil;
|
|
|
219 }
|
|
|
220
|
|
|
221 DEFUN ("console-type-list", Fconsole_type_list, Sconsole_type_list,
|
|
|
222 0, 0, 0 /*
|
|
|
223 Return a list of valid console types.
|
|
|
224 */ )
|
|
|
225 ()
|
|
|
226 {
|
|
|
227 return Fcopy_sequence (Vconsole_type_list);
|
|
|
228 }
|
|
|
229
|
|
|
230 DEFUN ("cdfw-console", Fcdfw_console, Scdfw_console, 1, 1, 0 /*
|
|
|
231 Given a console, device, frame, or window, return the associated console.
|
|
|
232 Return nil otherwise.
|
|
|
233 */ )
|
|
|
234 (obj)
|
|
|
235 Lisp_Object obj;
|
|
|
236 {
|
|
|
237 return CDFW_CONSOLE (obj);
|
|
|
238 }
|
|
|
239
|
|
|
240
|
|
|
241 DEFUN ("selected-console", Fselected_console, Sselected_console, 0, 0, 0 /*
|
|
|
242 Return the console which is currently active.
|
|
|
243 */ )
|
|
|
244 ()
|
|
|
245 {
|
|
|
246 return Vselected_console;
|
|
|
247 }
|
|
|
248
|
|
|
249 /* Called from selected_device_1(), called from selected_frame_1(),
|
|
|
250 called from Fselect_window() */
|
|
|
251 void
|
|
|
252 select_console_1 (Lisp_Object console)
|
|
|
253 {
|
|
|
254 /* perhaps this should do something more complicated */
|
|
|
255 Vselected_console = console;
|
|
|
256
|
|
|
257 /* #### Schedule this to be removed in 19.14 */
|
|
|
258 #ifdef HAVE_X_WINDOWS
|
|
|
259 if (CONSOLE_X_P (XCONSOLE (console)))
|
|
|
260 Vwindow_system = Qx;
|
|
|
261 else
|
|
|
262 #endif
|
|
|
263 #ifdef HAVE_NEXTSTEP
|
|
|
264 if (CONSOLE_NS_P (XCONSOLE (console)))
|
|
|
265 Vwindow_system = Qns;
|
|
|
266 else
|
|
|
267 #endif
|
|
|
268 Vwindow_system = Qnil;
|
|
|
269 }
|
|
|
270
|
|
|
271 DEFUN ("select-console", Fselect_console, Sselect_console, 1, 1, 0 /*
|
|
|
272 Select the console CONSOLE.
|
|
|
273 Subsequent editing commands apply to its selected device, selected frame,
|
|
|
274 and selected window. The selection of CONSOLE lasts until the next time
|
|
|
275 the user does something to select a different console, or until the next
|
|
|
276 time this function is called.
|
|
|
277 */ )
|
|
|
278 (console)
|
|
|
279 Lisp_Object console;
|
|
|
280 {
|
|
|
281 CHECK_LIVE_CONSOLE (console);
|
|
|
282
|
|
|
283 /* select the console's selected frame's selected window. This will call
|
|
|
284 selected_frame_1(). */
|
|
|
285 if (!NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (console))))
|
|
|
286 Fselect_window (FRAME_SELECTED_WINDOW (XFRAME (DEVICE_SELECTED_FRAME (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (console)))))));
|
|
|
287 else
|
|
|
288 error ("Can't select a console with no devices");
|
|
|
289 return Qnil;
|
|
|
290 }
|
|
|
291
|
|
|
292 void
|
|
|
293 set_console_last_nonminibuf_frame (struct console *con,
|
|
|
294 Lisp_Object frame)
|
|
|
295 {
|
|
|
296 con->_last_nonminibuf_frame = frame;
|
|
|
297 }
|
|
|
298
|
|
|
299 DEFUN ("consolep", Fconsolep, Sconsolep, 1, 1, 0 /*
|
|
|
300 Return non-nil if OBJECT is a console.
|
|
|
301 */ )
|
|
|
302 (object)
|
|
|
303 Lisp_Object object;
|
|
|
304 {
|
|
|
305 if (!CONSOLEP (object))
|
|
|
306 return Qnil;
|
|
|
307 return Qt;
|
|
|
308 }
|
|
|
309
|
|
|
310 DEFUN ("console-live-p", Fconsole_live_p, Sconsole_live_p, 1, 1, 0 /*
|
|
|
311 Return non-nil if OBJECT is a console that has not been deleted.
|
|
|
312 */ )
|
|
|
313 (object)
|
|
|
314 Lisp_Object object;
|
|
|
315 {
|
|
|
316 if (!CONSOLEP (object) || !CONSOLE_LIVE_P (XCONSOLE (object)))
|
|
|
317 return Qnil;
|
|
|
318 return Qt;
|
|
|
319 }
|
|
|
320
|
|
|
321 DEFUN ("console-type", Fconsole_type, Sconsole_type, 0, 1, 0 /*
|
|
|
322 Return the type of the specified console (e.g. `x' or `tty').
|
|
|
323 Value is `tty' for a tty console (a character-only terminal),
|
|
|
324 `x' for a console that is an X display,
|
|
|
325 `ns' for a console that is a NeXTstep connection (not yet implemeted),
|
|
|
326 `win32' for a console that is a Windows or Windows NT connection (not yet
|
|
|
327 implemented),
|
|
|
328 `pc' for a console that is a direct-write MS-DOS connection (not yet
|
|
|
329 implemented),
|
|
|
330 `stream' for a stream console (which acts like a stdio stream), and
|
|
|
331 `dead' for a deleted console.
|
|
|
332 */ )
|
|
|
333 (console)
|
|
|
334 Lisp_Object console;
|
|
|
335 {
|
|
|
336 /* don't call decode_console() because we want to allow for dead
|
|
|
337 consoles. */
|
|
|
338 if (NILP (console))
|
|
|
339 console = Fselected_console ();
|
|
|
340 CHECK_CONSOLE (console);
|
|
|
341 return CONSOLE_TYPE (XCONSOLE (console));
|
|
|
342 }
|
|
|
343
|
|
|
344 DEFUN ("console-name", Fconsole_name, Sconsole_name, 0, 1, 0 /*
|
|
|
345 Return the name of the specified console.
|
|
|
346 */ )
|
|
|
347 (console)
|
|
|
348 Lisp_Object console;
|
|
|
349 {
|
|
|
350 return CONSOLE_NAME (decode_console (console));
|
|
|
351 }
|
|
|
352
|
|
|
353 DEFUN ("console-connection", Fconsole_connection, Sconsole_connection,
|
|
|
354 0, 1, 0 /*
|
|
|
355 Return the connection of the specified console.
|
|
|
356 CONSOLE defaults to the selected console if omitted.
|
|
|
357 */ )
|
|
|
358 (console)
|
|
|
359 Lisp_Object console;
|
|
|
360 {
|
|
|
361 return CONSOLE_CONNECTION (decode_console (console));
|
|
|
362 }
|
|
|
363
|
|
|
364 Lisp_Object
|
|
|
365 make_console (struct console *c)
|
|
|
366 {
|
|
|
367 Lisp_Object console = Qnil;
|
|
|
368 XSETCONSOLE (console, c);
|
|
|
369 return console;
|
|
|
370 }
|
|
|
371
|
|
|
372 static Lisp_Object
|
|
|
373 semi_canonicalize_console_connection (struct console_methods *meths,
|
|
|
374 Lisp_Object name, Error_behavior errb)
|
|
|
375 {
|
|
|
376 return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_console_connection,
|
|
|
377 (name, errb), name);
|
|
|
378 }
|
|
|
379
|
|
|
380 static Lisp_Object
|
|
|
381 canonicalize_console_connection (struct console_methods *meths,
|
|
|
382 Lisp_Object name, Error_behavior errb)
|
|
|
383 {
|
|
|
384 return CONTYPE_METH_OR_GIVEN (meths, canonicalize_console_connection,
|
|
|
385 (name, errb), name);
|
|
|
386 }
|
|
|
387
|
|
|
388 static Lisp_Object
|
|
|
389 find_console_of_type (struct console_methods *meths, Lisp_Object canon)
|
|
|
390 {
|
|
|
391 Lisp_Object concons;
|
|
|
392
|
|
|
393 CONSOLE_LOOP (concons)
|
|
|
394 {
|
|
|
395 Lisp_Object console = XCAR (concons);
|
|
|
396
|
|
|
397 if (EQ (CONMETH_TYPE (meths), CONSOLE_TYPE (XCONSOLE (console)))
|
|
|
398 && !NILP (Fequal (CONSOLE_CANON_CONNECTION (XCONSOLE (console)),
|
|
|
399 canon)))
|
|
|
400 return console;
|
|
|
401 }
|
|
|
402
|
|
|
403 return Qnil;
|
|
|
404 }
|
|
|
405
|
|
|
406 DEFUN ("find-console", Ffind_console, Sfind_console, 1, 2, 0 /*
|
|
|
407 Look for an existing console attached to connection CONNECTION.
|
|
|
408 Return the console if found; otherwise, return nil.
|
|
|
409
|
|
|
410 If TYPE is specified, only return consoles of that type; otherwise,
|
|
|
411 return consoles of any type. (It is possible, although unlikely,
|
|
|
412 that two consoles of different types could have the same connection
|
|
|
413 name; in such a case, the first console found is returned.)
|
|
|
414 */ )
|
|
|
415 (connection, type)
|
|
|
416 Lisp_Object connection, type;
|
|
|
417 {
|
|
|
418 Lisp_Object canon = Qnil;
|
|
|
419 struct gcpro gcpro1;
|
|
|
420
|
|
|
421 GCPRO1 (canon);
|
|
|
422
|
|
|
423 if (!NILP (type))
|
|
|
424 {
|
|
|
425 struct console_methods *conmeths = decode_console_type (type,
|
|
|
426 ERROR_ME);
|
|
|
427 canon = canonicalize_console_connection (conmeths, connection,
|
|
|
428 ERROR_ME_NOT);
|
|
|
429 if (UNBOUNDP (canon))
|
|
|
430 RETURN_UNGCPRO (Qnil);
|
|
|
431
|
|
|
432 RETURN_UNGCPRO (find_console_of_type (conmeths, canon));
|
|
|
433 }
|
|
|
434 else
|
|
|
435 {
|
|
|
436 int i;
|
|
|
437
|
|
|
438 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
|
|
|
439 {
|
|
|
440 struct console_methods *conmeths =
|
|
|
441 Dynarr_at (the_console_type_entry_dynarr, i).meths;
|
|
|
442 canon = canonicalize_console_connection (conmeths, connection,
|
|
|
443 ERROR_ME_NOT);
|
|
|
444 if (!UNBOUNDP (canon))
|
|
|
445 {
|
|
|
446 Lisp_Object console = find_console_of_type (conmeths, canon);
|
|
|
447 if (!NILP (console))
|
|
|
448 RETURN_UNGCPRO (console);
|
|
|
449 }
|
|
|
450 }
|
|
|
451
|
|
|
452 RETURN_UNGCPRO (Qnil);
|
|
|
453 }
|
|
|
454 }
|
|
|
455
|
|
|
456 DEFUN ("get-console", Fget_console, Sget_console, 1, 2, 0 /*
|
|
|
457 Look for an existing console attached to connection CONNECTION.
|
|
|
458 Return the console if found; otherwise, signal an error.
|
|
|
459
|
|
|
460 If TYPE is specified, only return consoles of that type; otherwise,
|
|
|
461 return consoles of any type. (It is possible, although unlikely,
|
|
|
462 that two consoles of different types could have the same connection
|
|
|
463 name; in such a case, the first console found is returned.)
|
|
|
464 */ )
|
|
|
465 (connection, type)
|
|
|
466 Lisp_Object connection, type;
|
|
|
467 {
|
|
|
468 Lisp_Object console = Ffind_console (connection, type);
|
|
|
469 if (NILP (console))
|
|
|
470 {
|
|
|
471 if (NILP (type))
|
|
|
472 signal_simple_error ("No such console", connection);
|
|
|
473 else
|
|
|
474 signal_simple_error_2 ("No such console", type, connection);
|
|
|
475 }
|
|
|
476 return console;
|
|
|
477 }
|
|
|
478
|
|
|
479 Lisp_Object
|
|
|
480 create_console (Lisp_Object name, Lisp_Object type, Lisp_Object connection,
|
|
|
481 Lisp_Object props)
|
|
|
482 {
|
|
|
483 /* This function can GC */
|
|
|
484 struct console *con;
|
|
|
485 Lisp_Object console = Qnil;
|
|
|
486 struct gcpro gcpro1;
|
|
|
487
|
|
|
488 GCPRO1 (console);
|
|
|
489
|
|
|
490 console = Ffind_console (connection, type);
|
|
|
491 if (!NILP (console))
|
|
|
492 RETURN_UNGCPRO (console);
|
|
|
493
|
|
|
494 con = allocate_console ();
|
|
|
495 XSETCONSOLE (console, con);
|
|
|
496
|
|
|
497 con->conmeths = decode_console_type (type, ERROR_ME);
|
|
|
498
|
|
|
499 CONSOLE_NAME (con) = name;
|
|
|
500 CONSOLE_CONNECTION (con) =
|
|
|
501 semi_canonicalize_console_connection (con->conmeths, connection,
|
|
|
502 ERROR_ME);
|
|
|
503 CONSOLE_CANON_CONNECTION (con) =
|
|
|
504 canonicalize_console_connection (con->conmeths, connection,
|
|
|
505 ERROR_ME);
|
|
|
506
|
|
|
507 MAYBE_CONMETH (con, init_console, (con, props));
|
|
|
508
|
|
|
509 /* Do it this way so that the console list is in order of creation */
|
|
|
510 Vconsole_list = nconc2 (Vconsole_list, Fcons (console, Qnil));
|
|
|
511
|
|
|
512 if (CONMETH (con, initially_selected_for_input, (con)))
|
|
|
513 event_stream_select_console (con);
|
|
|
514
|
|
|
515 UNGCPRO;
|
|
|
516 return console;
|
|
|
517 }
|
|
|
518
|
|
|
519 void
|
|
|
520 add_entry_to_console_type_list (Lisp_Object symbol,
|
|
|
521 struct console_methods *meths)
|
|
|
522 {
|
|
|
523 struct console_type_entry entry;
|
|
|
524
|
|
|
525 entry.symbol = symbol;
|
|
|
526 entry.meths = meths;
|
|
|
527 Dynarr_add (the_console_type_entry_dynarr, entry);
|
|
|
528 Vconsole_type_list = Fcons (symbol, Vconsole_type_list);
|
|
|
529 }
|
|
|
530
|
|
|
531 /* find a console other than the selected one. Prefer non-stream
|
|
|
532 consoles over stream consoles. */
|
|
|
533
|
|
|
534 static Lisp_Object
|
|
|
535 find_other_console (Lisp_Object console)
|
|
|
536 {
|
|
|
537 Lisp_Object concons;
|
|
|
538
|
|
|
539 /* look for a non-stream console */
|
|
|
540 CONSOLE_LOOP (concons)
|
|
|
541 {
|
|
|
542 Lisp_Object con = XCAR (concons);
|
|
|
543 if (!CONSOLE_STREAM_P (XCONSOLE (con))
|
|
|
544 && !EQ (con, console)
|
|
|
545 && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))
|
|
|
546 && !NILP (DEVICE_SELECTED_FRAME
|
|
|
547 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))))))
|
|
|
548 break;
|
|
|
549 }
|
|
|
550 if (!NILP (concons))
|
|
|
551 return XCAR (concons);
|
|
|
552
|
|
|
553 /* OK, now look for a stream console */
|
|
|
554 CONSOLE_LOOP (concons)
|
|
|
555 {
|
|
|
556 Lisp_Object con = XCAR (concons);
|
|
|
557 if (!EQ (con, console)
|
|
|
558 && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))
|
|
|
559 && !NILP (DEVICE_SELECTED_FRAME
|
|
|
560 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))))))
|
|
|
561 break;
|
|
|
562 }
|
|
|
563 if (!NILP (concons))
|
|
|
564 return XCAR (concons);
|
|
|
565
|
|
|
566 /* Sorry, there ain't none */
|
|
|
567 return Qnil;
|
|
|
568 }
|
|
|
569
|
|
|
570 static int
|
|
|
571 find_nonminibuffer_frame_not_on_console_predicate (Lisp_Object frame,
|
|
|
572 void *closure)
|
|
|
573 {
|
|
|
574 Lisp_Object console;
|
|
|
575
|
|
|
576 VOID_TO_LISP (console, closure);
|
|
|
577 if (FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
|
|
|
578 return 0;
|
|
|
579 if (EQ (console, FRAME_CONSOLE (XFRAME (frame))))
|
|
|
580 return 0;
|
|
|
581 return 1;
|
|
|
582 }
|
|
|
583
|
|
|
584 static Lisp_Object
|
|
|
585 find_nonminibuffer_frame_not_on_console (Lisp_Object console)
|
|
|
586 {
|
|
|
587 return find_some_frame (find_nonminibuffer_frame_not_on_console_predicate,
|
|
|
588 LISP_TO_VOID (console));
|
|
|
589 }
|
|
|
590
|
|
|
591 /* Delete console CON.
|
|
|
592
|
|
|
593 If FORCE is non-zero, allow deletion of the only frame.
|
|
|
594
|
|
|
595 If CALLED_FROM_KILL_EMACS is non-zero, then, if
|
|
|
596 deleting the last console, just delete it,
|
|
|
597 instead of calling `save-buffers-kill-emacs'.
|
|
|
598
|
|
|
599 If FROM_IO_ERROR is non-zero, then the console is gone due
|
|
|
600 to an I/O error. This affects what happens if we exit
|
|
|
601 (we do an emergency exit instead of `save-buffers-kill-emacs'.)
|
|
|
602 */
|
|
|
603
|
|
|
604 void
|
|
|
605 delete_console_internal (struct console *con, int force,
|
|
|
606 int called_from_kill_emacs, int from_io_error)
|
|
|
607 {
|
|
|
608 /* This function can GC */
|
|
|
609 Lisp_Object console = Qnil;
|
|
|
610 struct gcpro gcpro1;
|
|
|
611
|
|
|
612 /* OK to delete an already-deleted console. */
|
|
|
613 if (!CONSOLE_LIVE_P (con))
|
|
|
614 return;
|
|
|
615
|
|
|
616 XSETCONSOLE (console, con);
|
|
|
617 GCPRO1 (console);
|
|
|
618
|
|
|
619 if (!called_from_kill_emacs)
|
|
|
620 {
|
|
|
621 int down_we_go = 0;
|
|
|
622
|
|
|
623 if ((XINT (Flength (Vconsole_list)) == 1)
|
|
|
624 /* if we just created the console, it might not be listed,
|
|
|
625 or something ... */
|
|
|
626 && !NILP (memq_no_quit (console, Vconsole_list)))
|
|
|
627 down_we_go = 1;
|
|
|
628 /* If there aren't any nonminibuffer frames that would
|
|
|
629 be left, then exit. */
|
|
|
630 else if (NILP (find_nonminibuffer_frame_not_on_console (console)))
|
|
|
631 down_we_go = 1;
|
|
|
632
|
|
|
633 if (down_we_go)
|
|
|
634 {
|
|
|
635 if (!force)
|
|
|
636 error ("Attempt to delete the only frame");
|
|
|
637 else if (from_io_error)
|
|
|
638 {
|
|
|
639 /* Mayday mayday! We're going down! */
|
|
|
640 stderr_out (" Autosaving and exiting...\n");
|
|
|
641 Vwindow_system = Qnil; /* let it lie! */
|
|
|
642 preparing_for_armageddon = 1;
|
|
|
643 Fkill_emacs (make_int (70));
|
|
|
644 }
|
|
|
645 else
|
|
|
646 {
|
|
|
647 call0 (Qsave_buffers_kill_emacs);
|
|
|
648 UNGCPRO;
|
|
|
649 /* If we get here, the user said they didn't want
|
|
|
650 to exit, so don't. */
|
|
|
651 return;
|
|
|
652 }
|
|
|
653 }
|
|
|
654 }
|
|
|
655
|
|
|
656 /* Breathe a sigh of relief. We're still alive. */
|
|
|
657
|
|
|
658 {
|
|
|
659 Lisp_Object frmcons, devcons;
|
|
|
660
|
|
|
661 /* First delete all frames without their own minibuffers,
|
|
|
662 to avoid errors coming from attempting to delete a frame
|
|
|
663 that is a surrogate for another frame.
|
|
|
664
|
|
|
665 We don't set "called_from_delete_console" because we want the
|
|
|
666 device to go ahead and get deleted if we delete the last frame
|
|
|
667 on a device. We won't run into trouble here because for any
|
|
|
668 frame without a minibuffer, there has to be another one on
|
|
|
669 the same console with a minibuffer, and we're not deleting that,
|
|
|
670 so delete_console_internal() won't get recursively called.
|
|
|
671
|
|
|
672 WRONG! With surrogate minibuffers this isn't true. Frames
|
|
|
673 with only a minibuffer are not enough to prevent
|
|
|
674 delete_frame_internal from triggering a device deletion. */
|
|
|
675 CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, con)
|
|
|
676 {
|
|
|
677 struct frame *f = XFRAME (XCAR (frmcons));
|
|
|
678 /* delete_frame_internal() might do anything such as run hooks,
|
|
|
679 so be defensive. */
|
|
|
680 if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f))
|
|
|
681 delete_frame_internal (f, 1, 1, from_io_error);
|
|
|
682
|
|
|
683 if (!CONSOLE_LIVE_P (con)) /* make sure the delete-*-hook didn't
|
|
|
684 go ahead and delete anything */
|
|
|
685 {
|
|
|
686 UNGCPRO;
|
|
|
687 return;
|
|
|
688 }
|
|
|
689 }
|
|
|
690
|
|
|
691 CONSOLE_DEVICE_LOOP (devcons, con)
|
|
|
692 {
|
|
|
693 struct device *d = XDEVICE (XCAR (devcons));
|
|
|
694 /* delete_device_internal() might do anything such as run hooks,
|
|
|
695 so be defensive. */
|
|
|
696 if (DEVICE_LIVE_P (d))
|
|
|
697 delete_device_internal (d, 1, 1, from_io_error);
|
|
|
698 if (!CONSOLE_LIVE_P (con)) /* make sure the delete-*-hook didn't
|
|
|
699 go ahead and delete anything */
|
|
|
700 {
|
|
|
701 UNGCPRO;
|
|
|
702 return;
|
|
|
703 }
|
|
|
704 }
|
|
|
705 }
|
|
|
706
|
|
|
707 CONSOLE_SELECTED_DEVICE (con) = Qnil;
|
|
|
708
|
|
|
709 /* try to select another console */
|
|
|
710
|
|
|
711 if (EQ (console, Fselected_console ()))
|
|
|
712 {
|
|
|
713 Lisp_Object other_dev = find_other_console (console);
|
|
|
714 if (!NILP (other_dev))
|
|
|
715 Fselect_console (other_dev);
|
|
|
716 else
|
|
|
717 {
|
|
|
718 /* necessary? */
|
|
|
719 Vselected_console = Qnil;
|
|
|
720 Vwindow_system = Qnil;
|
|
|
721 }
|
|
|
722 }
|
|
|
723
|
|
|
724 if (con->input_enabled)
|
|
|
725 event_stream_unselect_console (con);
|
|
|
726
|
|
|
727 MAYBE_CONMETH (con, delete_console, (con));
|
|
|
728
|
|
|
729 Vconsole_list = delq_no_quit (console, Vconsole_list);
|
|
|
730 RESET_CHANGED_SET_FLAGS;
|
|
|
731 con->conmeths = dead_console_methods;
|
|
|
732
|
|
|
733 UNGCPRO;
|
|
|
734 }
|
|
|
735
|
|
|
736 void
|
|
|
737 io_error_delete_console (Lisp_Object console)
|
|
|
738 {
|
|
|
739 delete_console_internal (XCONSOLE (console), 1, 0, 1);
|
|
|
740 }
|
|
|
741
|
|
|
742 DEFUN ("delete-console", Fdelete_console, Sdelete_console, 1, 2, 0 /*
|
|
|
743 Delete CONSOLE, permanently eliminating it from use.
|
|
|
744 Normally, you cannot delete the last non-minibuffer-only frame (you must
|
|
|
745 use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional
|
|
|
746 second argument FORCE is non-nil, you can delete the last frame. (This
|
|
|
747 will automatically call `save-buffers-kill-emacs'.)
|
|
|
748 */ )
|
|
|
749 (console, force)
|
|
|
750 Lisp_Object console, force;
|
|
|
751 {
|
|
|
752 CHECK_CONSOLE (console);
|
|
|
753 delete_console_internal (XCONSOLE (console), !NILP (force), 0, 0);
|
|
|
754 return Qnil;
|
|
|
755 }
|
|
|
756
|
|
|
757 DEFUN ("console-list", Fconsole_list, Sconsole_list, 0, 0, 0 /*
|
|
|
758 Return a list of all consoles.
|
|
|
759 */ )
|
|
|
760 ()
|
|
|
761 {
|
|
|
762 return Fcopy_sequence (Vconsole_list);
|
|
|
763 }
|
|
|
764
|
|
|
765 DEFUN ("console-device-list", Fconsole_device_list, Sconsole_device_list,
|
|
|
766 0, 1, 0 /*
|
|
|
767 Return a list of all devices on CONSOLE.
|
|
|
768 If CONSOLE is nil, the selected console will be used.
|
|
|
769 */ )
|
|
|
770 (console)
|
|
|
771 Lisp_Object console;
|
|
|
772 {
|
|
|
773 return Fcopy_sequence (CONSOLE_DEVICE_LIST (decode_console (console)));
|
|
|
774 }
|
|
|
775
|
|
|
776 DEFUN ("console-enable-input", Fconsole_enable_input, Sconsole_enable_input,
|
|
|
777 1, 1, 0 /*
|
|
|
778 Enable input on console CONSOLE.
|
|
|
779 */ )
|
|
|
780 (console)
|
|
|
781 Lisp_Object console;
|
|
|
782 {
|
|
|
783 struct console *con = decode_console (console);
|
|
|
784 if (!con->input_enabled)
|
|
|
785 event_stream_select_console (con);
|
|
|
786 return Qnil;
|
|
|
787 }
|
|
|
788
|
|
|
789 DEFUN ("console-disable-input", Fconsole_disable_input,
|
|
|
790 Sconsole_disable_input,
|
|
|
791 1, 1, 0 /*
|
|
|
792 Disable input on console CONSOLE.
|
|
|
793 */ )
|
|
|
794 (console)
|
|
|
795 Lisp_Object console;
|
|
|
796 {
|
|
|
797 struct console *con = decode_console (console);
|
|
|
798 if (con->input_enabled)
|
|
|
799 event_stream_unselect_console (con);
|
|
|
800 return Qnil;
|
|
|
801 }
|
|
|
802
|
|
|
803 DEFUN ("console-on-window-system-p", Fconsole_on_window_system_p,
|
|
|
804 Sconsole_on_window_system_p, 0, 1, 0 /*
|
|
|
805 Return non-nil if this console is on a window system.
|
|
|
806 This generally means that there is support for the mouse, the menubar,
|
|
|
807 the toolbar, glyphs, etc.
|
|
|
808 */ )
|
|
|
809 (console)
|
|
|
810 Lisp_Object console;
|
|
|
811 {
|
|
|
812 struct console *con = decode_console (console);
|
|
|
813
|
|
|
814 if (EQ (CONSOLE_TYPE (con), Qtty) || EQ (CONSOLE_TYPE (con), Qstream))
|
|
|
815 return Qnil;
|
|
|
816 return Qt;
|
|
|
817 }
|
|
|
818
|
|
|
819
|
|
|
820
|
|
|
821 /**********************************************************************/
|
|
|
822 /* Miscellaneous low-level functions */
|
|
|
823 /**********************************************************************/
|
|
|
824
|
|
|
825 static Lisp_Object
|
|
|
826 unwind_init_sys_modes (Lisp_Object console)
|
|
|
827 {
|
|
|
828 reinit_initial_console ();
|
|
|
829
|
|
|
830 if (!no_redraw_on_reenter)
|
|
|
831 {
|
|
|
832 if (CONSOLEP (console) && CONSOLE_LIVE_P (XCONSOLE (console)))
|
|
|
833 MARK_FRAME_CHANGED
|
|
|
834 (XFRAME (DEVICE_SELECTED_FRAME
|
|
|
835 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (console))))));
|
|
|
836 }
|
|
|
837 return Qnil;
|
|
|
838 }
|
|
|
839
|
|
|
840 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "" /*
|
|
|
841 Stop Emacs and return to superior process. You can resume later.
|
|
|
842 On systems that don't have job control, run a subshell instead.
|
|
|
843
|
|
|
844 If optional arg STUFFSTRING is non-nil, its characters are stuffed
|
|
|
845 to be read as terminal input by Emacs's superior shell.
|
|
|
846 Before suspending, if `suspend-hook' is bound and value is non-nil
|
|
|
847 call the value as a function of no args. Don't suspend if it returns non-nil.
|
|
|
848 Otherwise, suspend normally and after resumption call
|
|
|
849 `suspend-resume-hook' if that is bound and non-nil.
|
|
|
850
|
|
|
851 Some operating systems cannot stop the Emacs process and resume it later.
|
|
|
852 On such systems, Emacs will start a subshell and wait for it to exit.
|
|
|
853 */ )
|
|
|
854 (stuffstring)
|
|
|
855 Lisp_Object stuffstring;
|
|
|
856 {
|
|
|
857 int speccount = specpdl_depth ();
|
|
|
858 struct gcpro gcpro1;
|
|
|
859
|
|
|
860 if (!NILP (stuffstring))
|
|
|
861 CHECK_STRING (stuffstring);
|
|
|
862 GCPRO1 (stuffstring);
|
|
|
863
|
|
|
864 /* There used to be a check that the initial console is TTY.
|
|
|
865 This is bogus. Even checking to see whether any console
|
|
|
866 is a controlling terminal is not correct -- maybe
|
|
|
867 the user used the -t option or something. If we want to
|
|
|
868 suspend, then we suspend. Period. */
|
|
|
869
|
|
|
870 /* Call value of suspend-hook. */
|
|
|
871 run_hook (Qsuspend_hook);
|
|
|
872
|
|
|
873 reset_initial_console ();
|
|
|
874 /* sys_suspend can get an error if it tries to fork a subshell
|
|
|
875 and the system resources aren't available for that. */
|
|
|
876 record_unwind_protect (unwind_init_sys_modes, Vcontrolling_terminal);
|
|
|
877 stuff_buffered_input (stuffstring);
|
|
|
878 sys_suspend ();
|
|
|
879 /* the console is un-reset inside of the unwind-protect. */
|
|
|
880 unbind_to (speccount, Qnil);
|
|
|
881
|
|
|
882 #ifdef SIGWINCH
|
|
|
883 /* It is possible that a size change occurred while we were
|
|
|
884 suspended. Assume one did just to be safe. It won't hurt
|
|
|
885 anything if one didn't. */
|
|
|
886 asynch_device_change_pending++;
|
|
|
887 #endif
|
|
|
888
|
|
|
889 /* Call value of suspend-resume-hook
|
|
|
890 if it is bound and value is non-nil. */
|
|
|
891 run_hook (Qsuspend_resume_hook);
|
|
|
892
|
|
|
893 UNGCPRO;
|
|
|
894 return Qnil;
|
|
|
895 }
|
|
|
896
|
|
|
897 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
|
|
|
898 Then in any case stuff anything Emacs has read ahead and not used. */
|
|
|
899
|
|
|
900 void
|
|
|
901 stuff_buffered_input (Lisp_Object stuffstring)
|
|
|
902 {
|
|
|
903 /* stuff_char works only in BSD, versions 4.2 and up. */
|
|
|
904 #if defined (BSD)
|
|
|
905 if (!CONSOLEP (Vcontrolling_terminal) ||
|
|
|
906 !CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal)))
|
|
|
907 return;
|
|
|
908
|
|
|
909 if (STRINGP (stuffstring))
|
|
|
910 {
|
|
|
911 Extcount count;
|
|
|
912 Extbyte *p;
|
|
|
913
|
|
|
914 GET_STRING_EXT_DATA_ALLOCA (stuffstring, FORMAT_KEYBOARD, p, count);
|
|
|
915 while (count-- > 0)
|
|
|
916 stuff_char (XCONSOLE (Vcontrolling_terminal), *p++);
|
|
|
917 stuff_char (XCONSOLE (Vcontrolling_terminal), '\n');
|
|
|
918 }
|
|
|
919 /* Anything we have read ahead, put back for the shell to read. */
|
|
|
920 # if 0 /* oh, who cares about this silliness */
|
|
|
921 while (kbd_fetch_ptr != kbd_store_ptr)
|
|
|
922 {
|
|
|
923 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
|
|
|
924 kbd_fetch_ptr = kbd_buffer;
|
|
|
925 stuff_char (XCONSOLE (Vcontrolling_terminal), *kbd_fetch_ptr++);
|
|
|
926 }
|
|
|
927 # endif
|
|
|
928 #endif /* BSD */
|
|
|
929 }
|
|
|
930
|
|
|
931 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 5, 0 /*
|
|
|
932 Set mode of reading keyboard input.
|
|
|
933 First arg is ignored, for backward compatibility.
|
|
|
934 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
|
|
|
935 (no effect except in CBREAK mode).
|
|
|
936 Third arg META t means accept 8-bit input (for a Meta key).
|
|
|
937 META nil means ignore the top bit, on the assumption it is parity.
|
|
|
938 Otherwise, accept 8-bit input and don't use the top bit for Meta.
|
|
|
939 First three arguments only apply to TTY consoles.
|
|
|
940 Optional fourth arg QUIT if non-nil specifies character to use for quitting.
|
|
|
941 Optional fifth arg CONSOLE specifies console to make changes to; nil means
|
|
|
942 the selected console.
|
|
|
943 See also `current-input-mode'.
|
|
|
944 */ )
|
|
|
945 (ignored, flow, meta, quit, console)
|
|
|
946 Lisp_Object ignored, flow, meta, quit, console;
|
|
|
947 {
|
|
|
948 struct console *con = decode_console (console);
|
|
|
949 int meta_key = 1;
|
|
|
950
|
|
|
951 if (CONSOLE_TTY_P (con))
|
|
|
952 {
|
|
|
953 if (NILP (meta))
|
|
|
954 meta_key = 0;
|
|
|
955 else if (EQ (meta, Qt))
|
|
|
956 meta_key = 1;
|
|
|
957 else
|
|
|
958 meta_key = 2;
|
|
|
959 }
|
|
|
960
|
|
|
961 if (!NILP (quit))
|
|
|
962 {
|
|
|
963 CHECK_CHAR_COERCE_INT (quit);
|
|
|
964 CONSOLE_QUIT_CHAR (con) =
|
|
|
965 ((unsigned int) XCHAR (quit)) & (meta_key ? 0377 : 0177);
|
|
|
966 }
|
|
|
967
|
|
|
968 if (CONSOLE_TTY_P (con))
|
|
|
969 {
|
|
|
970 reset_one_console (con);
|
|
|
971 TTY_FLAGS (con).flow_control = !NILP (flow);
|
|
|
972 TTY_FLAGS (con).meta_key = meta_key;
|
|
|
973 init_one_console (con);
|
|
|
974 }
|
|
|
975
|
|
|
976 return Qnil;
|
|
|
977 }
|
|
|
978
|
|
|
979 DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode,
|
|
|
980 0, 1, 0 /*
|
|
|
981 Return information about the way Emacs currently reads keyboard input.
|
|
|
982 Optional arg CONSOLE specifies console to return information about; nil means
|
|
|
983 the selected console.
|
|
|
984 The value is a list of the form (nil FLOW META QUIT), where
|
|
|
985 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
|
|
|
986 terminal; this does not apply if Emacs uses interrupt-driven input.
|
|
|
987 META is t if accepting 8-bit input with 8th bit as Meta flag.
|
|
|
988 META nil means ignoring the top bit, on the assumption it is parity.
|
|
|
989 META is neither t nor nil if accepting 8-bit input and using
|
|
|
990 all 8 bits as the character code.
|
|
|
991 QUIT is the character Emacs currently uses to quit.
|
|
|
992 FLOW, and META are only meaningful for TTY consoles.
|
|
|
993 The elements of this list correspond to the arguments of
|
|
|
994 `set-input-mode'.
|
|
|
995 */ )
|
|
|
996 (console)
|
|
|
997 Lisp_Object console;
|
|
|
998 {
|
|
|
999 Lisp_Object val[4];
|
|
|
1000 struct console *con = decode_console (console);
|
|
|
1001
|
|
|
1002 val[0] = Qnil;
|
|
|
1003 val[1] = CONSOLE_TTY_P (con) && TTY_FLAGS (con).flow_control ? Qt : Qnil;
|
|
|
1004 val[2] = (!CONSOLE_TTY_P (con) || TTY_FLAGS (con).meta_key == 1) ?
|
|
|
1005 Qt : TTY_FLAGS (con).meta_key == 2 ? make_int (0) : Qnil;
|
|
|
1006 val[3] = make_char (CONSOLE_QUIT_CHAR (con));
|
|
|
1007
|
|
|
1008 return Flist (sizeof (val) / sizeof (val[0]), val);
|
|
|
1009 }
|
|
|
1010
|
|
|
1011
|
|
|
1012 /************************************************************************/
|
|
|
1013 /* initialization */
|
|
|
1014 /************************************************************************/
|
|
|
1015
|
|
|
1016 void
|
|
|
1017 syms_of_console (void)
|
|
|
1018 {
|
|
|
1019 defsubr (&Svalid_console_type_p);
|
|
|
1020 defsubr (&Sconsole_type_list);
|
|
|
1021 defsubr (&Scdfw_console);
|
|
|
1022 defsubr (&Sselected_console);
|
|
|
1023 defsubr (&Sselect_console);
|
|
|
1024 defsubr (&Sconsolep);
|
|
|
1025 defsubr (&Sconsole_live_p);
|
|
|
1026 defsubr (&Sconsole_type);
|
|
|
1027 defsubr (&Sconsole_name);
|
|
|
1028 defsubr (&Sconsole_connection);
|
|
|
1029 defsubr (&Sfind_console);
|
|
|
1030 defsubr (&Sget_console);
|
|
|
1031 defsubr (&Sdelete_console);
|
|
|
1032 defsubr (&Sconsole_list);
|
|
|
1033 defsubr (&Sconsole_device_list);
|
|
|
1034 defsubr (&Sconsole_enable_input);
|
|
|
1035 defsubr (&Sconsole_disable_input);
|
|
|
1036 defsubr (&Sconsole_on_window_system_p);
|
|
|
1037
|
|
|
1038 defsubr (&Ssuspend_emacs);
|
|
|
1039 defsubr (&Sset_input_mode);
|
|
|
1040 defsubr (&Scurrent_input_mode);
|
|
|
1041
|
|
|
1042 defsymbol (&Qconsolep, "consolep");
|
|
|
1043 defsymbol (&Qconsole_live_p, "console-live-p");
|
|
|
1044
|
|
|
1045 defsymbol (&Qcreate_console_hook, "create-console-hook");
|
|
|
1046 defsymbol (&Qdelete_console_hook, "delete-console-hook");
|
|
|
1047
|
|
|
1048 defsymbol (&Qsuspend_hook, "suspend-hook");
|
|
|
1049 defsymbol (&Qsuspend_resume_hook, "suspend-resume-hook");
|
|
|
1050 }
|
|
|
1051
|
|
|
1052 void
|
|
|
1053 console_type_create (void)
|
|
|
1054 {
|
|
|
1055 the_console_type_entry_dynarr = Dynarr_new (struct console_type_entry);
|
|
|
1056
|
|
|
1057 Vconsole_type_list = Qnil;
|
|
|
1058 staticpro (&Vconsole_type_list);
|
|
|
1059
|
|
|
1060 /* Initialize the dead console type */
|
|
|
1061 INITIALIZE_CONSOLE_TYPE (dead, "dead", "console-dead-p");
|
|
|
1062
|
|
|
1063 /* then reset the console-type lists, because `dead' is not really
|
|
|
1064 a valid console type */
|
|
|
1065 Dynarr_reset (the_console_type_entry_dynarr);
|
|
|
1066 Vconsole_type_list = Qnil;
|
|
|
1067 }
|
|
|
1068
|
|
|
1069 void
|
|
|
1070 vars_of_console (void)
|
|
|
1071 {
|
|
|
1072 DEFVAR_LISP ("create-console-hook", &Vcreate_console_hook /*
|
|
|
1073 Function or functions to call when a console is created.
|
|
|
1074 One argument, the newly-created console.
|
|
|
1075 This is called after the first frame has been created, but before
|
|
|
1076 calling the `create-device-hook' or `create-frame-hook'.
|
|
|
1077 Note that in general the console will not be selected.
|
|
|
1078 */ );
|
|
|
1079 Vcreate_console_hook = Qnil;
|
|
|
1080
|
|
|
1081 DEFVAR_LISP ("delete-console-hook", &Vdelete_console_hook /*
|
|
|
1082 Function or functions to call when a console is deleted.
|
|
|
1083 One argument, the to-be-deleted console.
|
|
|
1084 */ );
|
|
|
1085 Vdelete_console_hook = Qnil;
|
|
|
1086
|
|
|
1087 staticpro (&Vconsole_list);
|
|
|
1088 Vconsole_list = Qnil;
|
|
|
1089 staticpro (&Vselected_console);
|
|
|
1090 Vselected_console = Qnil;
|
|
|
1091
|
|
|
1092 #ifdef HAVE_WINDOW_SYSTEM
|
|
|
1093 Fprovide (intern ("window-system"));
|
|
|
1094 #endif
|
|
|
1095 }
|
|
|
1096
|
|
|
1097 /* DOC is ignored because it is snagged and recorded externally
|
|
|
1098 * by make-docfile */
|
|
|
1099 /* Declaring this stuff as const produces 'Cannot reinitialize' messages
|
|
|
1100 from SunPro C's fix-and-continue feature (a way neato feature that
|
|
|
1101 makes debugging unbelievably more bearable) */
|
|
|
1102 #define DEFVAR_CONSOLE_LOCAL(lname, field_name) \
|
|
|
1103 do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
|
|
|
1104 = { { { { lrecord_symbol_value_forward }, \
|
|
|
1105 (void *) &(console_local_flags.field_name), 69 }, \
|
|
|
1106 SYMVAL_SELECTED_CONSOLE_FORWARD }, 0 }; \
|
|
|
1107 defvar_console_local ((lname), &I_hate_C); \
|
|
|
1108 } while (0)
|
|
|
1109
|
|
|
1110 #define DEFVAR_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \
|
|
|
1111 do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
|
|
|
1112 = { { { { lrecord_symbol_value_forward }, \
|
|
|
1113 (void *) &(console_local_flags.field_name), 69 }, \
|
|
|
1114 SYMVAL_SELECTED_CONSOLE_FORWARD }, magicfun }; \
|
|
|
1115 defvar_console_local ((lname), &I_hate_C); \
|
|
|
1116 } while (0)
|
|
|
1117
|
|
|
1118 #define DEFVAR_CONST_CONSOLE_LOCAL(lname, field_name) \
|
|
|
1119 do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
|
|
|
1120 = { { { { lrecord_symbol_value_forward }, \
|
|
|
1121 (void *) &(console_local_flags.field_name), 69 }, \
|
|
|
1122 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD }, 0 }; \
|
|
|
1123 defvar_console_local ((lname), &I_hate_C); \
|
|
|
1124 } while (0)
|
|
|
1125
|
|
|
1126 #define DEFVAR_CONST_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \
|
|
|
1127 do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
|
|
|
1128 = { { { { lrecord_symbol_value_forward }, \
|
|
|
1129 (void *) &(console_local_flags.field_name), 69 }, \
|
|
|
1130 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD }, magicfun }; \
|
|
|
1131 defvar_console_local ((lname), &I_hate_C); \
|
|
|
1132 } while (0)
|
|
|
1133
|
|
|
1134 #define DEFVAR_CONSOLE_DEFAULTS(lname, field_name) \
|
|
|
1135 do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
|
|
|
1136 = { { { { lrecord_symbol_value_forward }, \
|
|
|
1137 (void *) &(console_local_flags.field_name), 69 }, \
|
|
|
1138 SYMVAL_DEFAULT_CONSOLE_FORWARD }, 0 }; \
|
|
|
1139 defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \
|
|
|
1140 } while (0)
|
|
|
1141
|
|
|
1142 #define DEFVAR_CONSOLE_DEFAULTS_MAGIC(lname, field_name, magicfun) \
|
|
|
1143 do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
|
|
|
1144 = { { { { lrecord_symbol_value_forward }, \
|
|
|
1145 (void *) &(console_local_flags.field_name), 69 }, \
|
|
|
1146 SYMVAL_DEFAULT_CONSOLE_FORWARD }, magicfun }; \
|
|
|
1147 defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \
|
|
|
1148 } while (0)
|
|
|
1149
|
|
|
1150 static void
|
|
|
1151 defvar_console_local (CONST char *namestring,
|
|
|
1152 CONST struct symbol_value_forward *m)
|
|
|
1153 {
|
|
|
1154 int offset = ((char *)symbol_value_forward_forward (m)
|
|
|
1155 - (char *)&console_local_flags);
|
|
|
1156
|
|
|
1157 defvar_mumble (namestring, m, sizeof (*m));
|
|
|
1158
|
|
|
1159 *((Lisp_Object *)(offset + (char *)XCONSOLE (Vconsole_local_symbols)))
|
|
|
1160 = intern (namestring);
|
|
|
1161 }
|
|
|
1162
|
|
|
1163 static void
|
|
|
1164 nuke_all_console_slots (struct console *con, Lisp_Object zap)
|
|
|
1165 {
|
|
|
1166 zero_lcrecord (con);
|
|
|
1167
|
|
|
1168 #define MARKED_SLOT(x) con->x = (zap);
|
|
|
1169 #include "conslots.h"
|
|
|
1170 #undef MARKED_SLOT
|
|
|
1171 }
|
|
|
1172
|
|
|
1173 void
|
|
|
1174 complex_vars_of_console (void)
|
|
|
1175 {
|
|
|
1176 /* Make sure all markable slots in console_defaults
|
|
|
1177 are initialized reasonably, so mark_console won't choke.
|
|
|
1178 */
|
|
|
1179 struct console *defs = alloc_lcrecord (sizeof (struct console),
|
|
|
1180 lrecord_console);
|
|
|
1181 struct console *syms = alloc_lcrecord (sizeof (struct console),
|
|
|
1182 lrecord_console);
|
|
|
1183
|
|
|
1184 staticpro (&Vconsole_defaults);
|
|
|
1185 staticpro (&Vconsole_local_symbols);
|
|
|
1186 XSETCONSOLE (Vconsole_defaults, defs);
|
|
|
1187 XSETCONSOLE (Vconsole_local_symbols, syms);
|
|
|
1188
|
|
|
1189 nuke_all_console_slots (syms, Qnil);
|
|
|
1190 nuke_all_console_slots (defs, Qnil);
|
|
|
1191
|
|
|
1192 /* Set up the non-nil default values of various console slots.
|
|
|
1193 Must do these before making the first console.
|
|
|
1194 */
|
|
|
1195 /* #### Anything needed here? */
|
|
|
1196
|
|
|
1197 {
|
|
|
1198 /* 0 means var is always local. Default used only at creation.
|
|
|
1199 * -1 means var is always local. Default used only at reset and
|
|
|
1200 * creation.
|
|
|
1201 * -2 means there's no lisp variable corresponding to this slot
|
|
|
1202 * and the default is only used at creation.
|
|
|
1203 * -3 means no Lisp variable. Default used only at reset and creation.
|
|
|
1204 * >0 is mask. Var is local if ((console->local_var_flags & mask) != 0)
|
|
|
1205 * Otherwise default is used.
|
|
|
1206 *
|
|
|
1207 * #### We don't currently ever reset console variables, so there
|
|
|
1208 * is no current distinction between 0 and -1, and between -2 and -3.
|
|
|
1209 */
|
|
|
1210 Lisp_Object always_local_resettable = make_int (-1);
|
|
|
1211
|
|
|
1212 #if 0 /* not used */
|
|
|
1213 Lisp_Object always_local_no_default = make_int (0);
|
|
|
1214 Lisp_Object resettable = make_int (-3);
|
|
|
1215 #endif
|
|
|
1216
|
|
|
1217 /* Assign the local-flags to the slots that have default values.
|
|
|
1218 The local flag is a bit that is used in the console
|
|
|
1219 to say that it has its own local value for the slot.
|
|
|
1220 The local flag bits are in the local_var_flags slot of the
|
|
|
1221 console. */
|
|
|
1222
|
|
|
1223 nuke_all_console_slots (&console_local_flags, make_int (-2));
|
|
|
1224 console_local_flags.defining_kbd_macro = always_local_resettable;
|
|
|
1225 console_local_flags.last_kbd_macro = always_local_resettable;
|
|
|
1226 console_local_flags.prefix_arg = always_local_resettable;
|
|
|
1227 console_local_flags.default_minibuffer_frame = always_local_resettable;
|
|
|
1228 console_local_flags.overriding_terminal_local_map =
|
|
|
1229 always_local_resettable;
|
|
|
1230
|
|
|
1231 console_local_flags.function_key_map = make_int (1);
|
|
|
1232
|
|
|
1233 /* #### Warning, 0x4000000 (that's six zeroes) is the largest number
|
|
|
1234 currently allowable due to the XINT() handling of this value.
|
|
|
1235 With some rearrangement you can get 4 more bits. */
|
|
|
1236 }
|
|
|
1237
|
|
|
1238 DEFVAR_CONSOLE_DEFAULTS ("default-function-key-map", function_key_map /*
|
|
|
1239 Default value of `function-key-map' for consoles that don't override it.
|
|
|
1240 This is the same as (default-value 'function-key-map).
|
|
|
1241 */ );
|
|
|
1242
|
|
|
1243 DEFVAR_CONSOLE_LOCAL ("function-key-map", function_key_map /*
|
|
|
1244 Keymap mapping ASCII function key sequences onto their preferred forms.
|
|
|
1245 This allows Emacs to recognize function keys sent from ASCII
|
|
|
1246 terminals at any point in a key sequence.
|
|
|
1247
|
|
|
1248 The `read-key-sequence' function replaces any subsequence bound by
|
|
|
1249 `function-key-map' with its binding. More precisely, when the active
|
|
|
1250 keymaps have no binding for the current key sequence but
|
|
|
1251 `function-key-map' binds a suffix of the sequence to a vector or string,
|
|
|
1252 `read-key-sequence' replaces the matching suffix with its binding, and
|
|
|
1253 continues with the new sequence.
|
|
|
1254
|
|
|
1255 The events that come from bindings in `function-key-map' are not
|
|
|
1256 themselves looked up in `function-key-map'.
|
|
|
1257
|
|
|
1258 For example, suppose `function-key-map' binds `ESC O P' to [f1].
|
|
|
1259 Typing `ESC O P' to `read-key-sequence' would return
|
|
|
1260 \[#<keypress-event f1>]. Typing `C-x ESC O P' would return
|
|
|
1261 \[#<keypress-event control-X> #<keypress-event f1>]. If [f1]
|
|
|
1262 were a prefix key, typing `ESC O P x' would return
|
|
|
1263 \[#<keypress-event f1> #<keypress-event x>].
|
|
|
1264 */ );
|
|
|
1265
|
|
|
1266 /* While this should be CONST it can't be because some things
|
|
|
1267 (i.e. edebug) do maninpulate it. */
|
|
|
1268 DEFVAR_CONSOLE_LOCAL ("defining-kbd-macro", defining_kbd_macro /*
|
|
|
1269 Non-nil while a console macro is being defined. Don't set this!
|
|
|
1270 */ );
|
|
|
1271
|
|
|
1272 DEFVAR_CONSOLE_LOCAL ("last-kbd-macro", last_kbd_macro /*
|
|
|
1273 Last kbd macro defined, as a vector of events; nil if none defined.
|
|
|
1274 */ );
|
|
|
1275
|
|
|
1276 DEFVAR_CONSOLE_LOCAL ("prefix-arg", prefix_arg /*
|
|
|
1277 The value of the prefix argument for the next editing command.
|
|
|
1278 It may be a number, or the symbol `-' for just a minus sign as arg,
|
|
|
1279 or a list whose car is a number for just one or more C-U's
|
|
|
1280 or nil if no argument has been specified.
|
|
|
1281
|
|
|
1282 You cannot examine this variable to find the argument for this command
|
|
|
1283 since it has been set to nil by the time you can look.
|
|
|
1284 Instead, you should use the variable `current-prefix-arg', although
|
|
|
1285 normally commands can get this prefix argument with (interactive \"P\").
|
|
|
1286 */ );
|
|
|
1287
|
|
|
1288 DEFVAR_CONSOLE_LOCAL ("default-minibuffer-frame",
|
|
|
1289 default_minibuffer_frame /*
|
|
|
1290 Minibufferless frames use this frame's minibuffer.
|
|
|
1291
|
|
|
1292 Emacs cannot create minibufferless frames unless this is set to an
|
|
|
1293 appropriate surrogate.
|
|
|
1294
|
|
|
1295 XEmacs consults this variable only when creating minibufferless
|
|
|
1296 frames; once the frame is created, it sticks with its assigned
|
|
|
1297 minibuffer, no matter what this variable is set to. This means that
|
|
|
1298 this variable doesn't necessarily say anything meaningful about the
|
|
|
1299 current set of frames, or where the minibuffer is currently being
|
|
|
1300 displayed.
|
|
|
1301 */ );
|
|
|
1302
|
|
|
1303 DEFVAR_CONSOLE_LOCAL ("overriding-terminal-local-map",
|
|
|
1304 overriding_terminal_local_map /*
|
|
|
1305 Keymap that overrides all other local keymaps, for the selected console only.
|
|
|
1306 If this variable is non-nil, it is used as a keymap instead of the
|
|
|
1307 buffer's local map, and the minor mode keymaps and text property keymaps.
|
|
|
1308 */ );
|
|
|
1309
|
|
|
1310 /* Check for DEFVAR_CONSOLE_LOCAL without initializing the corresponding
|
|
|
1311 slot of console_local_flags and vice-versa. Must be done after all
|
|
|
1312 DEFVAR_CONSOLE_LOCAL() calls. */
|
|
|
1313 #define MARKED_SLOT(slot) \
|
|
|
1314 if ((XINT (console_local_flags.slot) != -2 && \
|
|
|
1315 XINT (console_local_flags.slot) != -3) \
|
|
|
1316 != !(NILP (XCONSOLE (Vconsole_local_symbols)->slot))) \
|
|
|
1317 abort ()
|
|
|
1318 #include "conslots.h"
|
|
|
1319 #undef MARKED_SLOT
|
|
|
1320 }
|
