Mercurial > hg > xemacs-beta
annotate src/console.c @ 5117:3742ea8250b5 ben-lisp-object ben-lisp-object-final-ws-year-2005
Checking in final CVS version of workspace 'ben-lisp-object'
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Sat, 26 Dec 2009 00:20:27 -0600 |
parents | facf3239ba30 |
children | e0db3c197671 |
rev | line source |
---|---|
428 | 1 /* The console object. |
2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. | |
800 | 3 Copyright (C) 1996, 2002 Ben Wing. |
428 | 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 | |
853 | 24 /* Written by Ben Wing, late 1995?. |
25 suspend-console, set-input-mode, and related stuff largely based on | |
26 existing code. | |
27 */ | |
428 | 28 |
29 #include <config.h> | |
30 #include "lisp.h" | |
31 | |
32 #include "buffer.h" | |
872 | 33 #include "console-impl.h" |
34 #include "device-impl.h" | |
428 | 35 #include "events.h" |
872 | 36 #include "frame-impl.h" |
428 | 37 #include "redisplay.h" |
38 #include "sysdep.h" | |
39 #include "window.h" | |
40 | |
1204 | 41 #include "console-stream-impl.h" |
872 | 42 #ifdef HAVE_TTY |
43 #include "console-tty-impl.h" | |
44 #endif | |
800 | 45 |
2340 | 46 #ifdef HAVE_TTY |
47 #define USED_IF_TTY(decl) decl | |
48 #else | |
49 #define USED_IF_TTY(decl) UNUSED (decl) | |
50 #endif | |
51 | |
428 | 52 Lisp_Object Vconsole_list, Vselected_console; |
53 | |
54 Lisp_Object Vcreate_console_hook, Vdelete_console_hook; | |
55 | |
56 Lisp_Object Qconsolep, Qconsole_live_p; | |
57 Lisp_Object Qcreate_console_hook; | |
58 Lisp_Object Qdelete_console_hook; | |
59 | |
60 Lisp_Object Qsuspend_hook; | |
61 Lisp_Object Qsuspend_resume_hook; | |
62 | |
63 /* This structure holds the default values of the console-local | |
64 variables defined with DEFVAR_CONSOLE_LOCAL, that have special | |
65 slots in each console. The default value occupies the same slot | |
66 in this structure as an individual console's value occupies in | |
67 that console. Setting the default value also goes through the | |
68 list of consoles and stores into each console that does not say | |
69 it has a local value. */ | |
70 Lisp_Object Vconsole_defaults; | |
71 static void *console_defaults_saved_slots; | |
72 | |
73 /* This structure marks which slots in a console have corresponding | |
74 default values in console_defaults. | |
75 Each such slot has a nonzero value in this structure. | |
76 The value has only one nonzero bit. | |
77 | |
78 When a console has its own local value for a slot, | |
79 the bit for that slot (found in the same slot in this structure) | |
80 is turned on in the console's local_var_flags slot. | |
81 | |
82 If a slot in this structure is 0, then there is a DEFVAR_CONSOLE_LOCAL | |
83 for the slot, but there is no default value for it; the corresponding | |
84 slot in console_defaults is not used except to initialize newly-created | |
85 consoles. | |
86 | |
87 If a slot is -1, then there is a DEFVAR_CONSOLE_LOCAL for it | |
88 as well as a default value which is used to initialize newly-created | |
89 consoles and as a reset-value when local-vars are killed. | |
90 | |
91 If a slot is -2, there is no DEFVAR_CONSOLE_LOCAL for it. | |
92 (The slot is always local, but there's no lisp variable for it.) | |
93 The default value is only used to initialize newly-creation consoles. | |
94 | |
95 If a slot is -3, then there is no DEFVAR_CONSOLE_LOCAL for it but | |
96 there is a default which is used to initialize newly-creation | |
97 consoles and as a reset-value when local-vars are killed. | |
98 | |
99 | |
100 */ | |
101 struct console console_local_flags; | |
102 | |
103 /* This structure holds the names of symbols whose values may be | |
104 console-local. It is indexed and accessed in the same way as the above. */ | |
105 static Lisp_Object Vconsole_local_symbols; | |
106 static void *console_local_symbols_saved_slots; | |
107 | |
108 DEFINE_CONSOLE_TYPE (dead); | |
109 | |
110 Lisp_Object Vconsole_type_list; | |
111 | |
112 console_type_entry_dynarr *the_console_type_entry_dynarr; | |
113 | |
114 | |
934 | 115 |
1204 | 116 static const struct memory_description console_data_description_1 []= { |
117 #ifdef HAVE_TTY | |
2551 | 118 { XD_BLOCK_PTR, tty_console, 1, { &tty_console_data_description} }, |
1204 | 119 #endif |
2551 | 120 { XD_BLOCK_PTR, stream_console, 1, { &stream_console_data_description} }, |
934 | 121 { XD_END } |
122 }; | |
123 | |
1204 | 124 static const struct sized_memory_description console_data_description = { |
125 sizeof (void *), console_data_description_1 | |
934 | 126 }; |
127 | |
1204 | 128 static const struct memory_description console_description [] = { |
934 | 129 { XD_INT, offsetof (struct console, contype) }, |
1204 | 130 #define MARKED_SLOT(x) { XD_LISP_OBJECT, offsetof (struct console, x) }, |
131 #include "conslots.h" | |
2367 | 132 { XD_BLOCK_PTR, offsetof (struct console, conmeths), 1, |
2551 | 133 { &console_methods_description } }, |
934 | 134 { XD_UNION, offsetof (struct console, console_data), |
2551 | 135 XD_INDIRECT (0, 0), { &console_data_description } }, |
934 | 136 { XD_END } |
137 }; | |
138 | |
428 | 139 static Lisp_Object |
140 mark_console (Lisp_Object obj) | |
141 { | |
142 struct console *con = XCONSOLE (obj); | |
143 | |
1204 | 144 #define MARKED_SLOT(x) mark_object (con->x); |
428 | 145 #include "conslots.h" |
146 | |
147 /* Can be zero for Vconsole_defaults, Vconsole_local_symbols */ | |
148 if (con->conmeths) | |
149 { | |
150 mark_object (con->conmeths->symbol); | |
151 MAYBE_CONMETH (con, mark_console, (con)); | |
152 } | |
153 | |
154 return Qnil; | |
155 } | |
156 | |
157 static void | |
2286 | 158 print_console (Lisp_Object obj, Lisp_Object printcharfun, |
159 int UNUSED (escapeflag)) | |
428 | 160 { |
161 struct console *con = XCONSOLE (obj); | |
162 | |
163 if (print_readably) | |
563 | 164 printing_unreadable_object ("#<console %s 0x%x>", |
165 XSTRING_DATA (con->name), con->header.uid); | |
428 | 166 |
800 | 167 write_fmt_string (printcharfun, "#<%s-console", |
168 !CONSOLE_LIVE_P (con) ? "dead" : CONSOLE_TYPE_NAME (con)); | |
440 | 169 if (CONSOLE_LIVE_P (con) && !NILP (CONSOLE_CONNECTION (con))) |
800 | 170 write_fmt_string_lisp (printcharfun, " on %S", 1, |
171 CONSOLE_CONNECTION (con)); | |
172 write_fmt_string (printcharfun, " 0x%x>", con->header.uid); | |
428 | 173 } |
174 | |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
175 DEFINE_NONDUMPABLE_LISP_OBJECT ("console", console, mark_console, |
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
176 print_console, 0, 0, 0, |
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
177 console_description, |
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
178 struct console); |
428 | 179 |
1204 | 180 |
181 static void | |
182 set_quit_events (struct console *con, Lisp_Object key) | |
183 { | |
184 /* Make sure to run Fcharacter_to_event() *BEFORE* setting QUIT_CHAR, | |
185 so that nothing is changed when invalid values trigger an error! */ | |
186 con->quit_event = Fcharacter_to_event (key, Qnil, wrap_console (con), Qnil); | |
187 con->quit_char = key; | |
188 con->critical_quit_event = Fcopy_event (con->quit_event, Qnil); | |
189 upshift_event (con->critical_quit_event); | |
190 } | |
191 | |
428 | 192 static struct console * |
1204 | 193 allocate_console (Lisp_Object type) |
428 | 194 { |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
195 Lisp_Object console = ALLOC_LISP_OBJECT (console); |
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
196 struct console *con = XCONSOLE (console); |
428 | 197 struct gcpro gcpro1; |
198 | |
3017 | 199 COPY_LCRECORD (con, XCONSOLE (Vconsole_defaults)); |
428 | 200 |
201 GCPRO1 (console); | |
202 | |
1204 | 203 con->conmeths = decode_console_type (type, ERROR_ME); |
204 con->contype = get_console_variant (type); | |
771 | 205 con->command_builder = allocate_command_builder (console, 1); |
428 | 206 con->function_key_map = Fmake_sparse_keymap (Qnil); |
1204 | 207 set_quit_events (con, make_char (7)); /* C-g */ |
428 | 208 |
209 UNGCPRO; | |
210 return con; | |
211 } | |
212 | |
213 struct console * | |
214 decode_console (Lisp_Object console) | |
215 { | |
216 if (NILP (console)) | |
217 console = Fselected_console (); | |
218 /* quietly accept devices and frames for the console arg */ | |
219 if (DEVICEP (console) || FRAMEP (console)) | |
220 console = DEVICE_CONSOLE (decode_device (console)); | |
221 CHECK_LIVE_CONSOLE (console); | |
222 return XCONSOLE (console); | |
223 } | |
224 | |
225 | |
226 struct console_methods * | |
578 | 227 decode_console_type (Lisp_Object type, Error_Behavior errb) |
428 | 228 { |
229 int i; | |
230 | |
231 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++) | |
232 if (EQ (type, Dynarr_at (the_console_type_entry_dynarr, i).symbol)) | |
233 return Dynarr_at (the_console_type_entry_dynarr, i).meths; | |
234 | |
563 | 235 maybe_invalid_constant ("Invalid console type", type, Qconsole, errb); |
428 | 236 |
237 return 0; | |
238 } | |
239 | |
934 | 240 enum console_variant |
241 get_console_variant (Lisp_Object type) | |
242 { | |
243 if (EQ (type, Qtty)) | |
1204 | 244 return tty_console; |
934 | 245 |
246 if (EQ (type, Qgtk)) | |
1204 | 247 return gtk_console; |
934 | 248 |
249 if (EQ (type, Qx)) | |
1204 | 250 return x_console; |
934 | 251 |
252 if (EQ (type, Qmswindows)) | |
1204 | 253 return mswindows_console; |
934 | 254 |
1346 | 255 if (EQ (type, Qmsprinter)) |
256 return msprinter_console; | |
257 | |
934 | 258 if (EQ (type, Qstream)) |
1204 | 259 return stream_console; |
934 | 260 |
2500 | 261 ABORT (); /* should never happen */ |
934 | 262 return dead_console; |
263 } | |
264 | |
428 | 265 int |
266 valid_console_type_p (Lisp_Object type) | |
267 { | |
268 return decode_console_type (type, ERROR_ME_NOT) != 0; | |
269 } | |
270 | |
271 DEFUN ("valid-console-type-p", Fvalid_console_type_p, 1, 1, 0, /* | |
444 | 272 Return t if CONSOLE-TYPE is a valid console type. |
3025 | 273 Valid types are `x', `tty', `mswindows', `msprinter', `gtk', and `stream'. |
428 | 274 */ |
275 (console_type)) | |
276 { | |
277 return valid_console_type_p (console_type) ? Qt : Qnil; | |
278 } | |
279 | |
280 DEFUN ("console-type-list", Fconsole_type_list, 0, 0, 0, /* | |
281 Return a list of valid console types. | |
282 */ | |
283 ()) | |
284 { | |
285 return Fcopy_sequence (Vconsole_type_list); | |
286 } | |
287 | |
288 DEFUN ("cdfw-console", Fcdfw_console, 1, 1, 0, /* | |
289 Given a console, device, frame, or window, return the associated console. | |
290 Return nil otherwise. | |
291 */ | |
444 | 292 (object)) |
428 | 293 { |
444 | 294 return CDFW_CONSOLE (object); |
428 | 295 } |
296 | |
872 | 297 int |
298 console_live_p (struct console *c) | |
299 { | |
300 return CONSOLE_LIVE_P (c); | |
301 } | |
302 | |
303 Lisp_Object | |
304 console_device_list (struct console *c) | |
305 { | |
306 return CONSOLE_DEVICE_LIST (c); | |
307 } | |
308 | |
428 | 309 |
310 DEFUN ("selected-console", Fselected_console, 0, 0, 0, /* | |
311 Return the console which is currently active. | |
312 */ | |
313 ()) | |
314 { | |
315 return Vselected_console; | |
316 } | |
317 | |
318 /* Called from selected_device_1(), called from selected_frame_1(), | |
319 called from Fselect_window() */ | |
320 void | |
321 select_console_1 (Lisp_Object console) | |
322 { | |
323 /* perhaps this should do something more complicated */ | |
324 Vselected_console = console; | |
325 | |
326 /* #### Schedule this to be removed in 19.14 */ | |
327 #ifdef HAVE_X_WINDOWS | |
328 if (CONSOLE_X_P (XCONSOLE (console))) | |
329 Vwindow_system = Qx; | |
330 else | |
331 #endif | |
462 | 332 #ifdef HAVE_GTK |
333 if (CONSOLE_GTK_P (XCONSOLE (console))) | |
334 Vwindow_system = Qgtk; | |
335 else | |
336 #endif | |
428 | 337 #ifdef HAVE_MS_WINDOWS |
338 if (CONSOLE_MSWINDOWS_P (XCONSOLE (console))) | |
339 Vwindow_system = Qmswindows; | |
340 else | |
341 #endif | |
342 Vwindow_system = Qnil; | |
343 } | |
344 | |
345 DEFUN ("select-console", Fselect_console, 1, 1, 0, /* | |
346 Select the console CONSOLE. | |
347 Subsequent editing commands apply to its selected device, selected frame, | |
348 and selected window. The selection of CONSOLE lasts until the next time | |
349 the user does something to select a different console, or until the next | |
350 time this function is called. | |
351 */ | |
352 (console)) | |
353 { | |
354 Lisp_Object device; | |
355 | |
356 CHECK_LIVE_CONSOLE (console); | |
357 | |
358 device = CONSOLE_SELECTED_DEVICE (XCONSOLE (console)); | |
359 if (!NILP (device)) | |
360 { | |
361 struct device *d = XDEVICE (device); | |
362 Lisp_Object frame = DEVICE_SELECTED_FRAME (d); | |
363 if (!NILP (frame)) | |
364 { | |
365 struct frame *f = XFRAME(frame); | |
366 Fselect_window (FRAME_SELECTED_WINDOW (f), Qnil); | |
367 } | |
368 else | |
563 | 369 invalid_operation ("Can't select console with no frames", Qunbound); |
428 | 370 } |
371 else | |
563 | 372 invalid_operation ("Can't select a console with no devices", Qunbound); |
428 | 373 return Qnil; |
374 } | |
375 | |
376 void | |
377 set_console_last_nonminibuf_frame (struct console *con, | |
378 Lisp_Object frame) | |
379 { | |
380 con->last_nonminibuf_frame = frame; | |
381 } | |
382 | |
383 DEFUN ("consolep", Fconsolep, 1, 1, 0, /* | |
384 Return non-nil if OBJECT is a console. | |
385 */ | |
386 (object)) | |
387 { | |
388 return CONSOLEP (object) ? Qt : Qnil; | |
389 } | |
390 | |
391 DEFUN ("console-live-p", Fconsole_live_p, 1, 1, 0, /* | |
392 Return non-nil if OBJECT is a console that has not been deleted. | |
393 */ | |
394 (object)) | |
395 { | |
396 return CONSOLEP (object) && CONSOLE_LIVE_P (XCONSOLE (object)) ? Qt : Qnil; | |
397 } | |
398 | |
399 DEFUN ("console-type", Fconsole_type, 0, 1, 0, /* | |
444 | 400 Return the console type (e.g. `x' or `tty') of CONSOLE. |
1346 | 401 Value is |
402 `tty' for a tty console (a character-only terminal), | |
428 | 403 `x' for a console that is an X display, |
1346 | 404 `mswindows' for a console that is an MS Windows connection, |
405 `msprinter' for a console that is an MS Windows printer connection, | |
406 `gtk' for a console that is a GTK connection, | |
428 | 407 `stream' for a stream console (which acts like a stdio stream), and |
408 `dead' for a deleted console. | |
409 */ | |
410 (console)) | |
411 { | |
412 /* don't call decode_console() because we want to allow for dead | |
413 consoles. */ | |
414 if (NILP (console)) | |
415 console = Fselected_console (); | |
416 CHECK_CONSOLE (console); | |
417 return CONSOLE_TYPE (XCONSOLE (console)); | |
418 } | |
419 | |
420 DEFUN ("console-name", Fconsole_name, 0, 1, 0, /* | |
444 | 421 Return the name of CONSOLE. |
428 | 422 */ |
423 (console)) | |
424 { | |
425 return CONSOLE_NAME (decode_console (console)); | |
426 } | |
427 | |
428 DEFUN ("console-connection", Fconsole_connection, 0, 1, 0, /* | |
429 Return the connection of the specified console. | |
430 CONSOLE defaults to the selected console if omitted. | |
431 */ | |
432 (console)) | |
433 { | |
434 return CONSOLE_CONNECTION (decode_console (console)); | |
435 } | |
436 | |
437 static Lisp_Object | |
438 semi_canonicalize_console_connection (struct console_methods *meths, | |
578 | 439 Lisp_Object name, Error_Behavior errb) |
428 | 440 { |
440 | 441 if (HAS_CONTYPE_METH_P (meths, semi_canonicalize_console_connection)) |
442 return CONTYPE_METH (meths, semi_canonicalize_console_connection, | |
443 (name, errb)); | |
444 else | |
445 return CONTYPE_METH_OR_GIVEN (meths, canonicalize_console_connection, | |
446 (name, errb), name); | |
428 | 447 } |
448 | |
449 static Lisp_Object | |
450 canonicalize_console_connection (struct console_methods *meths, | |
578 | 451 Lisp_Object name, Error_Behavior errb) |
428 | 452 { |
440 | 453 if (HAS_CONTYPE_METH_P (meths, canonicalize_console_connection)) |
454 return CONTYPE_METH (meths, canonicalize_console_connection, | |
455 (name, errb)); | |
456 else | |
457 return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_console_connection, | |
458 (name, errb), name); | |
428 | 459 } |
460 | |
461 static Lisp_Object | |
462 find_console_of_type (struct console_methods *meths, Lisp_Object canon) | |
463 { | |
464 Lisp_Object concons; | |
465 | |
466 CONSOLE_LOOP (concons) | |
467 { | |
468 Lisp_Object console = XCAR (concons); | |
469 | |
470 if (EQ (CONMETH_TYPE (meths), CONSOLE_TYPE (XCONSOLE (console))) | |
471 && internal_equal (CONSOLE_CANON_CONNECTION (XCONSOLE (console)), | |
472 canon, 0)) | |
473 return console; | |
474 } | |
475 | |
476 return Qnil; | |
477 } | |
478 | |
479 DEFUN ("find-console", Ffind_console, 1, 2, 0, /* | |
480 Look for an existing console attached to connection CONNECTION. | |
481 Return the console if found; otherwise, return nil. | |
482 | |
483 If TYPE is specified, only return consoles of that type; otherwise, | |
484 return consoles of any type. (It is possible, although unlikely, | |
485 that two consoles of different types could have the same connection | |
486 name; in such a case, the first console found is returned.) | |
487 */ | |
488 (connection, type)) | |
489 { | |
490 Lisp_Object canon = Qnil; | |
491 struct gcpro gcpro1; | |
492 | |
493 GCPRO1 (canon); | |
494 | |
495 if (!NILP (type)) | |
496 { | |
497 struct console_methods *conmeths = decode_console_type (type, ERROR_ME); | |
498 canon = canonicalize_console_connection (conmeths, connection, | |
499 ERROR_ME_NOT); | |
500 if (UNBOUNDP (canon)) | |
501 RETURN_UNGCPRO (Qnil); | |
502 | |
503 RETURN_UNGCPRO (find_console_of_type (conmeths, canon)); | |
504 } | |
505 else | |
506 { | |
507 int i; | |
508 | |
509 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++) | |
510 { | |
511 struct console_methods *conmeths = | |
512 Dynarr_at (the_console_type_entry_dynarr, i).meths; | |
513 canon = canonicalize_console_connection (conmeths, connection, | |
514 ERROR_ME_NOT); | |
515 if (!UNBOUNDP (canon)) | |
516 { | |
517 Lisp_Object console = find_console_of_type (conmeths, canon); | |
518 if (!NILP (console)) | |
519 RETURN_UNGCPRO (console); | |
520 } | |
521 } | |
522 | |
523 RETURN_UNGCPRO (Qnil); | |
524 } | |
525 } | |
526 | |
527 DEFUN ("get-console", Fget_console, 1, 2, 0, /* | |
528 Look for an existing console attached to connection CONNECTION. | |
529 Return the console if found; otherwise, signal an error. | |
530 | |
531 If TYPE is specified, only return consoles of that type; otherwise, | |
532 return consoles of any type. (It is possible, although unlikely, | |
533 that two consoles of different types could have the same connection | |
534 name; in such a case, the first console found is returned.) | |
535 */ | |
536 (connection, type)) | |
537 { | |
538 Lisp_Object console = Ffind_console (connection, type); | |
539 if (NILP (console)) | |
540 { | |
541 if (NILP (type)) | |
563 | 542 invalid_argument ("No such console", connection); |
428 | 543 else |
563 | 544 invalid_argument_2 ("No such console", type, connection); |
428 | 545 } |
546 return console; | |
547 } | |
548 | |
549 Lisp_Object | |
550 create_console (Lisp_Object name, Lisp_Object type, Lisp_Object connection, | |
551 Lisp_Object props) | |
552 { | |
553 /* This function can GC */ | |
554 struct console *con; | |
555 Lisp_Object console; | |
556 struct gcpro gcpro1; | |
557 | |
558 console = Ffind_console (connection, type); | |
559 if (!NILP (console)) | |
560 return console; | |
561 | |
1204 | 562 con = allocate_console (type); |
793 | 563 console = wrap_console (con); |
428 | 564 |
565 GCPRO1 (console); | |
566 | |
567 CONSOLE_NAME (con) = name; | |
568 CONSOLE_CONNECTION (con) = | |
569 semi_canonicalize_console_connection (con->conmeths, connection, | |
570 ERROR_ME); | |
571 CONSOLE_CANON_CONNECTION (con) = | |
572 canonicalize_console_connection (con->conmeths, connection, | |
573 ERROR_ME); | |
574 | |
575 MAYBE_CONMETH (con, init_console, (con, props)); | |
576 | |
577 /* Do it this way so that the console list is in order of creation */ | |
578 Vconsole_list = nconc2 (Vconsole_list, Fcons (console, Qnil)); | |
853 | 579 note_object_created (console); |
428 | 580 |
440 | 581 if (CONMETH_OR_GIVEN (con, initially_selected_for_input, (con), 0)) |
428 | 582 event_stream_select_console (con); |
583 | |
584 UNGCPRO; | |
585 return console; | |
586 } | |
587 | |
588 void | |
589 add_entry_to_console_type_list (Lisp_Object symbol, | |
590 struct console_methods *meths) | |
591 { | |
592 struct console_type_entry entry; | |
593 | |
594 entry.symbol = symbol; | |
595 entry.meths = meths; | |
596 Dynarr_add (the_console_type_entry_dynarr, entry); | |
597 Vconsole_type_list = Fcons (symbol, Vconsole_type_list); | |
598 } | |
599 | |
600 /* find a console other than the selected one. Prefer non-stream | |
601 consoles over stream consoles. */ | |
602 | |
603 static Lisp_Object | |
604 find_other_console (Lisp_Object console) | |
605 { | |
606 Lisp_Object concons; | |
607 | |
608 /* look for a non-stream console */ | |
609 CONSOLE_LOOP (concons) | |
610 { | |
611 Lisp_Object con = XCAR (concons); | |
612 if (!CONSOLE_STREAM_P (XCONSOLE (con)) | |
613 && !EQ (con, console) | |
614 && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))) | |
615 && !NILP (DEVICE_SELECTED_FRAME | |
616 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))))) | |
617 break; | |
618 } | |
619 if (!NILP (concons)) | |
620 return XCAR (concons); | |
621 | |
622 /* OK, now look for a stream console */ | |
623 CONSOLE_LOOP (concons) | |
624 { | |
625 Lisp_Object con = XCAR (concons); | |
626 if (!EQ (con, console) | |
627 && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))) | |
628 && !NILP (DEVICE_SELECTED_FRAME | |
629 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))))) | |
630 break; | |
631 } | |
632 if (!NILP (concons)) | |
633 return XCAR (concons); | |
634 | |
635 /* Sorry, there ain't none */ | |
636 return Qnil; | |
637 } | |
638 | |
639 static int | |
640 find_nonminibuffer_frame_not_on_console_predicate (Lisp_Object frame, | |
641 void *closure) | |
642 { | |
643 Lisp_Object console; | |
644 | |
826 | 645 console = VOID_TO_LISP (closure); |
428 | 646 if (FRAME_MINIBUF_ONLY_P (XFRAME (frame))) |
647 return 0; | |
648 if (EQ (console, FRAME_CONSOLE (XFRAME (frame)))) | |
649 return 0; | |
650 return 1; | |
651 } | |
652 | |
653 static Lisp_Object | |
654 find_nonminibuffer_frame_not_on_console (Lisp_Object console) | |
655 { | |
656 return find_some_frame (find_nonminibuffer_frame_not_on_console_predicate, | |
657 LISP_TO_VOID (console)); | |
658 } | |
659 | |
617 | 660 static void |
661 nuke_all_console_slots (struct console *con, Lisp_Object zap) | |
662 { | |
3017 | 663 ZERO_LCRECORD (con); |
617 | 664 |
1204 | 665 #define MARKED_SLOT(x) con->x = zap; |
617 | 666 #include "conslots.h" |
667 } | |
668 | |
428 | 669 /* Delete console CON. |
670 | |
671 If FORCE is non-zero, allow deletion of the only frame. | |
672 | |
673 If CALLED_FROM_KILL_EMACS is non-zero, then, if | |
674 deleting the last console, just delete it, | |
675 instead of calling `save-buffers-kill-emacs'. | |
676 | |
677 If FROM_IO_ERROR is non-zero, then the console is gone due | |
678 to an I/O error. This affects what happens if we exit | |
679 (we do an emergency exit instead of `save-buffers-kill-emacs'.) | |
680 */ | |
681 | |
682 void | |
683 delete_console_internal (struct console *con, int force, | |
684 int called_from_kill_emacs, int from_io_error) | |
685 { | |
686 /* This function can GC */ | |
687 Lisp_Object console; | |
688 struct gcpro gcpro1; | |
689 | |
690 /* OK to delete an already-deleted console. */ | |
691 if (!CONSOLE_LIVE_P (con)) | |
692 return; | |
693 | |
793 | 694 console = wrap_console (con); |
853 | 695 |
696 if (!force) | |
697 check_allowed_operation (OPERATION_DELETE_OBJECT, console, Qnil); | |
698 | |
428 | 699 GCPRO1 (console); |
700 | |
701 if (!called_from_kill_emacs) | |
702 { | |
703 int down_we_go = 0; | |
704 | |
705 if ((XINT (Flength (Vconsole_list)) == 1) | |
706 /* if we just created the console, it might not be listed, | |
707 or something ... */ | |
708 && !NILP (memq_no_quit (console, Vconsole_list))) | |
709 down_we_go = 1; | |
710 /* If there aren't any nonminibuffer frames that would | |
711 be left, then exit. */ | |
712 else if (NILP (find_nonminibuffer_frame_not_on_console (console))) | |
713 down_we_go = 1; | |
714 | |
715 if (down_we_go) | |
716 { | |
717 if (!force) | |
563 | 718 invalid_operation ("Attempt to delete the only frame", Qunbound); |
428 | 719 else if (from_io_error) |
720 { | |
721 /* Mayday mayday! We're going down! */ | |
722 stderr_out (" Autosaving and exiting...\n"); | |
723 Vwindow_system = Qnil; /* let it lie! */ | |
724 preparing_for_armageddon = 1; | |
725 Fkill_emacs (make_int (70)); | |
726 } | |
727 else | |
728 { | |
729 call0 (Qsave_buffers_kill_emacs); | |
730 UNGCPRO; | |
731 /* If we get here, the user said they didn't want | |
732 to exit, so don't. */ | |
733 return; | |
734 } | |
735 } | |
736 } | |
737 | |
738 /* Breathe a sigh of relief. We're still alive. */ | |
739 | |
740 { | |
741 Lisp_Object frmcons, devcons; | |
742 | |
743 /* First delete all frames without their own minibuffers, | |
744 to avoid errors coming from attempting to delete a frame | |
745 that is a surrogate for another frame. | |
746 | |
747 We don't set "called_from_delete_console" because we want the | |
748 device to go ahead and get deleted if we delete the last frame | |
749 on a device. We won't run into trouble here because for any | |
750 frame without a minibuffer, there has to be another one on | |
751 the same console with a minibuffer, and we're not deleting that, | |
752 so delete_console_internal() won't get recursively called. | |
753 | |
754 WRONG! With surrogate minibuffers this isn't true. Frames | |
755 with only a minibuffer are not enough to prevent | |
756 delete_frame_internal from triggering a device deletion. */ | |
757 CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, con) | |
758 { | |
759 struct frame *f = XFRAME (XCAR (frmcons)); | |
760 /* delete_frame_internal() might do anything such as run hooks, | |
761 so be defensive. */ | |
762 if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f)) | |
763 delete_frame_internal (f, 1, 1, from_io_error); | |
764 | |
765 if (!CONSOLE_LIVE_P (con)) /* make sure the delete-*-hook didn't | |
766 go ahead and delete anything */ | |
767 { | |
768 UNGCPRO; | |
769 return; | |
770 } | |
771 } | |
772 | |
773 CONSOLE_DEVICE_LOOP (devcons, con) | |
774 { | |
775 struct device *d = XDEVICE (XCAR (devcons)); | |
776 /* delete_device_internal() might do anything such as run hooks, | |
777 so be defensive. */ | |
778 if (DEVICE_LIVE_P (d)) | |
779 delete_device_internal (d, 1, 1, from_io_error); | |
780 if (!CONSOLE_LIVE_P (con)) /* make sure the delete-*-hook didn't | |
781 go ahead and delete anything */ | |
782 { | |
783 UNGCPRO; | |
784 return; | |
785 } | |
786 } | |
787 } | |
788 | |
789 CONSOLE_SELECTED_DEVICE (con) = Qnil; | |
790 | |
791 /* try to select another console */ | |
792 | |
793 if (EQ (console, Fselected_console ())) | |
794 { | |
795 Lisp_Object other_dev = find_other_console (console); | |
796 if (!NILP (other_dev)) | |
797 Fselect_console (other_dev); | |
798 else | |
799 { | |
800 /* necessary? */ | |
801 Vselected_console = Qnil; | |
802 Vwindow_system = Qnil; | |
803 } | |
804 } | |
805 | |
806 if (con->input_enabled) | |
807 event_stream_unselect_console (con); | |
808 | |
809 MAYBE_CONMETH (con, delete_console, (con)); | |
810 | |
811 Vconsole_list = delq_no_quit (console, Vconsole_list); | |
617 | 812 |
428 | 813 RESET_CHANGED_SET_FLAGS; |
617 | 814 |
815 /* Nobody should be accessing anything in this object any more, and | |
816 making all Lisp_Objects Qnil allows for better GC'ing in case a | |
817 pointer to the dead console continues to hang around. Zero all | |
818 other structs in case someone tries to access something through | |
819 them. */ | |
820 nuke_all_console_slots (con, Qnil); | |
428 | 821 con->conmeths = dead_console_methods; |
1204 | 822 con->contype = dead_console; |
853 | 823 note_object_deleted (console); |
428 | 824 |
825 UNGCPRO; | |
826 } | |
827 | |
828 void | |
829 io_error_delete_console (Lisp_Object console) | |
830 { | |
831 delete_console_internal (XCONSOLE (console), 1, 0, 1); | |
832 } | |
833 | |
834 DEFUN ("delete-console", Fdelete_console, 1, 2, 0, /* | |
835 Delete CONSOLE, permanently eliminating it from use. | |
836 Normally, you cannot delete the last non-minibuffer-only frame (you must | |
837 use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional | |
838 second argument FORCE is non-nil, you can delete the last frame. (This | |
839 will automatically call `save-buffers-kill-emacs'.) | |
840 */ | |
841 (console, force)) | |
842 { | |
843 CHECK_CONSOLE (console); | |
844 delete_console_internal (XCONSOLE (console), !NILP (force), 0, 0); | |
845 return Qnil; | |
846 } | |
847 | |
848 DEFUN ("console-list", Fconsole_list, 0, 0, 0, /* | |
849 Return a list of all consoles. | |
850 */ | |
851 ()) | |
852 { | |
853 return Fcopy_sequence (Vconsole_list); | |
854 } | |
855 | |
856 DEFUN ("console-device-list", Fconsole_device_list, 0, 1, 0, /* | |
857 Return a list of all devices on CONSOLE. | |
444 | 858 If CONSOLE is nil, the selected console is used. |
428 | 859 */ |
860 (console)) | |
861 { | |
862 return Fcopy_sequence (CONSOLE_DEVICE_LIST (decode_console (console))); | |
863 } | |
864 | |
865 DEFUN ("console-enable-input", Fconsole_enable_input, 1, 1, 0, /* | |
866 Enable input on console CONSOLE. | |
867 */ | |
868 (console)) | |
869 { | |
870 struct console *con = decode_console (console); | |
871 if (!con->input_enabled) | |
872 event_stream_select_console (con); | |
873 return Qnil; | |
874 } | |
875 | |
876 DEFUN ("console-disable-input", Fconsole_disable_input, 1, 1, 0, /* | |
877 Disable input on console CONSOLE. | |
878 */ | |
879 (console)) | |
880 { | |
881 struct console *con = decode_console (console); | |
882 if (con->input_enabled) | |
883 event_stream_unselect_console (con); | |
884 return Qnil; | |
885 } | |
886 | |
887 DEFUN ("console-on-window-system-p", Fconsole_on_window_system_p, 0, 1, 0, /* | |
444 | 888 Return t if CONSOLE is on a window system. |
889 If CONSOLE is nil, the selected console is used. | |
428 | 890 This generally means that there is support for the mouse, the menubar, |
891 the toolbar, glyphs, etc. | |
892 */ | |
893 (console)) | |
894 { | |
895 Lisp_Object type = CONSOLE_TYPE (decode_console (console)); | |
896 | |
897 return !EQ (type, Qtty) && !EQ (type, Qstream) ? Qt : Qnil; | |
898 } | |
899 | |
900 | |
901 | |
902 /**********************************************************************/ | |
903 /* Miscellaneous low-level functions */ | |
904 /**********************************************************************/ | |
905 | |
906 static Lisp_Object | |
907 unwind_init_sys_modes (Lisp_Object console) | |
908 { | |
909 reinit_initial_console (); | |
910 | |
911 if (!no_redraw_on_reenter && | |
912 CONSOLEP (console) && | |
913 CONSOLE_LIVE_P (XCONSOLE (console))) | |
914 { | |
915 struct frame *f = | |
916 XFRAME (DEVICE_SELECTED_FRAME | |
917 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (console))))); | |
918 MARK_FRAME_CHANGED (f); | |
919 } | |
920 return Qnil; | |
921 } | |
922 | |
923 DEFUN ("suspend-emacs", Fsuspend_emacs, 0, 1, "", /* | |
924 Stop Emacs and return to superior process. You can resume later. | |
925 On systems that don't have job control, run a subshell instead. | |
926 | |
927 If optional arg STUFFSTRING is non-nil, its characters are stuffed | |
928 to be read as terminal input by Emacs's superior shell. | |
929 | |
930 Before suspending, run the normal hook `suspend-hook'. | |
931 After resumption run the normal hook `suspend-resume-hook'. | |
932 | |
933 Some operating systems cannot stop the Emacs process and resume it later. | |
934 On such systems, Emacs will start a subshell and wait for it to exit. | |
935 */ | |
936 (stuffstring)) | |
937 { | |
938 int speccount = specpdl_depth (); | |
939 struct gcpro gcpro1; | |
940 | |
941 if (!NILP (stuffstring)) | |
942 CHECK_STRING (stuffstring); | |
943 GCPRO1 (stuffstring); | |
944 | |
945 /* There used to be a check that the initial console is TTY. | |
946 This is bogus. Even checking to see whether any console | |
947 is a controlling terminal is not correct -- maybe | |
948 the user used the -t option or something. If we want to | |
949 suspend, then we suspend. Period. */ | |
950 | |
951 /* Call value of suspend-hook. */ | |
952 run_hook (Qsuspend_hook); | |
953 | |
954 reset_initial_console (); | |
955 /* sys_suspend can get an error if it tries to fork a subshell | |
956 and the system resources aren't available for that. */ | |
957 record_unwind_protect (unwind_init_sys_modes, Vcontrolling_terminal); | |
958 stuff_buffered_input (stuffstring); | |
959 sys_suspend (); | |
960 /* the console is un-reset inside of the unwind-protect. */ | |
771 | 961 unbind_to (speccount); |
428 | 962 |
963 #ifdef SIGWINCH | |
964 /* It is possible that a size change occurred while we were | |
965 suspended. Assume one did just to be safe. It won't hurt | |
966 anything if one didn't. */ | |
967 asynch_device_change_pending++; | |
968 #endif | |
969 | |
970 /* Call value of suspend-resume-hook | |
971 if it is bound and value is non-nil. */ | |
972 run_hook (Qsuspend_resume_hook); | |
973 | |
974 UNGCPRO; | |
975 return Qnil; | |
976 } | |
977 | |
978 /* If STUFFSTRING is a string, stuff its contents as pending terminal input. | |
979 Then in any case stuff anything Emacs has read ahead and not used. */ | |
980 | |
981 void | |
2286 | 982 stuff_buffered_input ( |
983 #ifdef BSD | |
984 Lisp_Object stuffstring | |
985 #else | |
986 Lisp_Object UNUSED (stuffstring) | |
987 #endif | |
988 ) | |
428 | 989 { |
990 /* stuff_char works only in BSD, versions 4.2 and up. */ | |
991 #if defined (BSD) | |
992 if (!CONSOLEP (Vcontrolling_terminal) || | |
993 !CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal))) | |
994 return; | |
995 | |
996 if (STRINGP (stuffstring)) | |
997 { | |
665 | 998 Bytecount count; |
428 | 999 Extbyte *p; |
1000 | |
440 | 1001 TO_EXTERNAL_FORMAT (LISP_STRING, stuffstring, |
1002 ALLOCA, (p, count), | |
1003 Qkeyboard); | |
428 | 1004 while (count-- > 0) |
1005 stuff_char (XCONSOLE (Vcontrolling_terminal), *p++); | |
1006 stuff_char (XCONSOLE (Vcontrolling_terminal), '\n'); | |
1007 } | |
1008 /* Anything we have read ahead, put back for the shell to read. */ | |
1009 # if 0 /* oh, who cares about this silliness */ | |
1010 while (kbd_fetch_ptr != kbd_store_ptr) | |
1011 { | |
1012 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE) | |
1013 kbd_fetch_ptr = kbd_buffer; | |
1014 stuff_char (XCONSOLE (Vcontrolling_terminal), *kbd_fetch_ptr++); | |
1015 } | |
1016 # endif | |
1017 #endif /* BSD */ | |
1018 } | |
1019 | |
1020 DEFUN ("suspend-console", Fsuspend_console, 0, 1, "", /* | |
1021 Suspend a console. For tty consoles, it sends a signal to suspend | |
1022 the process in charge of the tty, and removes the devices and | |
1023 frames of that console from the display. | |
1024 | |
1025 If optional arg CONSOLE is non-nil, it is the console to be suspended. | |
1026 Otherwise it is assumed to be the selected console. | |
1027 | |
1028 Some operating systems cannot stop processes and resume them later. | |
1029 On such systems, who knows what will happen. | |
1030 */ | |
2340 | 1031 (USED_IF_TTY (console))) |
428 | 1032 { |
1033 #ifdef HAVE_TTY | |
1034 struct console *con = decode_console (console); | |
1035 | |
1036 if (CONSOLE_TTY_P (con)) | |
1037 { | |
1038 /* | |
1039 * hide all the unhidden frames so the display code won't update | |
1040 * them while the console is suspended. | |
1041 */ | |
1042 Lisp_Object device = CONSOLE_SELECTED_DEVICE (con); | |
1043 if (!NILP (device)) | |
1044 { | |
1045 struct device *d = XDEVICE (device); | |
1046 Lisp_Object frame_list = DEVICE_FRAME_LIST (d); | |
1047 while (CONSP (frame_list)) | |
1048 { | |
1049 struct frame *f = XFRAME (XCAR (frame_list)); | |
1050 if (FRAME_REPAINT_P (f)) | |
1051 f->visible = -1; | |
1052 frame_list = XCDR (frame_list); | |
1053 } | |
1054 } | |
1055 reset_one_console (con); | |
1056 event_stream_unselect_console (con); | |
1057 sys_suspend_process (XINT (Fconsole_tty_controlling_process (console))); | |
1058 } | |
1059 #endif /* HAVE_TTY */ | |
1060 | |
1061 return Qnil; | |
1062 } | |
1063 | |
1064 DEFUN ("resume-console", Fresume_console, 1, 1, "", /* | |
1065 Re-initialize a previously suspended console. | |
1066 For tty consoles, do stuff to the tty to make it sane again. | |
1067 */ | |
2340 | 1068 (USED_IF_TTY (console))) |
428 | 1069 { |
1070 #ifdef HAVE_TTY | |
1071 struct console *con = decode_console (console); | |
1072 | |
1073 if (CONSOLE_TTY_P (con)) | |
1074 { | |
1075 /* raise the selected frame */ | |
1076 Lisp_Object device = CONSOLE_SELECTED_DEVICE (con); | |
1077 if (!NILP (device)) | |
1078 { | |
1079 struct device *d = XDEVICE (device); | |
1080 Lisp_Object frame = DEVICE_SELECTED_FRAME (d); | |
1081 if (!NILP (frame)) | |
1082 { | |
1083 /* force the frame to be cleared */ | |
1084 SET_FRAME_CLEAR (XFRAME (frame)); | |
1085 Fraise_frame (frame); | |
1086 } | |
1087 } | |
1088 init_one_console (con); | |
1089 event_stream_select_console (con); | |
1090 #ifdef SIGWINCH | |
1091 /* The same as in Fsuspend_emacs: it is possible that a size | |
1092 change occurred while we were suspended. Assume one did just | |
1093 to be safe. It won't hurt anything if one didn't. */ | |
1094 asynch_device_change_pending++; | |
1095 #endif | |
1096 } | |
1097 #endif /* HAVE_TTY */ | |
1098 | |
1099 return Qnil; | |
1100 } | |
1101 | |
1102 DEFUN ("set-input-mode", Fset_input_mode, 3, 5, 0, /* | |
1103 Set mode of reading keyboard input. | |
1204 | 1104 First arg (formerly INTERRUPT-INPUT) is ignored, for backward compatibility. |
428 | 1105 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal |
1106 (no effect except in CBREAK mode). | |
1107 Third arg META t means accept 8-bit input (for a Meta key). | |
1108 META nil means ignore the top bit, on the assumption it is parity. | |
1109 Otherwise, accept 8-bit input and don't use the top bit for Meta. | |
1110 First three arguments only apply to TTY consoles. | |
1111 Optional fourth arg QUIT if non-nil specifies character to use for quitting. | |
1112 Optional fifth arg CONSOLE specifies console to make changes to; nil means | |
1113 the selected console. | |
1114 See also `current-input-mode'. | |
1115 */ | |
2340 | 1116 (UNUSED (ignored), USED_IF_TTY (flow), meta, quit, console)) |
428 | 1117 { |
1118 struct console *con = decode_console (console); | |
1119 int meta_key = (!CONSOLE_TTY_P (con) ? 1 : | |
1120 EQ (meta, Qnil) ? 0 : | |
1121 EQ (meta, Qt) ? 1 : | |
1122 2); | |
1123 | |
1124 if (!NILP (quit)) | |
1125 { | |
1204 | 1126 if (CHAR_OR_CHAR_INTP (quit) && !meta_key) |
1127 set_quit_events (con, make_char (XCHAR_OR_CHAR_INT (quit) & 0177)); | |
1128 else | |
1129 set_quit_events (con, quit); | |
428 | 1130 } |
1131 | |
1132 #ifdef HAVE_TTY | |
1133 if (CONSOLE_TTY_P (con)) | |
1134 { | |
1135 reset_one_console (con); | |
1136 TTY_FLAGS (con).flow_control = !NILP (flow); | |
1137 TTY_FLAGS (con).meta_key = meta_key; | |
1138 init_one_console (con); | |
444 | 1139 MARK_FRAME_CHANGED (XFRAME (CONSOLE_SELECTED_FRAME (con))); |
428 | 1140 } |
1141 #endif | |
1142 | |
1143 return Qnil; | |
1144 } | |
1145 | |
1146 DEFUN ("current-input-mode", Fcurrent_input_mode, 0, 1, 0, /* | |
1147 Return information about the way Emacs currently reads keyboard input. | |
1148 Optional arg CONSOLE specifies console to return information about; nil means | |
1149 the selected console. | |
1150 The value is a list of the form (nil FLOW META QUIT), where | |
1151 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the | |
1152 terminal; this does not apply if Emacs uses interrupt-driven input. | |
1153 META is t if accepting 8-bit input with 8th bit as Meta flag. | |
1154 META nil means ignoring the top bit, on the assumption it is parity. | |
1155 META is neither t nor nil if accepting 8-bit input and using | |
1156 all 8 bits as the character code. | |
1157 QUIT is the character Emacs currently uses to quit. | |
1158 FLOW, and META are only meaningful for TTY consoles. | |
1159 The elements of this list correspond to the arguments of | |
1160 `set-input-mode'. | |
1161 */ | |
1162 (console)) | |
1163 { | |
1164 struct console *con = decode_console (console); | |
1204 | 1165 Lisp_Object flow, meta; |
428 | 1166 |
1167 #ifdef HAVE_TTY | |
1168 flow = CONSOLE_TTY_P (con) && TTY_FLAGS (con).flow_control ? Qt : Qnil; | |
1169 meta = (!CONSOLE_TTY_P (con) ? Qt : | |
1170 TTY_FLAGS (con).meta_key == 1 ? Qt : | |
1171 TTY_FLAGS (con).meta_key == 2 ? Qzero : | |
1172 Qnil); | |
1173 #else | |
1174 flow = Qnil; | |
1175 meta = Qt; | |
1176 #endif | |
1177 | |
1204 | 1178 return list4 (Qnil, flow, meta, CONSOLE_QUIT_CHAR (con)); |
428 | 1179 } |
1180 | |
1181 | |
1182 /************************************************************************/ | |
1183 /* initialization */ | |
1184 /************************************************************************/ | |
1185 | |
1186 void | |
1187 syms_of_console (void) | |
1188 { | |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1189 INIT_LISP_OBJECT (console); |
442 | 1190 |
428 | 1191 DEFSUBR (Fvalid_console_type_p); |
1192 DEFSUBR (Fconsole_type_list); | |
1193 DEFSUBR (Fcdfw_console); | |
1194 DEFSUBR (Fselected_console); | |
1195 DEFSUBR (Fselect_console); | |
1196 DEFSUBR (Fconsolep); | |
1197 DEFSUBR (Fconsole_live_p); | |
1198 DEFSUBR (Fconsole_type); | |
1199 DEFSUBR (Fconsole_name); | |
1200 DEFSUBR (Fconsole_connection); | |
1201 DEFSUBR (Ffind_console); | |
1202 DEFSUBR (Fget_console); | |
1203 DEFSUBR (Fdelete_console); | |
1204 DEFSUBR (Fconsole_list); | |
1205 DEFSUBR (Fconsole_device_list); | |
1206 DEFSUBR (Fconsole_enable_input); | |
1207 DEFSUBR (Fconsole_disable_input); | |
1208 DEFSUBR (Fconsole_on_window_system_p); | |
1209 DEFSUBR (Fsuspend_console); | |
1210 DEFSUBR (Fresume_console); | |
1211 | |
1212 DEFSUBR (Fsuspend_emacs); | |
1213 DEFSUBR (Fset_input_mode); | |
1214 DEFSUBR (Fcurrent_input_mode); | |
1215 | |
563 | 1216 DEFSYMBOL (Qconsolep); |
1217 DEFSYMBOL (Qconsole_live_p); | |
428 | 1218 |
563 | 1219 DEFSYMBOL (Qcreate_console_hook); |
1220 DEFSYMBOL (Qdelete_console_hook); | |
428 | 1221 |
563 | 1222 DEFSYMBOL (Qsuspend_hook); |
1223 DEFSYMBOL (Qsuspend_resume_hook); | |
428 | 1224 } |
1225 | |
1204 | 1226 static const struct memory_description cte_description_1[] = { |
440 | 1227 { XD_LISP_OBJECT, offsetof (console_type_entry, symbol) }, |
2551 | 1228 { XD_BLOCK_PTR, offsetof (console_type_entry, meths), 1, |
1229 { &console_methods_description } }, | |
428 | 1230 { XD_END } |
1231 }; | |
1232 | |
1204 | 1233 static const struct sized_memory_description cte_description = { |
440 | 1234 sizeof (console_type_entry), |
428 | 1235 cte_description_1 |
1236 }; | |
1237 | |
1204 | 1238 static const struct memory_description cted_description_1[] = { |
440 | 1239 XD_DYNARR_DESC (console_type_entry_dynarr, &cte_description), |
428 | 1240 { XD_END } |
1241 }; | |
1242 | |
1204 | 1243 const struct sized_memory_description cted_description = { |
440 | 1244 sizeof (console_type_entry_dynarr), |
428 | 1245 cted_description_1 |
1246 }; | |
1247 | |
1204 | 1248 static const struct memory_description console_methods_description_1[] = { |
440 | 1249 { XD_LISP_OBJECT, offsetof (struct console_methods, symbol) }, |
1250 { XD_LISP_OBJECT, offsetof (struct console_methods, predicate_symbol) }, | |
1251 { XD_LISP_OBJECT, offsetof (struct console_methods, image_conversion_list) }, | |
428 | 1252 { XD_END } |
1253 }; | |
1254 | |
1204 | 1255 const struct sized_memory_description console_methods_description = { |
440 | 1256 sizeof (struct console_methods), |
428 | 1257 console_methods_description_1 |
1258 }; | |
1259 | |
1260 | |
1261 void | |
1262 console_type_create (void) | |
1263 { | |
1264 the_console_type_entry_dynarr = Dynarr_new (console_type_entry); | |
2367 | 1265 dump_add_root_block_ptr (&the_console_type_entry_dynarr, &cted_description); |
428 | 1266 |
1267 Vconsole_type_list = Qnil; | |
1268 staticpro (&Vconsole_type_list); | |
1269 | |
1270 /* Initialize the dead console type */ | |
1271 INITIALIZE_CONSOLE_TYPE (dead, "dead", "console-dead-p"); | |
1272 | |
1273 /* then reset the console-type lists, because `dead' is not really | |
1274 a valid console type */ | |
1275 Dynarr_reset (the_console_type_entry_dynarr); | |
1276 Vconsole_type_list = Qnil; | |
1277 } | |
1278 | |
1279 void | |
1280 reinit_vars_of_console (void) | |
1281 { | |
1282 staticpro_nodump (&Vconsole_list); | |
1283 Vconsole_list = Qnil; | |
1284 staticpro_nodump (&Vselected_console); | |
1285 Vselected_console = Qnil; | |
1286 } | |
1287 | |
1288 void | |
1289 vars_of_console (void) | |
1290 { | |
1291 DEFVAR_LISP ("create-console-hook", &Vcreate_console_hook /* | |
1292 Function or functions to call when a console is created. | |
1293 One argument, the newly-created console. | |
1294 This is called after the first frame has been created, but before | |
1295 calling the `create-device-hook' or `create-frame-hook'. | |
1296 Note that in general the console will not be selected. | |
1297 */ ); | |
1298 Vcreate_console_hook = Qnil; | |
1299 | |
1300 DEFVAR_LISP ("delete-console-hook", &Vdelete_console_hook /* | |
1301 Function or functions to call when a console is deleted. | |
1302 One argument, the to-be-deleted console. | |
1303 */ ); | |
1304 Vdelete_console_hook = Qnil; | |
1305 | |
1306 #ifdef HAVE_WINDOW_SYSTEM | |
1307 Fprovide (intern ("window-system")); | |
1308 #endif | |
1309 } | |
1310 | |
643 | 1311 /* The docstrings for DEFVAR_* are recorded externally by make-docfile. */ |
2720 | 1312 #ifdef MC_ALLOC |
1313 #define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magic_fun) \ | |
1314 do { \ | |
1315 struct symbol_value_forward *I_hate_C = \ | |
1316 alloc_lrecord_type (struct symbol_value_forward, \ | |
1317 &lrecord_symbol_value_forward); \ | |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1318 /*mcpro ((Lisp_Object) I_hate_C);*/ \ |
2720 | 1319 \ |
1320 I_hate_C->magic.value = &(console_local_flags.field_name); \ | |
1321 I_hate_C->magic.type = forward_type; \ | |
1322 I_hate_C->magicfun = magic_fun; \ | |
1323 \ | |
1324 MARK_LRECORD_AS_LISP_READONLY (I_hate_C); \ | |
1325 \ | |
1326 { \ | |
1327 int offset = ((char *)symbol_value_forward_forward (I_hate_C) \ | |
1328 - (char *)&console_local_flags); \ | |
1329 \ | |
1330 defvar_magic (lname, I_hate_C); \ | |
1331 \ | |
1332 *((Lisp_Object *)(offset + (char *)XCONSOLE (Vconsole_local_symbols))) \ | |
1333 = intern (lname); \ | |
1334 } \ | |
1335 } while (0) | |
1336 #else /* not MC_ALLOC */ | |
617 | 1337 #define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magicfun) \ |
1338 do { \ | |
1339 static const struct symbol_value_forward I_hate_C = \ | |
1340 { /* struct symbol_value_forward */ \ | |
1341 { /* struct symbol_value_magic */ \ | |
3024 | 1342 { /* struct old_lcrecord_header */ \ |
617 | 1343 { /* struct lrecord_header */ \ |
1344 lrecord_type_symbol_value_forward, /* lrecord_type_index */ \ | |
1345 1, /* mark bit */ \ | |
1346 1, /* c_readonly bit */ \ | |
1347 1 /* lisp_readonly bit */ \ | |
1348 }, \ | |
1349 0, /* next */ \ | |
1350 0, /* uid */ \ | |
1351 0 /* free */ \ | |
1352 }, \ | |
1353 &(console_local_flags.field_name), \ | |
1354 forward_type \ | |
1355 }, \ | |
1356 magicfun \ | |
1357 }; \ | |
1358 \ | |
1359 { \ | |
1360 int offset = ((char *)symbol_value_forward_forward (&I_hate_C) \ | |
1361 - (char *)&console_local_flags); \ | |
1362 \ | |
1363 defvar_magic (lname, &I_hate_C); \ | |
1364 \ | |
1365 *((Lisp_Object *)(offset + (char *)XCONSOLE (Vconsole_local_symbols))) \ | |
1366 = intern (lname); \ | |
1367 } \ | |
428 | 1368 } while (0) |
2720 | 1369 #endif /* not MC_ALLOC */ |
428 | 1370 |
1371 #define DEFVAR_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \ | |
1372 DEFVAR_CONSOLE_LOCAL_1 (lname, field_name, \ | |
1373 SYMVAL_SELECTED_CONSOLE_FORWARD, magicfun) | |
1374 #define DEFVAR_CONSOLE_LOCAL(lname, field_name) \ | |
1375 DEFVAR_CONSOLE_LOCAL_MAGIC (lname, field_name, 0) | |
1376 #define DEFVAR_CONST_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \ | |
1377 DEFVAR_CONSOLE_LOCAL_1 (lname, field_name, \ | |
1378 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD, magicfun) | |
1379 #define DEFVAR_CONST_CONSOLE_LOCAL(lname, field_name) \ | |
1380 DEFVAR_CONST_CONSOLE_LOCAL_MAGIC (lname, field_name, 0) | |
1381 | |
1382 #define DEFVAR_CONSOLE_DEFAULTS_MAGIC(lname, field_name, magicfun) \ | |
1383 DEFVAR_SYMVAL_FWD(lname, &(console_local_flags.field_name), \ | |
1384 SYMVAL_DEFAULT_CONSOLE_FORWARD, magicfun) | |
1385 #define DEFVAR_CONSOLE_DEFAULTS(lname, field_name) \ | |
1386 DEFVAR_CONSOLE_DEFAULTS_MAGIC (lname, field_name, 0) | |
1387 | |
1388 static void | |
1389 common_init_complex_vars_of_console (void) | |
1390 { | |
1391 /* Make sure all markable slots in console_defaults | |
1392 are initialized reasonably, so mark_console won't choke. | |
1393 */ | |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1394 Lisp_Object defobj = ALLOC_LISP_OBJECT (console); |
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1395 struct console *defs = XCONSOLE (defobj); |
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1396 Lisp_Object symobj = ALLOC_LISP_OBJECT (console); |
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1397 struct console *syms = XCONSOLE (symobj); |
428 | 1398 |
1399 staticpro_nodump (&Vconsole_defaults); | |
1400 staticpro_nodump (&Vconsole_local_symbols); | |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1401 Vconsole_defaults = defobj; |
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1402 Vconsole_local_symbols = symobj; |
428 | 1403 |
1404 nuke_all_console_slots (syms, Qnil); | |
1405 nuke_all_console_slots (defs, Qnil); | |
1406 | |
1407 /* Set up the non-nil default values of various console slots. | |
1408 Must do these before making the first console. | |
1409 */ | |
1204 | 1410 |
1411 /* ... Nothing here for the moment. | |
1412 #### Console-local variables should probably be eliminated.*/ | |
428 | 1413 |
1414 { | |
1415 /* 0 means var is always local. Default used only at creation. | |
1416 * -1 means var is always local. Default used only at reset and | |
1417 * creation. | |
1418 * -2 means there's no lisp variable corresponding to this slot | |
1419 * and the default is only used at creation. | |
1420 * -3 means no Lisp variable. Default used only at reset and creation. | |
1421 * >0 is mask. Var is local if ((console->local_var_flags & mask) != 0) | |
1422 * Otherwise default is used. | |
1423 * | |
1424 * #### We don't currently ever reset console variables, so there | |
1425 * is no current distinction between 0 and -1, and between -2 and -3. | |
1426 */ | |
1427 Lisp_Object always_local_resettable = make_int (-1); | |
1428 | |
1429 #if 0 /* not used */ | |
1430 Lisp_Object always_local_no_default = make_int (0); | |
1431 Lisp_Object resettable = make_int (-3); | |
1432 #endif | |
1433 | |
1434 /* Assign the local-flags to the slots that have default values. | |
1435 The local flag is a bit that is used in the console | |
1436 to say that it has its own local value for the slot. | |
1437 The local flag bits are in the local_var_flags slot of the | |
1438 console. */ | |
1439 | |
1440 nuke_all_console_slots (&console_local_flags, make_int (-2)); | |
1441 console_local_flags.defining_kbd_macro = always_local_resettable; | |
1442 console_local_flags.last_kbd_macro = always_local_resettable; | |
1443 console_local_flags.prefix_arg = always_local_resettable; | |
1444 console_local_flags.default_minibuffer_frame = always_local_resettable; | |
1445 console_local_flags.overriding_terminal_local_map = | |
1446 always_local_resettable; | |
1447 #ifdef HAVE_TTY | |
1448 console_local_flags.tty_erase_char = always_local_resettable; | |
1449 #endif | |
1450 | |
1451 console_local_flags.function_key_map = make_int (1); | |
1452 | |
1453 /* #### Warning, 0x4000000 (that's six zeroes) is the largest number | |
1454 currently allowable due to the XINT() handling of this value. | |
1455 With some rearrangement you can get 4 more bits. */ | |
1456 } | |
1457 } | |
1458 | |
1459 | |
1460 #define CONSOLE_SLOTS_SIZE (offsetof (struct console, CONSOLE_SLOTS_LAST_NAME) - offsetof (struct console, CONSOLE_SLOTS_FIRST_NAME) + sizeof (Lisp_Object)) | |
1461 #define CONSOLE_SLOTS_COUNT (CONSOLE_SLOTS_SIZE / sizeof (Lisp_Object)) | |
1462 | |
1463 void | |
771 | 1464 reinit_complex_vars_of_console_runtime_only (void) |
428 | 1465 { |
1466 struct console *defs, *syms; | |
1467 | |
1468 common_init_complex_vars_of_console (); | |
1469 | |
1470 defs = XCONSOLE (Vconsole_defaults); | |
1471 syms = XCONSOLE (Vconsole_local_symbols); | |
1472 memcpy (&defs->CONSOLE_SLOTS_FIRST_NAME, | |
1473 console_defaults_saved_slots, | |
1474 CONSOLE_SLOTS_SIZE); | |
1475 memcpy (&syms->CONSOLE_SLOTS_FIRST_NAME, | |
1476 console_local_symbols_saved_slots, | |
1477 CONSOLE_SLOTS_SIZE); | |
1478 } | |
1479 | |
1480 | |
1204 | 1481 static const struct memory_description console_slots_description_1[] = { |
440 | 1482 { XD_LISP_OBJECT_ARRAY, 0, CONSOLE_SLOTS_COUNT }, |
428 | 1483 { XD_END } |
1484 }; | |
1485 | |
1204 | 1486 static const struct sized_memory_description console_slots_description = { |
428 | 1487 CONSOLE_SLOTS_SIZE, |
1488 console_slots_description_1 | |
1489 }; | |
1490 | |
1491 void | |
1492 complex_vars_of_console (void) | |
1493 { | |
1494 struct console *defs, *syms; | |
1495 | |
1496 common_init_complex_vars_of_console (); | |
1497 | |
1498 defs = XCONSOLE (Vconsole_defaults); | |
1499 syms = XCONSOLE (Vconsole_local_symbols); | |
1500 console_defaults_saved_slots = &defs->CONSOLE_SLOTS_FIRST_NAME; | |
1501 console_local_symbols_saved_slots = &syms->CONSOLE_SLOTS_FIRST_NAME; | |
2367 | 1502 dump_add_root_block_ptr (&console_defaults_saved_slots, &console_slots_description); |
1503 dump_add_root_block_ptr (&console_local_symbols_saved_slots, &console_slots_description); | |
428 | 1504 |
1505 DEFVAR_CONSOLE_DEFAULTS ("default-function-key-map", function_key_map /* | |
1506 Default value of `function-key-map' for consoles that don't override it. | |
1507 This is the same as (default-value 'function-key-map). | |
1508 */ ); | |
1509 | |
1510 DEFVAR_CONSOLE_LOCAL ("function-key-map", function_key_map /* | |
1511 Keymap mapping ASCII function key sequences onto their preferred forms. | |
1512 This allows Emacs to recognize function keys sent from ASCII | |
1513 terminals at any point in a key sequence. | |
1514 | |
1515 The `read-key-sequence' function replaces any subsequence bound by | |
1516 `function-key-map' with its binding. More precisely, when the active | |
1517 keymaps have no binding for the current key sequence but | |
1518 `function-key-map' binds a suffix of the sequence to a vector or string, | |
1519 `read-key-sequence' replaces the matching suffix with its binding, and | |
2027 | 1520 continues with the new sequence. See `key-binding'. |
428 | 1521 |
1522 The events that come from bindings in `function-key-map' are not | |
1523 themselves looked up in `function-key-map'. | |
1524 | |
1525 For example, suppose `function-key-map' binds `ESC O P' to [f1]. | |
1526 Typing `ESC O P' to `read-key-sequence' would return | |
1527 \[#<keypress-event f1>]. Typing `C-x ESC O P' would return | |
1528 \[#<keypress-event control-X> #<keypress-event f1>]. If [f1] | |
1529 were a prefix key, typing `ESC O P x' would return | |
1530 \[#<keypress-event f1> #<keypress-event x>]. | |
1531 */ ); | |
1532 | |
1533 #ifdef HAVE_TTY | |
440 | 1534 /* #### Should this somehow go to TTY data? How do we make it |
428 | 1535 accessible from Lisp, then? */ |
1536 DEFVAR_CONSOLE_LOCAL ("tty-erase-char", tty_erase_char /* | |
1537 The ERASE character as set by the user with stty. | |
1538 When this value cannot be determined or would be meaningless (on non-TTY | |
1539 consoles, for example), it is set to nil. | |
1540 */ ); | |
1541 #endif | |
1542 | |
442 | 1543 /* While this should be const it can't be because some things |
428 | 1544 (i.e. edebug) do manipulate it. */ |
1545 DEFVAR_CONSOLE_LOCAL ("defining-kbd-macro", defining_kbd_macro /* | |
442 | 1546 Non-nil while a keyboard macro is being defined. Don't set this! |
428 | 1547 */ ); |
1548 | |
1549 DEFVAR_CONSOLE_LOCAL ("last-kbd-macro", last_kbd_macro /* | |
442 | 1550 Last keyboard macro defined, as a vector of events; nil if none defined. |
428 | 1551 */ ); |
1552 | |
1553 DEFVAR_CONSOLE_LOCAL ("prefix-arg", prefix_arg /* | |
1554 The value of the prefix argument for the next editing command. | |
1555 It may be a number, or the symbol `-' for just a minus sign as arg, | |
1556 or a list whose car is a number for just one or more C-U's | |
1557 or nil if no argument has been specified. | |
1558 | |
1559 You cannot examine this variable to find the argument for this command | |
1560 since it has been set to nil by the time you can look. | |
1561 Instead, you should use the variable `current-prefix-arg', although | |
1562 normally commands can get this prefix argument with (interactive "P"). | |
1563 */ ); | |
1564 | |
1565 DEFVAR_CONSOLE_LOCAL ("default-minibuffer-frame", | |
1566 default_minibuffer_frame /* | |
1567 Minibufferless frames use this frame's minibuffer. | |
1568 | |
1569 Emacs cannot create minibufferless frames unless this is set to an | |
1570 appropriate surrogate. | |
1571 | |
1572 XEmacs consults this variable only when creating minibufferless | |
1573 frames; once the frame is created, it sticks with its assigned | |
1574 minibuffer, no matter what this variable is set to. This means that | |
1575 this variable doesn't necessarily say anything meaningful about the | |
1576 current set of frames, or where the minibuffer is currently being | |
1577 displayed. | |
1578 */ ); | |
1579 | |
1580 DEFVAR_CONSOLE_LOCAL ("overriding-terminal-local-map", | |
1581 overriding_terminal_local_map /* | |
1582 Keymap that overrides all other local keymaps, for the selected console only. | |
1583 If this variable is non-nil, it is used as a keymap instead of the | |
1584 buffer's local map, and the minor mode keymaps and text property keymaps. | |
1585 */ ); | |
1586 | |
1587 /* Check for DEFVAR_CONSOLE_LOCAL without initializing the corresponding | |
1588 slot of console_local_flags and vice-versa. Must be done after all | |
1589 DEFVAR_CONSOLE_LOCAL() calls. */ | |
1590 #define MARKED_SLOT(slot) \ | |
1591 if ((XINT (console_local_flags.slot) != -2 && \ | |
1592 XINT (console_local_flags.slot) != -3) \ | |
1593 != !(NILP (XCONSOLE (Vconsole_local_symbols)->slot))) \ | |
2500 | 1594 ABORT (); |
428 | 1595 #include "conslots.h" |
1596 } |