Mercurial > hg > xemacs-beta

comparison src/console.c @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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 }