2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1996 Ben Wing.
5 This file is part of XEmacs.
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
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
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. */
22 /* Synched up with: Not in FSF. */
24 /* Written by Ben Wing. */
30 #include "console-tty.h"
33 #include "redisplay.h"
37 Lisp_Object Vconsole_list, Vselected_console;
39 Lisp_Object Vcreate_console_hook, Vdelete_console_hook;
41 Lisp_Object Qconsolep, Qconsole_live_p;
42 Lisp_Object Qcreate_console_hook;
43 Lisp_Object Qdelete_console_hook;
45 Lisp_Object Qsuspend_hook;
46 Lisp_Object Qsuspend_resume_hook;
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
53 list of consoles and stores into each console that does not say
54 it has a local value. */
55 Lisp_Object Vconsole_defaults;
56 static void *console_defaults_saved_slots;
58 /* This structure marks which slots in a console have corresponding
59 default values in console_defaults.
60 Each such slot has a nonzero value in this structure.
61 The value has only one nonzero bit.
63 When a console has its own local value for a slot,
64 the bit for that slot (found in the same slot in this structure)
65 is turned on in the console's local_var_flags slot.
67 If a slot in this structure is 0, then there is a DEFVAR_CONSOLE_LOCAL
68 for the slot, but there is no default value for it; the corresponding
69 slot in console_defaults is not used except to initialize newly-created
72 If a slot is -1, then there is a DEFVAR_CONSOLE_LOCAL for it
73 as well as a default value which is used to initialize newly-created
74 consoles and as a reset-value when local-vars are killed.
76 If a slot is -2, there is no DEFVAR_CONSOLE_LOCAL for it.
77 (The slot is always local, but there's no lisp variable for it.)
78 The default value is only used to initialize newly-creation consoles.
80 If a slot is -3, then there is no DEFVAR_CONSOLE_LOCAL for it but
81 there is a default which is used to initialize newly-creation
82 consoles and as a reset-value when local-vars are killed.
86 struct console console_local_flags;
88 /* This structure holds the names of symbols whose values may be
89 console-local. It is indexed and accessed in the same way as the above. */
90 static Lisp_Object Vconsole_local_symbols;
91 static void *console_local_symbols_saved_slots;
93 DEFINE_CONSOLE_TYPE (dead);
95 Lisp_Object Vconsole_type_list;
97 console_type_entry_dynarr *the_console_type_entry_dynarr;
101 mark_console (Lisp_Object obj)
103 struct console *con = XCONSOLE (obj);
105 #define MARKED_SLOT(x) mark_object (con->x)
106 #include "conslots.h"
109 /* Can be zero for Vconsole_defaults, Vconsole_local_symbols */
112 mark_object (con->conmeths->symbol);
113 MAYBE_CONMETH (con, mark_console, (con));
120 print_console (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
122 struct console *con = XCONSOLE (obj);
126 error ("printing unreadable object #<console %s 0x%x>",
127 XSTRING_DATA (con->name), con->header.uid);
129 sprintf (buf, "#<%s-console", !CONSOLE_LIVE_P (con) ? "dead" :
130 CONSOLE_TYPE_NAME (con));
131 write_c_string (buf, printcharfun);
132 if (CONSOLE_LIVE_P (con) && !NILP (CONSOLE_CONNECTION (con)))
134 write_c_string (" on ", printcharfun);
135 print_internal (CONSOLE_CONNECTION (con), printcharfun, 1);
137 sprintf (buf, " 0x%x>", con->header.uid);
138 write_c_string (buf, printcharfun);
141 DEFINE_LRECORD_IMPLEMENTATION ("console", console,
142 mark_console, print_console, 0, 0, 0, 0,
145 static struct console *
146 allocate_console (void)
149 struct console *con = alloc_lcrecord_type (struct console, &lrecord_console);
152 copy_lcrecord (con, XCONSOLE (Vconsole_defaults));
154 XSETCONSOLE (console, con);
157 con->quit_char = 7; /* C-g */
158 con->command_builder = allocate_command_builder (console);
159 con->function_key_map = Fmake_sparse_keymap (Qnil);
166 decode_console (Lisp_Object console)
169 console = Fselected_console ();
170 /* quietly accept devices and frames for the console arg */
171 if (DEVICEP (console) || FRAMEP (console))
172 console = DEVICE_CONSOLE (decode_device (console));
173 CHECK_LIVE_CONSOLE (console);
174 return XCONSOLE (console);
178 struct console_methods *
179 decode_console_type (Lisp_Object type, Error_behavior errb)
183 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
184 if (EQ (type, Dynarr_at (the_console_type_entry_dynarr, i).symbol))
185 return Dynarr_at (the_console_type_entry_dynarr, i).meths;
187 maybe_signal_simple_error ("Invalid console type", type, Qconsole, errb);
193 valid_console_type_p (Lisp_Object type)
195 return decode_console_type (type, ERROR_ME_NOT) != 0;
198 DEFUN ("valid-console-type-p", Fvalid_console_type_p, 1, 1, 0, /*
199 Return t if CONSOLE-TYPE is a valid console type.
200 Valid types are 'x, 'tty, and 'stream.
204 return valid_console_type_p (console_type) ? Qt : Qnil;
207 DEFUN ("console-type-list", Fconsole_type_list, 0, 0, 0, /*
208 Return a list of valid console types.
212 return Fcopy_sequence (Vconsole_type_list);
215 DEFUN ("cdfw-console", Fcdfw_console, 1, 1, 0, /*
216 Given a console, device, frame, or window, return the associated console.
217 Return nil otherwise.
221 return CDFW_CONSOLE (object);
225 DEFUN ("selected-console", Fselected_console, 0, 0, 0, /*
226 Return the console which is currently active.
230 return Vselected_console;
233 /* Called from selected_device_1(), called from selected_frame_1(),
234 called from Fselect_window() */
236 select_console_1 (Lisp_Object console)
238 /* perhaps this should do something more complicated */
239 Vselected_console = console;
241 /* #### Schedule this to be removed in 19.14 */
242 #ifdef HAVE_X_WINDOWS
243 if (CONSOLE_X_P (XCONSOLE (console)))
247 #ifdef HAVE_MS_WINDOWS
248 if (CONSOLE_MSWINDOWS_P (XCONSOLE (console)))
249 Vwindow_system = Qmswindows;
252 Vwindow_system = Qnil;
255 DEFUN ("select-console", Fselect_console, 1, 1, 0, /*
256 Select the console CONSOLE.
257 Subsequent editing commands apply to its selected device, selected frame,
258 and selected window. The selection of CONSOLE lasts until the next time
259 the user does something to select a different console, or until the next
260 time this function is called.
266 CHECK_LIVE_CONSOLE (console);
268 device = CONSOLE_SELECTED_DEVICE (XCONSOLE (console));
271 struct device *d = XDEVICE (device);
272 Lisp_Object frame = DEVICE_SELECTED_FRAME (d);
275 struct frame *f = XFRAME(frame);
276 Fselect_window (FRAME_SELECTED_WINDOW (f), Qnil);
279 error ("Can't select console with no frames.");
282 error ("Can't select a console with no devices");
287 set_console_last_nonminibuf_frame (struct console *con,
290 con->last_nonminibuf_frame = frame;
293 DEFUN ("consolep", Fconsolep, 1, 1, 0, /*
294 Return non-nil if OBJECT is a console.
298 return CONSOLEP (object) ? Qt : Qnil;
301 DEFUN ("console-live-p", Fconsole_live_p, 1, 1, 0, /*
302 Return non-nil if OBJECT is a console that has not been deleted.
306 return CONSOLEP (object) && CONSOLE_LIVE_P (XCONSOLE (object)) ? Qt : Qnil;
309 DEFUN ("console-type", Fconsole_type, 0, 1, 0, /*
310 Return the console type (e.g. `x' or `tty') of CONSOLE.
311 Value is `tty' for a tty console (a character-only terminal),
312 `x' for a console that is an X display,
313 `mswindows' for a console that is a Windows NT/95/97 connection,
314 `pc' for a console that is a direct-write MS-DOS connection (not yet
316 `stream' for a stream console (which acts like a stdio stream), and
317 `dead' for a deleted console.
321 /* don't call decode_console() because we want to allow for dead
324 console = Fselected_console ();
325 CHECK_CONSOLE (console);
326 return CONSOLE_TYPE (XCONSOLE (console));
329 DEFUN ("console-name", Fconsole_name, 0, 1, 0, /*
330 Return the name of CONSOLE.
334 return CONSOLE_NAME (decode_console (console));
337 DEFUN ("console-connection", Fconsole_connection, 0, 1, 0, /*
338 Return the connection of the specified console.
339 CONSOLE defaults to the selected console if omitted.
343 return CONSOLE_CONNECTION (decode_console (console));
347 make_console (struct console *con)
350 XSETCONSOLE (console, con);
355 semi_canonicalize_console_connection (struct console_methods *meths,
356 Lisp_Object name, Error_behavior errb)
358 if (HAS_CONTYPE_METH_P (meths, semi_canonicalize_console_connection))
359 return CONTYPE_METH (meths, semi_canonicalize_console_connection,
362 return CONTYPE_METH_OR_GIVEN (meths, canonicalize_console_connection,
367 canonicalize_console_connection (struct console_methods *meths,
368 Lisp_Object name, Error_behavior errb)
370 if (HAS_CONTYPE_METH_P (meths, canonicalize_console_connection))
371 return CONTYPE_METH (meths, canonicalize_console_connection,
374 return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_console_connection,
379 find_console_of_type (struct console_methods *meths, Lisp_Object canon)
383 CONSOLE_LOOP (concons)
385 Lisp_Object console = XCAR (concons);
387 if (EQ (CONMETH_TYPE (meths), CONSOLE_TYPE (XCONSOLE (console)))
388 && internal_equal (CONSOLE_CANON_CONNECTION (XCONSOLE (console)),
396 DEFUN ("find-console", Ffind_console, 1, 2, 0, /*
397 Look for an existing console attached to connection CONNECTION.
398 Return the console if found; otherwise, return nil.
400 If TYPE is specified, only return consoles of that type; otherwise,
401 return consoles of any type. (It is possible, although unlikely,
402 that two consoles of different types could have the same connection
403 name; in such a case, the first console found is returned.)
407 Lisp_Object canon = Qnil;
414 struct console_methods *conmeths = decode_console_type (type, ERROR_ME);
415 canon = canonicalize_console_connection (conmeths, connection,
417 if (UNBOUNDP (canon))
418 RETURN_UNGCPRO (Qnil);
420 RETURN_UNGCPRO (find_console_of_type (conmeths, canon));
426 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
428 struct console_methods *conmeths =
429 Dynarr_at (the_console_type_entry_dynarr, i).meths;
430 canon = canonicalize_console_connection (conmeths, connection,
432 if (!UNBOUNDP (canon))
434 Lisp_Object console = find_console_of_type (conmeths, canon);
436 RETURN_UNGCPRO (console);
440 RETURN_UNGCPRO (Qnil);
444 DEFUN ("get-console", Fget_console, 1, 2, 0, /*
445 Look for an existing console attached to connection CONNECTION.
446 Return the console if found; otherwise, signal an error.
448 If TYPE is specified, only return consoles of that type; otherwise,
449 return consoles of any type. (It is possible, although unlikely,
450 that two consoles of different types could have the same connection
451 name; in such a case, the first console found is returned.)
455 Lisp_Object console = Ffind_console (connection, type);
459 signal_simple_error ("No such console", connection);
461 signal_simple_error_2 ("No such console", type, connection);
467 create_console (Lisp_Object name, Lisp_Object type, Lisp_Object connection,
470 /* This function can GC */
475 console = Ffind_console (connection, type);
479 con = allocate_console ();
480 XSETCONSOLE (console, con);
484 con->conmeths = decode_console_type (type, ERROR_ME);
486 CONSOLE_NAME (con) = name;
487 CONSOLE_CONNECTION (con) =
488 semi_canonicalize_console_connection (con->conmeths, connection,
490 CONSOLE_CANON_CONNECTION (con) =
491 canonicalize_console_connection (con->conmeths, connection,
494 MAYBE_CONMETH (con, init_console, (con, props));
496 /* Do it this way so that the console list is in order of creation */
497 Vconsole_list = nconc2 (Vconsole_list, Fcons (console, Qnil));
499 if (CONMETH_OR_GIVEN (con, initially_selected_for_input, (con), 0))
500 event_stream_select_console (con);
507 add_entry_to_console_type_list (Lisp_Object symbol,
508 struct console_methods *meths)
510 struct console_type_entry entry;
512 entry.symbol = symbol;
514 Dynarr_add (the_console_type_entry_dynarr, entry);
515 Vconsole_type_list = Fcons (symbol, Vconsole_type_list);
518 /* find a console other than the selected one. Prefer non-stream
519 consoles over stream consoles. */
522 find_other_console (Lisp_Object console)
526 /* look for a non-stream console */
527 CONSOLE_LOOP (concons)
529 Lisp_Object con = XCAR (concons);
530 if (!CONSOLE_STREAM_P (XCONSOLE (con))
531 && !EQ (con, console)
532 && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))
533 && !NILP (DEVICE_SELECTED_FRAME
534 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))))))
538 return XCAR (concons);
540 /* OK, now look for a stream console */
541 CONSOLE_LOOP (concons)
543 Lisp_Object con = XCAR (concons);
544 if (!EQ (con, console)
545 && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))
546 && !NILP (DEVICE_SELECTED_FRAME
547 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))))))
551 return XCAR (concons);
553 /* Sorry, there ain't none */
558 find_nonminibuffer_frame_not_on_console_predicate (Lisp_Object frame,
563 VOID_TO_LISP (console, closure);
564 if (FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
566 if (EQ (console, FRAME_CONSOLE (XFRAME (frame))))
572 find_nonminibuffer_frame_not_on_console (Lisp_Object console)
574 return find_some_frame (find_nonminibuffer_frame_not_on_console_predicate,
575 LISP_TO_VOID (console));
578 /* Delete console CON.
580 If FORCE is non-zero, allow deletion of the only frame.
582 If CALLED_FROM_KILL_EMACS is non-zero, then, if
583 deleting the last console, just delete it,
584 instead of calling `save-buffers-kill-emacs'.
586 If FROM_IO_ERROR is non-zero, then the console is gone due
587 to an I/O error. This affects what happens if we exit
588 (we do an emergency exit instead of `save-buffers-kill-emacs'.)
592 delete_console_internal (struct console *con, int force,
593 int called_from_kill_emacs, int from_io_error)
595 /* This function can GC */
599 /* OK to delete an already-deleted console. */
600 if (!CONSOLE_LIVE_P (con))
603 XSETCONSOLE (console, con);
606 if (!called_from_kill_emacs)
610 if ((XINT (Flength (Vconsole_list)) == 1)
611 /* if we just created the console, it might not be listed,
613 && !NILP (memq_no_quit (console, Vconsole_list)))
615 /* If there aren't any nonminibuffer frames that would
616 be left, then exit. */
617 else if (NILP (find_nonminibuffer_frame_not_on_console (console)))
623 error ("Attempt to delete the only frame");
624 else if (from_io_error)
626 /* Mayday mayday! We're going down! */
627 stderr_out (" Autosaving and exiting...\n");
628 Vwindow_system = Qnil; /* let it lie! */
629 preparing_for_armageddon = 1;
630 Fkill_emacs (make_int (70));
634 call0 (Qsave_buffers_kill_emacs);
636 /* If we get here, the user said they didn't want
637 to exit, so don't. */
643 /* Breathe a sigh of relief. We're still alive. */
646 Lisp_Object frmcons, devcons;
648 /* First delete all frames without their own minibuffers,
649 to avoid errors coming from attempting to delete a frame
650 that is a surrogate for another frame.
652 We don't set "called_from_delete_console" because we want the
653 device to go ahead and get deleted if we delete the last frame
654 on a device. We won't run into trouble here because for any
655 frame without a minibuffer, there has to be another one on
656 the same console with a minibuffer, and we're not deleting that,
657 so delete_console_internal() won't get recursively called.
659 WRONG! With surrogate minibuffers this isn't true. Frames
660 with only a minibuffer are not enough to prevent
661 delete_frame_internal from triggering a device deletion. */
662 CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, con)
664 struct frame *f = XFRAME (XCAR (frmcons));
665 /* delete_frame_internal() might do anything such as run hooks,
667 if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f))
668 delete_frame_internal (f, 1, 1, from_io_error);
670 if (!CONSOLE_LIVE_P (con)) /* make sure the delete-*-hook didn't
671 go ahead and delete anything */
678 CONSOLE_DEVICE_LOOP (devcons, con)
680 struct device *d = XDEVICE (XCAR (devcons));
681 /* delete_device_internal() might do anything such as run hooks,
683 if (DEVICE_LIVE_P (d))
684 delete_device_internal (d, 1, 1, from_io_error);
685 if (!CONSOLE_LIVE_P (con)) /* make sure the delete-*-hook didn't
686 go ahead and delete anything */
694 CONSOLE_SELECTED_DEVICE (con) = Qnil;
696 /* try to select another console */
698 if (EQ (console, Fselected_console ()))
700 Lisp_Object other_dev = find_other_console (console);
701 if (!NILP (other_dev))
702 Fselect_console (other_dev);
706 Vselected_console = Qnil;
707 Vwindow_system = Qnil;
711 if (con->input_enabled)
712 event_stream_unselect_console (con);
714 MAYBE_CONMETH (con, delete_console, (con));
716 Vconsole_list = delq_no_quit (console, Vconsole_list);
717 RESET_CHANGED_SET_FLAGS;
718 con->conmeths = dead_console_methods;
724 io_error_delete_console (Lisp_Object console)
726 delete_console_internal (XCONSOLE (console), 1, 0, 1);
729 DEFUN ("delete-console", Fdelete_console, 1, 2, 0, /*
730 Delete CONSOLE, permanently eliminating it from use.
731 Normally, you cannot delete the last non-minibuffer-only frame (you must
732 use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional
733 second argument FORCE is non-nil, you can delete the last frame. (This
734 will automatically call `save-buffers-kill-emacs'.)
738 CHECK_CONSOLE (console);
739 delete_console_internal (XCONSOLE (console), !NILP (force), 0, 0);
743 DEFUN ("console-list", Fconsole_list, 0, 0, 0, /*
744 Return a list of all consoles.
748 return Fcopy_sequence (Vconsole_list);
751 DEFUN ("console-device-list", Fconsole_device_list, 0, 1, 0, /*
752 Return a list of all devices on CONSOLE.
753 If CONSOLE is nil, the selected console is used.
757 return Fcopy_sequence (CONSOLE_DEVICE_LIST (decode_console (console)));
760 DEFUN ("console-enable-input", Fconsole_enable_input, 1, 1, 0, /*
761 Enable input on console CONSOLE.
765 struct console *con = decode_console (console);
766 if (!con->input_enabled)
767 event_stream_select_console (con);
771 DEFUN ("console-disable-input", Fconsole_disable_input, 1, 1, 0, /*
772 Disable input on console CONSOLE.
776 struct console *con = decode_console (console);
777 if (con->input_enabled)
778 event_stream_unselect_console (con);
782 DEFUN ("console-on-window-system-p", Fconsole_on_window_system_p, 0, 1, 0, /*
783 Return t if CONSOLE is on a window system.
784 If CONSOLE is nil, the selected console is used.
785 This generally means that there is support for the mouse, the menubar,
786 the toolbar, glyphs, etc.
790 Lisp_Object type = CONSOLE_TYPE (decode_console (console));
792 return !EQ (type, Qtty) && !EQ (type, Qstream) ? Qt : Qnil;
797 /**********************************************************************/
798 /* Miscellaneous low-level functions */
799 /**********************************************************************/
802 unwind_init_sys_modes (Lisp_Object console)
804 reinit_initial_console ();
806 if (!no_redraw_on_reenter &&
807 CONSOLEP (console) &&
808 CONSOLE_LIVE_P (XCONSOLE (console)))
811 XFRAME (DEVICE_SELECTED_FRAME
812 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (console)))));
813 MARK_FRAME_CHANGED (f);
818 DEFUN ("suspend-emacs", Fsuspend_emacs, 0, 1, "", /*
819 Stop Emacs and return to superior process. You can resume later.
820 On systems that don't have job control, run a subshell instead.
822 If optional arg STUFFSTRING is non-nil, its characters are stuffed
823 to be read as terminal input by Emacs's superior shell.
825 Before suspending, run the normal hook `suspend-hook'.
826 After resumption run the normal hook `suspend-resume-hook'.
828 Some operating systems cannot stop the Emacs process and resume it later.
829 On such systems, Emacs will start a subshell and wait for it to exit.
833 int speccount = specpdl_depth ();
836 if (!NILP (stuffstring))
837 CHECK_STRING (stuffstring);
838 GCPRO1 (stuffstring);
840 /* There used to be a check that the initial console is TTY.
841 This is bogus. Even checking to see whether any console
842 is a controlling terminal is not correct -- maybe
843 the user used the -t option or something. If we want to
844 suspend, then we suspend. Period. */
846 /* Call value of suspend-hook. */
847 run_hook (Qsuspend_hook);
849 reset_initial_console ();
850 /* sys_suspend can get an error if it tries to fork a subshell
851 and the system resources aren't available for that. */
852 record_unwind_protect (unwind_init_sys_modes, Vcontrolling_terminal);
853 stuff_buffered_input (stuffstring);
855 /* the console is un-reset inside of the unwind-protect. */
856 unbind_to (speccount, Qnil);
859 /* It is possible that a size change occurred while we were
860 suspended. Assume one did just to be safe. It won't hurt
861 anything if one didn't. */
862 asynch_device_change_pending++;
865 /* Call value of suspend-resume-hook
866 if it is bound and value is non-nil. */
867 run_hook (Qsuspend_resume_hook);
873 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
874 Then in any case stuff anything Emacs has read ahead and not used. */
877 stuff_buffered_input (Lisp_Object stuffstring)
879 /* stuff_char works only in BSD, versions 4.2 and up. */
881 if (!CONSOLEP (Vcontrolling_terminal) ||
882 !CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal)))
885 if (STRINGP (stuffstring))
890 TO_EXTERNAL_FORMAT (LISP_STRING, stuffstring,
894 stuff_char (XCONSOLE (Vcontrolling_terminal), *p++);
895 stuff_char (XCONSOLE (Vcontrolling_terminal), '\n');
897 /* Anything we have read ahead, put back for the shell to read. */
898 # if 0 /* oh, who cares about this silliness */
899 while (kbd_fetch_ptr != kbd_store_ptr)
901 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
902 kbd_fetch_ptr = kbd_buffer;
903 stuff_char (XCONSOLE (Vcontrolling_terminal), *kbd_fetch_ptr++);
909 DEFUN ("suspend-console", Fsuspend_console, 0, 1, "", /*
910 Suspend a console. For tty consoles, it sends a signal to suspend
911 the process in charge of the tty, and removes the devices and
912 frames of that console from the display.
914 If optional arg CONSOLE is non-nil, it is the console to be suspended.
915 Otherwise it is assumed to be the selected console.
917 Some operating systems cannot stop processes and resume them later.
918 On such systems, who knows what will happen.
923 struct console *con = decode_console (console);
925 if (CONSOLE_TTY_P (con))
928 * hide all the unhidden frames so the display code won't update
929 * them while the console is suspended.
931 Lisp_Object device = CONSOLE_SELECTED_DEVICE (con);
934 struct device *d = XDEVICE (device);
935 Lisp_Object frame_list = DEVICE_FRAME_LIST (d);
936 while (CONSP (frame_list))
938 struct frame *f = XFRAME (XCAR (frame_list));
939 if (FRAME_REPAINT_P (f))
941 frame_list = XCDR (frame_list);
944 reset_one_console (con);
945 event_stream_unselect_console (con);
946 sys_suspend_process (XINT (Fconsole_tty_controlling_process (console)));
948 #endif /* HAVE_TTY */
953 DEFUN ("resume-console", Fresume_console, 1, 1, "", /*
954 Re-initialize a previously suspended console.
955 For tty consoles, do stuff to the tty to make it sane again.
960 struct console *con = decode_console (console);
962 if (CONSOLE_TTY_P (con))
964 /* raise the selected frame */
965 Lisp_Object device = CONSOLE_SELECTED_DEVICE (con);
968 struct device *d = XDEVICE (device);
969 Lisp_Object frame = DEVICE_SELECTED_FRAME (d);
972 /* force the frame to be cleared */
973 SET_FRAME_CLEAR (XFRAME (frame));
974 Fraise_frame (frame);
977 init_one_console (con);
978 event_stream_select_console (con);
980 /* The same as in Fsuspend_emacs: it is possible that a size
981 change occurred while we were suspended. Assume one did just
982 to be safe. It won't hurt anything if one didn't. */
983 asynch_device_change_pending++;
986 #endif /* HAVE_TTY */
991 DEFUN ("set-input-mode", Fset_input_mode, 3, 5, 0, /*
992 Set mode of reading keyboard input.
993 First arg is ignored, for backward compatibility.
994 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
995 (no effect except in CBREAK mode).
996 Third arg META t means accept 8-bit input (for a Meta key).
997 META nil means ignore the top bit, on the assumption it is parity.
998 Otherwise, accept 8-bit input and don't use the top bit for Meta.
999 First three arguments only apply to TTY consoles.
1000 Optional fourth arg QUIT if non-nil specifies character to use for quitting.
1001 Optional fifth arg CONSOLE specifies console to make changes to; nil means
1002 the selected console.
1003 See also `current-input-mode'.
1005 (ignored, flow, meta, quit, console))
1007 struct console *con = decode_console (console);
1008 int meta_key = (!CONSOLE_TTY_P (con) ? 1 :
1009 EQ (meta, Qnil) ? 0 :
1015 CHECK_CHAR_COERCE_INT (quit);
1016 CONSOLE_QUIT_CHAR (con) =
1017 ((unsigned int) XCHAR (quit)) & (meta_key ? 0377 : 0177);
1021 if (CONSOLE_TTY_P (con))
1023 reset_one_console (con);
1024 TTY_FLAGS (con).flow_control = !NILP (flow);
1025 TTY_FLAGS (con).meta_key = meta_key;
1026 init_one_console (con);
1027 MARK_FRAME_CHANGED (XFRAME (CONSOLE_SELECTED_FRAME (con)));
1034 DEFUN ("current-input-mode", Fcurrent_input_mode, 0, 1, 0, /*
1035 Return information about the way Emacs currently reads keyboard input.
1036 Optional arg CONSOLE specifies console to return information about; nil means
1037 the selected console.
1038 The value is a list of the form (nil FLOW META QUIT), where
1039 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
1040 terminal; this does not apply if Emacs uses interrupt-driven input.
1041 META is t if accepting 8-bit input with 8th bit as Meta flag.
1042 META nil means ignoring the top bit, on the assumption it is parity.
1043 META is neither t nor nil if accepting 8-bit input and using
1044 all 8 bits as the character code.
1045 QUIT is the character Emacs currently uses to quit.
1046 FLOW, and META are only meaningful for TTY consoles.
1047 The elements of this list correspond to the arguments of
1052 struct console *con = decode_console (console);
1053 Lisp_Object flow, meta, quit;
1056 flow = CONSOLE_TTY_P (con) && TTY_FLAGS (con).flow_control ? Qt : Qnil;
1057 meta = (!CONSOLE_TTY_P (con) ? Qt :
1058 TTY_FLAGS (con).meta_key == 1 ? Qt :
1059 TTY_FLAGS (con).meta_key == 2 ? Qzero :
1065 quit = make_char (CONSOLE_QUIT_CHAR (con));
1067 return list4 (Qnil, flow, meta, quit);
1071 /************************************************************************/
1072 /* initialization */
1073 /************************************************************************/
1076 syms_of_console (void)
1078 INIT_LRECORD_IMPLEMENTATION (console);
1080 DEFSUBR (Fvalid_console_type_p);
1081 DEFSUBR (Fconsole_type_list);
1082 DEFSUBR (Fcdfw_console);
1083 DEFSUBR (Fselected_console);
1084 DEFSUBR (Fselect_console);
1085 DEFSUBR (Fconsolep);
1086 DEFSUBR (Fconsole_live_p);
1087 DEFSUBR (Fconsole_type);
1088 DEFSUBR (Fconsole_name);
1089 DEFSUBR (Fconsole_connection);
1090 DEFSUBR (Ffind_console);
1091 DEFSUBR (Fget_console);
1092 DEFSUBR (Fdelete_console);
1093 DEFSUBR (Fconsole_list);
1094 DEFSUBR (Fconsole_device_list);
1095 DEFSUBR (Fconsole_enable_input);
1096 DEFSUBR (Fconsole_disable_input);
1097 DEFSUBR (Fconsole_on_window_system_p);
1098 DEFSUBR (Fsuspend_console);
1099 DEFSUBR (Fresume_console);
1101 DEFSUBR (Fsuspend_emacs);
1102 DEFSUBR (Fset_input_mode);
1103 DEFSUBR (Fcurrent_input_mode);
1105 defsymbol (&Qconsolep, "consolep");
1106 defsymbol (&Qconsole_live_p, "console-live-p");
1108 defsymbol (&Qcreate_console_hook, "create-console-hook");
1109 defsymbol (&Qdelete_console_hook, "delete-console-hook");
1111 defsymbol (&Qsuspend_hook, "suspend-hook");
1112 defsymbol (&Qsuspend_resume_hook, "suspend-resume-hook");
1115 static const struct lrecord_description cte_description_1[] = {
1116 { XD_LISP_OBJECT, offsetof (console_type_entry, symbol) },
1117 { XD_STRUCT_PTR, offsetof (console_type_entry, meths), 1, &console_methods_description },
1121 static const struct struct_description cte_description = {
1122 sizeof (console_type_entry),
1126 static const struct lrecord_description cted_description_1[] = {
1127 XD_DYNARR_DESC (console_type_entry_dynarr, &cte_description),
1131 const struct struct_description cted_description = {
1132 sizeof (console_type_entry_dynarr),
1136 static const struct lrecord_description console_methods_description_1[] = {
1137 { XD_LISP_OBJECT, offsetof (struct console_methods, symbol) },
1138 { XD_LISP_OBJECT, offsetof (struct console_methods, predicate_symbol) },
1139 { XD_LISP_OBJECT, offsetof (struct console_methods, image_conversion_list) },
1143 const struct struct_description console_methods_description = {
1144 sizeof (struct console_methods),
1145 console_methods_description_1
1150 console_type_create (void)
1152 the_console_type_entry_dynarr = Dynarr_new (console_type_entry);
1153 dump_add_root_struct_ptr (&the_console_type_entry_dynarr, &cted_description);
1155 Vconsole_type_list = Qnil;
1156 staticpro (&Vconsole_type_list);
1158 /* Initialize the dead console type */
1159 INITIALIZE_CONSOLE_TYPE (dead, "dead", "console-dead-p");
1161 /* then reset the console-type lists, because `dead' is not really
1162 a valid console type */
1163 Dynarr_reset (the_console_type_entry_dynarr);
1164 Vconsole_type_list = Qnil;
1168 reinit_vars_of_console (void)
1170 staticpro_nodump (&Vconsole_list);
1171 Vconsole_list = Qnil;
1172 staticpro_nodump (&Vselected_console);
1173 Vselected_console = Qnil;
1177 vars_of_console (void)
1179 reinit_vars_of_console ();
1181 DEFVAR_LISP ("create-console-hook", &Vcreate_console_hook /*
1182 Function or functions to call when a console is created.
1183 One argument, the newly-created console.
1184 This is called after the first frame has been created, but before
1185 calling the `create-device-hook' or `create-frame-hook'.
1186 Note that in general the console will not be selected.
1188 Vcreate_console_hook = Qnil;
1190 DEFVAR_LISP ("delete-console-hook", &Vdelete_console_hook /*
1191 Function or functions to call when a console is deleted.
1192 One argument, the to-be-deleted console.
1194 Vdelete_console_hook = Qnil;
1196 #ifdef HAVE_WINDOW_SYSTEM
1197 Fprovide (intern ("window-system"));
1201 /* The docstrings for DEFVAR_* are recorded externally by make-docfile. */
1202 #define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magicfun) do { \
1203 static const struct symbol_value_forward I_hate_C = \
1204 { /* struct symbol_value_forward */ \
1205 { /* struct symbol_value_magic */ \
1206 { /* struct lcrecord_header */ \
1207 { /* struct lrecord_header */ \
1208 lrecord_type_symbol_value_forward, /* lrecord_type_index */ \
1210 1, /* c_readonly bit */ \
1211 1 /* lisp_readonly bit */ \
1217 &(console_local_flags.field_name), \
1224 int offset = ((char *)symbol_value_forward_forward (&I_hate_C) \
1225 - (char *)&console_local_flags); \
1227 defvar_magic (lname, &I_hate_C); \
1229 *((Lisp_Object *)(offset + (char *)XCONSOLE (Vconsole_local_symbols))) \
1234 #define DEFVAR_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \
1235 DEFVAR_CONSOLE_LOCAL_1 (lname, field_name, \
1236 SYMVAL_SELECTED_CONSOLE_FORWARD, magicfun)
1237 #define DEFVAR_CONSOLE_LOCAL(lname, field_name) \
1238 DEFVAR_CONSOLE_LOCAL_MAGIC (lname, field_name, 0)
1239 #define DEFVAR_CONST_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \
1240 DEFVAR_CONSOLE_LOCAL_1 (lname, field_name, \
1241 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD, magicfun)
1242 #define DEFVAR_CONST_CONSOLE_LOCAL(lname, field_name) \
1243 DEFVAR_CONST_CONSOLE_LOCAL_MAGIC (lname, field_name, 0)
1245 #define DEFVAR_CONSOLE_DEFAULTS_MAGIC(lname, field_name, magicfun) \
1246 DEFVAR_SYMVAL_FWD(lname, &(console_local_flags.field_name), \
1247 SYMVAL_DEFAULT_CONSOLE_FORWARD, magicfun)
1248 #define DEFVAR_CONSOLE_DEFAULTS(lname, field_name) \
1249 DEFVAR_CONSOLE_DEFAULTS_MAGIC (lname, field_name, 0)
1252 nuke_all_console_slots (struct console *con, Lisp_Object zap)
1254 zero_lcrecord (con);
1256 #define MARKED_SLOT(x) con->x = zap
1257 #include "conslots.h"
1262 common_init_complex_vars_of_console (void)
1264 /* Make sure all markable slots in console_defaults
1265 are initialized reasonably, so mark_console won't choke.
1267 struct console *defs = alloc_lcrecord_type (struct console, &lrecord_console);
1268 struct console *syms = alloc_lcrecord_type (struct console, &lrecord_console);
1270 staticpro_nodump (&Vconsole_defaults);
1271 staticpro_nodump (&Vconsole_local_symbols);
1272 XSETCONSOLE (Vconsole_defaults, defs);
1273 XSETCONSOLE (Vconsole_local_symbols, syms);
1275 nuke_all_console_slots (syms, Qnil);
1276 nuke_all_console_slots (defs, Qnil);
1278 /* Set up the non-nil default values of various console slots.
1279 Must do these before making the first console.
1281 /* #### Anything needed here? */
1284 /* 0 means var is always local. Default used only at creation.
1285 * -1 means var is always local. Default used only at reset and
1287 * -2 means there's no lisp variable corresponding to this slot
1288 * and the default is only used at creation.
1289 * -3 means no Lisp variable. Default used only at reset and creation.
1290 * >0 is mask. Var is local if ((console->local_var_flags & mask) != 0)
1291 * Otherwise default is used.
1293 * #### We don't currently ever reset console variables, so there
1294 * is no current distinction between 0 and -1, and between -2 and -3.
1296 Lisp_Object always_local_resettable = make_int (-1);
1298 #if 0 /* not used */
1299 Lisp_Object always_local_no_default = make_int (0);
1300 Lisp_Object resettable = make_int (-3);
1303 /* Assign the local-flags to the slots that have default values.
1304 The local flag is a bit that is used in the console
1305 to say that it has its own local value for the slot.
1306 The local flag bits are in the local_var_flags slot of the
1309 nuke_all_console_slots (&console_local_flags, make_int (-2));
1310 console_local_flags.defining_kbd_macro = always_local_resettable;
1311 console_local_flags.last_kbd_macro = always_local_resettable;
1312 console_local_flags.prefix_arg = always_local_resettable;
1313 console_local_flags.default_minibuffer_frame = always_local_resettable;
1314 console_local_flags.overriding_terminal_local_map =
1315 always_local_resettable;
1317 console_local_flags.tty_erase_char = always_local_resettable;
1320 console_local_flags.function_key_map = make_int (1);
1322 /* #### Warning, 0x4000000 (that's six zeroes) is the largest number
1323 currently allowable due to the XINT() handling of this value.
1324 With some rearrangement you can get 4 more bits. */
1329 #define CONSOLE_SLOTS_SIZE (offsetof (struct console, CONSOLE_SLOTS_LAST_NAME) - offsetof (struct console, CONSOLE_SLOTS_FIRST_NAME) + sizeof (Lisp_Object))
1330 #define CONSOLE_SLOTS_COUNT (CONSOLE_SLOTS_SIZE / sizeof (Lisp_Object))
1333 reinit_complex_vars_of_console (void)
1335 struct console *defs, *syms;
1337 common_init_complex_vars_of_console ();
1339 defs = XCONSOLE (Vconsole_defaults);
1340 syms = XCONSOLE (Vconsole_local_symbols);
1341 memcpy (&defs->CONSOLE_SLOTS_FIRST_NAME,
1342 console_defaults_saved_slots,
1343 CONSOLE_SLOTS_SIZE);
1344 memcpy (&syms->CONSOLE_SLOTS_FIRST_NAME,
1345 console_local_symbols_saved_slots,
1346 CONSOLE_SLOTS_SIZE);
1350 static const struct lrecord_description console_slots_description_1[] = {
1351 { XD_LISP_OBJECT_ARRAY, 0, CONSOLE_SLOTS_COUNT },
1355 static const struct struct_description console_slots_description = {
1357 console_slots_description_1
1361 complex_vars_of_console (void)
1363 struct console *defs, *syms;
1365 common_init_complex_vars_of_console ();
1367 defs = XCONSOLE (Vconsole_defaults);
1368 syms = XCONSOLE (Vconsole_local_symbols);
1369 console_defaults_saved_slots = &defs->CONSOLE_SLOTS_FIRST_NAME;
1370 console_local_symbols_saved_slots = &syms->CONSOLE_SLOTS_FIRST_NAME;
1371 dump_add_root_struct_ptr (&console_defaults_saved_slots, &console_slots_description);
1372 dump_add_root_struct_ptr (&console_local_symbols_saved_slots, &console_slots_description);
1374 DEFVAR_CONSOLE_DEFAULTS ("default-function-key-map", function_key_map /*
1375 Default value of `function-key-map' for consoles that don't override it.
1376 This is the same as (default-value 'function-key-map).
1379 DEFVAR_CONSOLE_LOCAL ("function-key-map", function_key_map /*
1380 Keymap mapping ASCII function key sequences onto their preferred forms.
1381 This allows Emacs to recognize function keys sent from ASCII
1382 terminals at any point in a key sequence.
1384 The `read-key-sequence' function replaces any subsequence bound by
1385 `function-key-map' with its binding. More precisely, when the active
1386 keymaps have no binding for the current key sequence but
1387 `function-key-map' binds a suffix of the sequence to a vector or string,
1388 `read-key-sequence' replaces the matching suffix with its binding, and
1389 continues with the new sequence.
1391 The events that come from bindings in `function-key-map' are not
1392 themselves looked up in `function-key-map'.
1394 For example, suppose `function-key-map' binds `ESC O P' to [f1].
1395 Typing `ESC O P' to `read-key-sequence' would return
1396 \[#<keypress-event f1>]. Typing `C-x ESC O P' would return
1397 \[#<keypress-event control-X> #<keypress-event f1>]. If [f1]
1398 were a prefix key, typing `ESC O P x' would return
1399 \[#<keypress-event f1> #<keypress-event x>].
1403 /* #### Should this somehow go to TTY data? How do we make it
1404 accessible from Lisp, then? */
1405 DEFVAR_CONSOLE_LOCAL ("tty-erase-char", tty_erase_char /*
1406 The ERASE character as set by the user with stty.
1407 When this value cannot be determined or would be meaningless (on non-TTY
1408 consoles, for example), it is set to nil.
1412 /* While this should be const it can't be because some things
1413 (i.e. edebug) do manipulate it. */
1414 DEFVAR_CONSOLE_LOCAL ("defining-kbd-macro", defining_kbd_macro /*
1415 Non-nil while a keyboard macro is being defined. Don't set this!
1418 DEFVAR_CONSOLE_LOCAL ("last-kbd-macro", last_kbd_macro /*
1419 Last keyboard macro defined, as a vector of events; nil if none defined.
1422 DEFVAR_CONSOLE_LOCAL ("prefix-arg", prefix_arg /*
1423 The value of the prefix argument for the next editing command.
1424 It may be a number, or the symbol `-' for just a minus sign as arg,
1425 or a list whose car is a number for just one or more C-U's
1426 or nil if no argument has been specified.
1428 You cannot examine this variable to find the argument for this command
1429 since it has been set to nil by the time you can look.
1430 Instead, you should use the variable `current-prefix-arg', although
1431 normally commands can get this prefix argument with (interactive "P").
1434 DEFVAR_CONSOLE_LOCAL ("default-minibuffer-frame",
1435 default_minibuffer_frame /*
1436 Minibufferless frames use this frame's minibuffer.
1438 Emacs cannot create minibufferless frames unless this is set to an
1439 appropriate surrogate.
1441 XEmacs consults this variable only when creating minibufferless
1442 frames; once the frame is created, it sticks with its assigned
1443 minibuffer, no matter what this variable is set to. This means that
1444 this variable doesn't necessarily say anything meaningful about the
1445 current set of frames, or where the minibuffer is currently being
1449 DEFVAR_CONSOLE_LOCAL ("overriding-terminal-local-map",
1450 overriding_terminal_local_map /*
1451 Keymap that overrides all other local keymaps, for the selected console only.
1452 If this variable is non-nil, it is used as a keymap instead of the
1453 buffer's local map, and the minor mode keymaps and text property keymaps.
1456 /* Check for DEFVAR_CONSOLE_LOCAL without initializing the corresponding
1457 slot of console_local_flags and vice-versa. Must be done after all
1458 DEFVAR_CONSOLE_LOCAL() calls. */
1459 #define MARKED_SLOT(slot) \
1460 if ((XINT (console_local_flags.slot) != -2 && \
1461 XINT (console_local_flags.slot) != -3) \
1462 != !(NILP (XCONSOLE (Vconsole_local_symbols)->slot))) \
1464 #include "conslots.h"