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;
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.
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.
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
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.
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.
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.
85 struct console console_local_flags;
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;
91 DEFINE_CONSOLE_TYPE (dead);
93 Lisp_Object Vconsole_type_list;
95 console_type_entry_dynarr *the_console_type_entry_dynarr;
99 mark_console (Lisp_Object obj, void (*markobj) (Lisp_Object))
101 struct console *con = XCONSOLE (obj);
103 #define MARKED_SLOT(x) ((void) (markobj (con->x)));
104 #include "conslots.h"
107 /* Can be zero for Vconsole_defaults, Vconsole_local_symbols */
110 markobj (con->conmeths->symbol);
111 MAYBE_CONMETH (con, mark_console, (con, markobj));
118 print_console (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
120 struct console *con = XCONSOLE (obj);
124 error ("printing unreadable object #<console %s 0x%x>",
125 XSTRING_DATA (con->name), con->header.uid);
127 sprintf (buf, "#<%s-console", !CONSOLE_LIVE_P (con) ? "dead" :
128 CONSOLE_TYPE_NAME (con));
129 write_c_string (buf, printcharfun);
130 if (CONSOLE_LIVE_P (con))
132 write_c_string (" on ", printcharfun);
133 print_internal (CONSOLE_CONNECTION (con), printcharfun, 1);
135 sprintf (buf, " 0x%x>", con->header.uid);
136 write_c_string (buf, printcharfun);
139 DEFINE_LRECORD_IMPLEMENTATION ("console", console,
140 mark_console, print_console, 0, 0, 0, 0,
143 static struct console *
144 allocate_console (void)
147 struct console *con = alloc_lcrecord_type (struct console, &lrecord_console);
150 copy_lcrecord (con, XCONSOLE (Vconsole_defaults));
152 XSETCONSOLE (console, con);
155 con->quit_char = 7; /* C-g */
156 con->command_builder = allocate_command_builder (console);
157 con->function_key_map = Fmake_sparse_keymap (Qnil);
164 decode_console (Lisp_Object console)
167 console = Fselected_console ();
168 /* quietly accept devices and frames for the console arg */
169 if (DEVICEP (console) || FRAMEP (console))
170 console = DEVICE_CONSOLE (decode_device (console));
171 CHECK_LIVE_CONSOLE (console);
172 return XCONSOLE (console);
176 struct console_methods *
177 decode_console_type (Lisp_Object type, Error_behavior errb)
181 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
182 if (EQ (type, Dynarr_at (the_console_type_entry_dynarr, i).symbol))
183 return Dynarr_at (the_console_type_entry_dynarr, i).meths;
185 maybe_signal_simple_error ("Invalid console type", type, Qconsole, errb);
191 valid_console_type_p (Lisp_Object type)
193 return decode_console_type (type, ERROR_ME_NOT) != 0;
196 DEFUN ("valid-console-type-p", Fvalid_console_type_p, 1, 1, 0, /*
197 Given a CONSOLE-TYPE, return t if it is valid.
198 Valid types are 'x, 'tty, and 'stream.
202 return valid_console_type_p (console_type) ? Qt : Qnil;
205 DEFUN ("console-type-list", Fconsole_type_list, 0, 0, 0, /*
206 Return a list of valid console types.
210 return Fcopy_sequence (Vconsole_type_list);
213 DEFUN ("cdfw-console", Fcdfw_console, 1, 1, 0, /*
214 Given a console, device, frame, or window, return the associated console.
215 Return nil otherwise.
219 return CDFW_CONSOLE (obj);
223 DEFUN ("selected-console", Fselected_console, 0, 0, 0, /*
224 Return the console which is currently active.
228 return Vselected_console;
231 /* Called from selected_device_1(), called from selected_frame_1(),
232 called from Fselect_window() */
234 select_console_1 (Lisp_Object console)
236 /* perhaps this should do something more complicated */
237 Vselected_console = console;
239 /* #### Schedule this to be removed in 19.14 */
240 #ifdef HAVE_X_WINDOWS
241 if (CONSOLE_X_P (XCONSOLE (console)))
245 #ifdef HAVE_MS_WINDOWS
246 if (CONSOLE_MSWINDOWS_P (XCONSOLE (console)))
247 Vwindow_system = Qmswindows;
250 Vwindow_system = Qnil;
253 DEFUN ("select-console", Fselect_console, 1, 1, 0, /*
254 Select the console CONSOLE.
255 Subsequent editing commands apply to its selected device, selected frame,
256 and selected window. The selection of CONSOLE lasts until the next time
257 the user does something to select a different console, or until the next
258 time this function is called.
264 CHECK_LIVE_CONSOLE (console);
266 device = CONSOLE_SELECTED_DEVICE (XCONSOLE (console));
269 struct device *d = XDEVICE (device);
270 Lisp_Object frame = DEVICE_SELECTED_FRAME (d);
273 struct frame *f = XFRAME(frame);
274 Fselect_window (FRAME_SELECTED_WINDOW (f), Qnil);
277 error ("Can't select console with no frames.");
280 error ("Can't select a console with no devices");
285 set_console_last_nonminibuf_frame (struct console *con,
288 con->last_nonminibuf_frame = frame;
291 DEFUN ("consolep", Fconsolep, 1, 1, 0, /*
292 Return non-nil if OBJECT is a console.
296 return CONSOLEP (object) ? Qt : Qnil;
299 DEFUN ("console-live-p", Fconsole_live_p, 1, 1, 0, /*
300 Return non-nil if OBJECT is a console that has not been deleted.
304 return CONSOLEP (object) && CONSOLE_LIVE_P (XCONSOLE (object)) ? Qt : Qnil;
307 DEFUN ("console-type", Fconsole_type, 0, 1, 0, /*
308 Return the type of the specified console (e.g. `x' or `tty').
309 Value is `tty' for a tty console (a character-only terminal),
310 `x' for a console that is an X display,
311 `mswindows' for a console that is a Windows NT/95/97 connection,
312 `pc' for a console that is a direct-write MS-DOS connection (not yet
314 `stream' for a stream console (which acts like a stdio stream), and
315 `dead' for a deleted console.
319 /* don't call decode_console() because we want to allow for dead
322 console = Fselected_console ();
323 CHECK_CONSOLE (console);
324 return CONSOLE_TYPE (XCONSOLE (console));
327 DEFUN ("console-name", Fconsole_name, 0, 1, 0, /*
328 Return the name of the specified console.
332 return CONSOLE_NAME (decode_console (console));
335 DEFUN ("console-connection", Fconsole_connection, 0, 1, 0, /*
336 Return the connection of the specified console.
337 CONSOLE defaults to the selected console if omitted.
341 return CONSOLE_CONNECTION (decode_console (console));
345 make_console (struct console *con)
348 XSETCONSOLE (console, con);
353 semi_canonicalize_console_connection (struct console_methods *meths,
354 Lisp_Object name, Error_behavior errb)
356 return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_console_connection,
361 canonicalize_console_connection (struct console_methods *meths,
362 Lisp_Object name, Error_behavior errb)
364 return CONTYPE_METH_OR_GIVEN (meths, canonicalize_console_connection,
369 find_console_of_type (struct console_methods *meths, Lisp_Object canon)
373 CONSOLE_LOOP (concons)
375 Lisp_Object console = XCAR (concons);
377 if (EQ (CONMETH_TYPE (meths), CONSOLE_TYPE (XCONSOLE (console)))
378 && internal_equal (CONSOLE_CANON_CONNECTION (XCONSOLE (console)),
386 DEFUN ("find-console", Ffind_console, 1, 2, 0, /*
387 Look for an existing console attached to connection CONNECTION.
388 Return the console if found; otherwise, return nil.
390 If TYPE is specified, only return consoles of that type; otherwise,
391 return consoles of any type. (It is possible, although unlikely,
392 that two consoles of different types could have the same connection
393 name; in such a case, the first console found is returned.)
397 Lisp_Object canon = Qnil;
404 struct console_methods *conmeths = decode_console_type (type, ERROR_ME);
405 canon = canonicalize_console_connection (conmeths, connection,
407 if (UNBOUNDP (canon))
408 RETURN_UNGCPRO (Qnil);
410 RETURN_UNGCPRO (find_console_of_type (conmeths, canon));
416 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
418 struct console_methods *conmeths =
419 Dynarr_at (the_console_type_entry_dynarr, i).meths;
420 canon = canonicalize_console_connection (conmeths, connection,
422 if (!UNBOUNDP (canon))
424 Lisp_Object console = find_console_of_type (conmeths, canon);
426 RETURN_UNGCPRO (console);
430 RETURN_UNGCPRO (Qnil);
434 DEFUN ("get-console", Fget_console, 1, 2, 0, /*
435 Look for an existing console attached to connection CONNECTION.
436 Return the console if found; otherwise, signal an error.
438 If TYPE is specified, only return consoles of that type; otherwise,
439 return consoles of any type. (It is possible, although unlikely,
440 that two consoles of different types could have the same connection
441 name; in such a case, the first console found is returned.)
445 Lisp_Object console = Ffind_console (connection, type);
449 signal_simple_error ("No such console", connection);
451 signal_simple_error_2 ("No such console", type, connection);
457 create_console (Lisp_Object name, Lisp_Object type, Lisp_Object connection,
460 /* This function can GC */
465 console = Ffind_console (connection, type);
469 con = allocate_console ();
470 XSETCONSOLE (console, con);
474 con->conmeths = decode_console_type (type, ERROR_ME);
476 CONSOLE_NAME (con) = name;
477 CONSOLE_CONNECTION (con) =
478 semi_canonicalize_console_connection (con->conmeths, connection,
480 CONSOLE_CANON_CONNECTION (con) =
481 canonicalize_console_connection (con->conmeths, connection,
484 MAYBE_CONMETH (con, init_console, (con, props));
486 /* Do it this way so that the console list is in order of creation */
487 Vconsole_list = nconc2 (Vconsole_list, Fcons (console, Qnil));
489 if (CONMETH (con, initially_selected_for_input, (con)))
490 event_stream_select_console (con);
497 add_entry_to_console_type_list (Lisp_Object symbol,
498 struct console_methods *meths)
500 struct console_type_entry entry;
502 entry.symbol = symbol;
504 Dynarr_add (the_console_type_entry_dynarr, entry);
505 Vconsole_type_list = Fcons (symbol, Vconsole_type_list);
508 /* find a console other than the selected one. Prefer non-stream
509 consoles over stream consoles. */
512 find_other_console (Lisp_Object console)
516 /* look for a non-stream console */
517 CONSOLE_LOOP (concons)
519 Lisp_Object con = XCAR (concons);
520 if (!CONSOLE_STREAM_P (XCONSOLE (con))
521 && !EQ (con, console)
522 && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))
523 && !NILP (DEVICE_SELECTED_FRAME
524 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))))))
528 return XCAR (concons);
530 /* OK, now look for a stream console */
531 CONSOLE_LOOP (concons)
533 Lisp_Object con = XCAR (concons);
534 if (!EQ (con, console)
535 && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))
536 && !NILP (DEVICE_SELECTED_FRAME
537 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))))))
541 return XCAR (concons);
543 /* Sorry, there ain't none */
548 find_nonminibuffer_frame_not_on_console_predicate (Lisp_Object frame,
553 VOID_TO_LISP (console, closure);
554 if (FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
556 if (EQ (console, FRAME_CONSOLE (XFRAME (frame))))
562 find_nonminibuffer_frame_not_on_console (Lisp_Object console)
564 return find_some_frame (find_nonminibuffer_frame_not_on_console_predicate,
565 LISP_TO_VOID (console));
568 /* Delete console CON.
570 If FORCE is non-zero, allow deletion of the only frame.
572 If CALLED_FROM_KILL_EMACS is non-zero, then, if
573 deleting the last console, just delete it,
574 instead of calling `save-buffers-kill-emacs'.
576 If FROM_IO_ERROR is non-zero, then the console is gone due
577 to an I/O error. This affects what happens if we exit
578 (we do an emergency exit instead of `save-buffers-kill-emacs'.)
582 delete_console_internal (struct console *con, int force,
583 int called_from_kill_emacs, int from_io_error)
585 /* This function can GC */
589 /* OK to delete an already-deleted console. */
590 if (!CONSOLE_LIVE_P (con))
593 XSETCONSOLE (console, con);
596 if (!called_from_kill_emacs)
600 if ((XINT (Flength (Vconsole_list)) == 1)
601 /* if we just created the console, it might not be listed,
603 && !NILP (memq_no_quit (console, Vconsole_list)))
605 /* If there aren't any nonminibuffer frames that would
606 be left, then exit. */
607 else if (NILP (find_nonminibuffer_frame_not_on_console (console)))
613 error ("Attempt to delete the only frame");
614 else if (from_io_error)
616 /* Mayday mayday! We're going down! */
617 stderr_out (" Autosaving and exiting...\n");
618 Vwindow_system = Qnil; /* let it lie! */
619 preparing_for_armageddon = 1;
620 Fkill_emacs (make_int (70));
624 call0 (Qsave_buffers_kill_emacs);
626 /* If we get here, the user said they didn't want
627 to exit, so don't. */
633 /* Breathe a sigh of relief. We're still alive. */
636 Lisp_Object frmcons, devcons;
638 /* First delete all frames without their own minibuffers,
639 to avoid errors coming from attempting to delete a frame
640 that is a surrogate for another frame.
642 We don't set "called_from_delete_console" because we want the
643 device to go ahead and get deleted if we delete the last frame
644 on a device. We won't run into trouble here because for any
645 frame without a minibuffer, there has to be another one on
646 the same console with a minibuffer, and we're not deleting that,
647 so delete_console_internal() won't get recursively called.
649 WRONG! With surrogate minibuffers this isn't true. Frames
650 with only a minibuffer are not enough to prevent
651 delete_frame_internal from triggering a device deletion. */
652 CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, con)
654 struct frame *f = XFRAME (XCAR (frmcons));
655 /* delete_frame_internal() might do anything such as run hooks,
657 if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f))
658 delete_frame_internal (f, 1, 1, from_io_error);
660 if (!CONSOLE_LIVE_P (con)) /* make sure the delete-*-hook didn't
661 go ahead and delete anything */
668 CONSOLE_DEVICE_LOOP (devcons, con)
670 struct device *d = XDEVICE (XCAR (devcons));
671 /* delete_device_internal() might do anything such as run hooks,
673 if (DEVICE_LIVE_P (d))
674 delete_device_internal (d, 1, 1, from_io_error);
675 if (!CONSOLE_LIVE_P (con)) /* make sure the delete-*-hook didn't
676 go ahead and delete anything */
684 CONSOLE_SELECTED_DEVICE (con) = Qnil;
686 /* try to select another console */
688 if (EQ (console, Fselected_console ()))
690 Lisp_Object other_dev = find_other_console (console);
691 if (!NILP (other_dev))
692 Fselect_console (other_dev);
696 Vselected_console = Qnil;
697 Vwindow_system = Qnil;
701 if (con->input_enabled)
702 event_stream_unselect_console (con);
704 MAYBE_CONMETH (con, delete_console, (con));
706 Vconsole_list = delq_no_quit (console, Vconsole_list);
707 RESET_CHANGED_SET_FLAGS;
708 con->conmeths = dead_console_methods;
714 io_error_delete_console (Lisp_Object console)
716 delete_console_internal (XCONSOLE (console), 1, 0, 1);
719 DEFUN ("delete-console", Fdelete_console, 1, 2, 0, /*
720 Delete CONSOLE, permanently eliminating it from use.
721 Normally, you cannot delete the last non-minibuffer-only frame (you must
722 use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional
723 second argument FORCE is non-nil, you can delete the last frame. (This
724 will automatically call `save-buffers-kill-emacs'.)
728 CHECK_CONSOLE (console);
729 delete_console_internal (XCONSOLE (console), !NILP (force), 0, 0);
733 DEFUN ("console-list", Fconsole_list, 0, 0, 0, /*
734 Return a list of all consoles.
738 return Fcopy_sequence (Vconsole_list);
741 DEFUN ("console-device-list", Fconsole_device_list, 0, 1, 0, /*
742 Return a list of all devices on CONSOLE.
743 If CONSOLE is nil, the selected console will be used.
747 return Fcopy_sequence (CONSOLE_DEVICE_LIST (decode_console (console)));
750 DEFUN ("console-enable-input", Fconsole_enable_input, 1, 1, 0, /*
751 Enable input on console CONSOLE.
755 struct console *con = decode_console (console);
756 if (!con->input_enabled)
757 event_stream_select_console (con);
761 DEFUN ("console-disable-input", Fconsole_disable_input, 1, 1, 0, /*
762 Disable input on console CONSOLE.
766 struct console *con = decode_console (console);
767 if (con->input_enabled)
768 event_stream_unselect_console (con);
772 DEFUN ("console-on-window-system-p", Fconsole_on_window_system_p, 0, 1, 0, /*
773 Return non-nil if this console is on a window system.
774 This generally means that there is support for the mouse, the menubar,
775 the toolbar, glyphs, etc.
779 Lisp_Object type = CONSOLE_TYPE (decode_console (console));
781 return !EQ (type, Qtty) && !EQ (type, Qstream) ? Qt : Qnil;
784 DEFUN ("console-features", Fconsole_features, 0, 1, 0, /*
785 Return a list of console-specific features.
789 return CONSOLE_FEATURES (decode_console (console));
794 /**********************************************************************/
795 /* Miscellaneous low-level functions */
796 /**********************************************************************/
799 unwind_init_sys_modes (Lisp_Object console)
801 reinit_initial_console ();
803 if (!no_redraw_on_reenter &&
804 CONSOLEP (console) &&
805 CONSOLE_LIVE_P (XCONSOLE (console)))
808 XFRAME (DEVICE_SELECTED_FRAME
809 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (console)))));
810 MARK_FRAME_CHANGED (f);
815 DEFUN ("suspend-emacs", Fsuspend_emacs, 0, 1, "", /*
816 Stop Emacs and return to superior process. You can resume later.
817 On systems that don't have job control, run a subshell instead.
819 If optional arg STUFFSTRING is non-nil, its characters are stuffed
820 to be read as terminal input by Emacs's superior shell.
822 Before suspending, run the normal hook `suspend-hook'.
823 After resumption run the normal hook `suspend-resume-hook'.
825 Some operating systems cannot stop the Emacs process and resume it later.
826 On such systems, Emacs will start a subshell and wait for it to exit.
830 int speccount = specpdl_depth ();
833 if (!NILP (stuffstring))
834 CHECK_STRING (stuffstring);
835 GCPRO1 (stuffstring);
837 /* There used to be a check that the initial console is TTY.
838 This is bogus. Even checking to see whether any console
839 is a controlling terminal is not correct -- maybe
840 the user used the -t option or something. If we want to
841 suspend, then we suspend. Period. */
843 /* Call value of suspend-hook. */
844 run_hook (Qsuspend_hook);
846 reset_initial_console ();
847 /* sys_suspend can get an error if it tries to fork a subshell
848 and the system resources aren't available for that. */
849 record_unwind_protect (unwind_init_sys_modes, Vcontrolling_terminal);
850 stuff_buffered_input (stuffstring);
852 /* the console is un-reset inside of the unwind-protect. */
853 unbind_to (speccount, Qnil);
856 /* It is possible that a size change occurred while we were
857 suspended. Assume one did just to be safe. It won't hurt
858 anything if one didn't. */
859 asynch_device_change_pending++;
862 /* Call value of suspend-resume-hook
863 if it is bound and value is non-nil. */
864 run_hook (Qsuspend_resume_hook);
870 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
871 Then in any case stuff anything Emacs has read ahead and not used. */
874 stuff_buffered_input (Lisp_Object stuffstring)
876 /* stuff_char works only in BSD, versions 4.2 and up. */
878 if (!CONSOLEP (Vcontrolling_terminal) ||
879 !CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal)))
882 if (STRINGP (stuffstring))
887 GET_STRING_EXT_DATA_ALLOCA (stuffstring, FORMAT_KEYBOARD, p, count);
889 stuff_char (XCONSOLE (Vcontrolling_terminal), *p++);
890 stuff_char (XCONSOLE (Vcontrolling_terminal), '\n');
892 /* Anything we have read ahead, put back for the shell to read. */
893 # if 0 /* oh, who cares about this silliness */
894 while (kbd_fetch_ptr != kbd_store_ptr)
896 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
897 kbd_fetch_ptr = kbd_buffer;
898 stuff_char (XCONSOLE (Vcontrolling_terminal), *kbd_fetch_ptr++);
904 DEFUN ("suspend-console", Fsuspend_console, 0, 1, "", /*
905 Suspend a console. For tty consoles, it sends a signal to suspend
906 the process in charge of the tty, and removes the devices and
907 frames of that console from the display.
909 If optional arg CONSOLE is non-nil, it is the console to be suspended.
910 Otherwise it is assumed to be the selected console.
912 Some operating systems cannot stop processes and resume them later.
913 On such systems, who knows what will happen.
918 struct console *con = decode_console (console);
920 if (CONSOLE_TTY_P (con))
923 * hide all the unhidden frames so the display code won't update
924 * them while the console is suspended.
926 Lisp_Object device = CONSOLE_SELECTED_DEVICE (con);
929 struct device *d = XDEVICE (device);
930 Lisp_Object frame_list = DEVICE_FRAME_LIST (d);
931 while (CONSP (frame_list))
933 struct frame *f = XFRAME (XCAR (frame_list));
934 if (FRAME_REPAINT_P (f))
936 frame_list = XCDR (frame_list);
939 reset_one_console (con);
940 event_stream_unselect_console (con);
941 sys_suspend_process (XINT (Fconsole_tty_controlling_process (console)));
943 #endif /* HAVE_TTY */
948 DEFUN ("resume-console", Fresume_console, 1, 1, "", /*
949 Re-initialize a previously suspended console.
950 For tty consoles, do stuff to the tty to make it sane again.
955 struct console *con = decode_console (console);
957 if (CONSOLE_TTY_P (con))
959 /* raise the selected frame */
960 Lisp_Object device = CONSOLE_SELECTED_DEVICE (con);
963 struct device *d = XDEVICE (device);
964 Lisp_Object frame = DEVICE_SELECTED_FRAME (d);
967 /* force the frame to be cleared */
968 SET_FRAME_CLEAR (XFRAME (frame));
969 Fraise_frame (frame);
972 init_one_console (con);
973 event_stream_select_console (con);
975 /* The same as in Fsuspend_emacs: it is possible that a size
976 change occurred while we were suspended. Assume one did just
977 to be safe. It won't hurt anything if one didn't. */
978 asynch_device_change_pending++;
981 #endif /* HAVE_TTY */
986 DEFUN ("set-input-mode", Fset_input_mode, 3, 5, 0, /*
987 Set mode of reading keyboard input.
988 First arg is ignored, for backward compatibility.
989 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
990 (no effect except in CBREAK mode).
991 Third arg META t means accept 8-bit input (for a Meta key).
992 META nil means ignore the top bit, on the assumption it is parity.
993 Otherwise, accept 8-bit input and don't use the top bit for Meta.
994 First three arguments only apply to TTY consoles.
995 Optional fourth arg QUIT if non-nil specifies character to use for quitting.
996 Optional fifth arg CONSOLE specifies console to make changes to; nil means
997 the selected console.
998 See also `current-input-mode'.
1000 (ignored, flow, meta, quit, console))
1002 struct console *con = decode_console (console);
1003 int meta_key = (!CONSOLE_TTY_P (con) ? 1 :
1004 EQ (meta, Qnil) ? 0 :
1010 CHECK_CHAR_COERCE_INT (quit);
1011 CONSOLE_QUIT_CHAR (con) =
1012 ((unsigned int) XCHAR (quit)) & (meta_key ? 0377 : 0177);
1016 if (CONSOLE_TTY_P (con))
1018 reset_one_console (con);
1019 TTY_FLAGS (con).flow_control = !NILP (flow);
1020 TTY_FLAGS (con).meta_key = meta_key;
1021 init_one_console (con);
1028 DEFUN ("current-input-mode", Fcurrent_input_mode, 0, 1, 0, /*
1029 Return information about the way Emacs currently reads keyboard input.
1030 Optional arg CONSOLE specifies console to return information about; nil means
1031 the selected console.
1032 The value is a list of the form (nil FLOW META QUIT), where
1033 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
1034 terminal; this does not apply if Emacs uses interrupt-driven input.
1035 META is t if accepting 8-bit input with 8th bit as Meta flag.
1036 META nil means ignoring the top bit, on the assumption it is parity.
1037 META is neither t nor nil if accepting 8-bit input and using
1038 all 8 bits as the character code.
1039 QUIT is the character Emacs currently uses to quit.
1040 FLOW, and META are only meaningful for TTY consoles.
1041 The elements of this list correspond to the arguments of
1046 struct console *con = decode_console (console);
1047 Lisp_Object flow, meta, quit;
1050 flow = CONSOLE_TTY_P (con) && TTY_FLAGS (con).flow_control ? Qt : Qnil;
1051 meta = (!CONSOLE_TTY_P (con) ? Qt :
1052 TTY_FLAGS (con).meta_key == 1 ? Qt :
1053 TTY_FLAGS (con).meta_key == 2 ? Qzero :
1059 quit = make_char (CONSOLE_QUIT_CHAR (con));
1061 return list4 (Qnil, flow, meta, quit);
1065 /************************************************************************/
1066 /* initialization */
1067 /************************************************************************/
1070 syms_of_console (void)
1072 DEFSUBR (Fvalid_console_type_p);
1073 DEFSUBR (Fconsole_type_list);
1074 DEFSUBR (Fcdfw_console);
1075 DEFSUBR (Fselected_console);
1076 DEFSUBR (Fselect_console);
1077 DEFSUBR (Fconsolep);
1078 DEFSUBR (Fconsole_live_p);
1079 DEFSUBR (Fconsole_type);
1080 DEFSUBR (Fconsole_name);
1081 DEFSUBR (Fconsole_connection);
1082 DEFSUBR (Ffind_console);
1083 DEFSUBR (Fget_console);
1084 DEFSUBR (Fdelete_console);
1085 DEFSUBR (Fconsole_list);
1086 DEFSUBR (Fconsole_device_list);
1087 DEFSUBR (Fconsole_enable_input);
1088 DEFSUBR (Fconsole_disable_input);
1089 DEFSUBR (Fconsole_on_window_system_p);
1090 DEFSUBR (Fconsole_features);
1091 DEFSUBR (Fsuspend_console);
1092 DEFSUBR (Fresume_console);
1094 DEFSUBR (Fsuspend_emacs);
1095 DEFSUBR (Fset_input_mode);
1096 DEFSUBR (Fcurrent_input_mode);
1098 defsymbol (&Qconsolep, "consolep");
1099 defsymbol (&Qconsole_live_p, "console-live-p");
1101 defsymbol (&Qcreate_console_hook, "create-console-hook");
1102 defsymbol (&Qdelete_console_hook, "delete-console-hook");
1104 defsymbol (&Qsuspend_hook, "suspend-hook");
1105 defsymbol (&Qsuspend_resume_hook, "suspend-resume-hook");
1109 console_type_create (void)
1111 the_console_type_entry_dynarr = Dynarr_new (console_type_entry);
1113 Vconsole_type_list = Qnil;
1114 staticpro (&Vconsole_type_list);
1116 /* Initialize the dead console type */
1117 INITIALIZE_CONSOLE_TYPE (dead, "dead", "console-dead-p");
1119 /* then reset the console-type lists, because `dead' is not really
1120 a valid console type */
1121 Dynarr_reset (the_console_type_entry_dynarr);
1122 Vconsole_type_list = Qnil;
1126 vars_of_console (void)
1128 DEFVAR_LISP ("create-console-hook", &Vcreate_console_hook /*
1129 Function or functions to call when a console is created.
1130 One argument, the newly-created console.
1131 This is called after the first frame has been created, but before
1132 calling the `create-device-hook' or `create-frame-hook'.
1133 Note that in general the console will not be selected.
1135 Vcreate_console_hook = Qnil;
1137 DEFVAR_LISP ("delete-console-hook", &Vdelete_console_hook /*
1138 Function or functions to call when a console is deleted.
1139 One argument, the to-be-deleted console.
1141 Vdelete_console_hook = Qnil;
1143 staticpro (&Vconsole_list);
1144 Vconsole_list = Qnil;
1145 staticpro (&Vselected_console);
1146 Vselected_console = Qnil;
1148 #ifdef HAVE_WINDOW_SYSTEM
1149 Fprovide (intern ("window-system"));
1153 /* The docstrings for DEFVAR_* are recorded externally by make-docfile. */
1155 /* Declaring this stuff as const produces 'Cannot reinitialize' messages
1156 from SunPro C's fix-and-continue feature (a way neato feature that
1157 makes debugging unbelievably more bearable) */
1158 #define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magicfun) do { \
1159 static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
1160 = { { { symbol_value_forward_lheader_initializer, \
1161 (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \
1162 forward_type }, magicfun }; \
1164 int offset = ((char *)symbol_value_forward_forward (&I_hate_C) \
1165 - (char *)&console_local_flags); \
1167 defvar_magic (lname, &I_hate_C); \
1169 *((Lisp_Object *)(offset + (char *)XCONSOLE (Vconsole_local_symbols))) \
1174 #define DEFVAR_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \
1175 DEFVAR_CONSOLE_LOCAL_1 (lname, field_name, \
1176 SYMVAL_SELECTED_CONSOLE_FORWARD, magicfun)
1177 #define DEFVAR_CONSOLE_LOCAL(lname, field_name) \
1178 DEFVAR_CONSOLE_LOCAL_MAGIC (lname, field_name, 0)
1179 #define DEFVAR_CONST_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \
1180 DEFVAR_CONSOLE_LOCAL_1 (lname, field_name, \
1181 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD, magicfun)
1182 #define DEFVAR_CONST_CONSOLE_LOCAL(lname, field_name) \
1183 DEFVAR_CONST_CONSOLE_LOCAL_MAGIC (lname, field_name, 0)
1185 #define DEFVAR_CONSOLE_DEFAULTS_MAGIC(lname, field_name, magicfun) \
1186 DEFVAR_SYMVAL_FWD(lname, &(console_local_flags.field_name), \
1187 SYMVAL_DEFAULT_CONSOLE_FORWARD, magicfun)
1188 #define DEFVAR_CONSOLE_DEFAULTS(lname, field_name) \
1189 DEFVAR_CONSOLE_DEFAULTS_MAGIC (lname, field_name, 0)
1192 nuke_all_console_slots (struct console *con, Lisp_Object zap)
1194 zero_lcrecord (con);
1196 #define MARKED_SLOT(x) con->x = (zap);
1197 #include "conslots.h"
1202 complex_vars_of_console (void)
1204 /* Make sure all markable slots in console_defaults
1205 are initialized reasonably, so mark_console won't choke.
1207 struct console *defs = alloc_lcrecord_type (struct console, &lrecord_console);
1208 struct console *syms = alloc_lcrecord_type (struct console, &lrecord_console);
1210 staticpro (&Vconsole_defaults);
1211 staticpro (&Vconsole_local_symbols);
1212 XSETCONSOLE (Vconsole_defaults, defs);
1213 XSETCONSOLE (Vconsole_local_symbols, syms);
1215 nuke_all_console_slots (syms, Qnil);
1216 nuke_all_console_slots (defs, Qnil);
1218 /* Set up the non-nil default values of various console slots.
1219 Must do these before making the first console.
1221 /* #### Anything needed here? */
1224 /* 0 means var is always local. Default used only at creation.
1225 * -1 means var is always local. Default used only at reset and
1227 * -2 means there's no lisp variable corresponding to this slot
1228 * and the default is only used at creation.
1229 * -3 means no Lisp variable. Default used only at reset and creation.
1230 * >0 is mask. Var is local if ((console->local_var_flags & mask) != 0)
1231 * Otherwise default is used.
1233 * #### We don't currently ever reset console variables, so there
1234 * is no current distinction between 0 and -1, and between -2 and -3.
1236 Lisp_Object always_local_resettable = make_int (-1);
1238 #if 0 /* not used */
1239 Lisp_Object always_local_no_default = make_int (0);
1240 Lisp_Object resettable = make_int (-3);
1243 /* Assign the local-flags to the slots that have default values.
1244 The local flag is a bit that is used in the console
1245 to say that it has its own local value for the slot.
1246 The local flag bits are in the local_var_flags slot of the
1249 nuke_all_console_slots (&console_local_flags, make_int (-2));
1250 console_local_flags.defining_kbd_macro = always_local_resettable;
1251 console_local_flags.last_kbd_macro = always_local_resettable;
1252 console_local_flags.prefix_arg = always_local_resettable;
1253 console_local_flags.default_minibuffer_frame = always_local_resettable;
1254 console_local_flags.overriding_terminal_local_map =
1255 always_local_resettable;
1257 console_local_flags.tty_erase_char = always_local_resettable;
1260 console_local_flags.function_key_map = make_int (1);
1262 /* #### Warning, 0x4000000 (that's six zeroes) is the largest number
1263 currently allowable due to the XINT() handling of this value.
1264 With some rearrangement you can get 4 more bits. */
1267 DEFVAR_CONSOLE_DEFAULTS ("default-function-key-map", function_key_map /*
1268 Default value of `function-key-map' for consoles that don't override it.
1269 This is the same as (default-value 'function-key-map).
1272 DEFVAR_CONSOLE_LOCAL ("function-key-map", function_key_map /*
1273 Keymap mapping ASCII function key sequences onto their preferred forms.
1274 This allows Emacs to recognize function keys sent from ASCII
1275 terminals at any point in a key sequence.
1277 The `read-key-sequence' function replaces any subsequence bound by
1278 `function-key-map' with its binding. More precisely, when the active
1279 keymaps have no binding for the current key sequence but
1280 `function-key-map' binds a suffix of the sequence to a vector or string,
1281 `read-key-sequence' replaces the matching suffix with its binding, and
1282 continues with the new sequence.
1284 The events that come from bindings in `function-key-map' are not
1285 themselves looked up in `function-key-map'.
1287 For example, suppose `function-key-map' binds `ESC O P' to [f1].
1288 Typing `ESC O P' to `read-key-sequence' would return
1289 \[#<keypress-event f1>]. Typing `C-x ESC O P' would return
1290 \[#<keypress-event control-X> #<keypress-event f1>]. If [f1]
1291 were a prefix key, typing `ESC O P x' would return
1292 \[#<keypress-event f1> #<keypress-event x>].
1296 /* ### Should this somehow go to TTY data? How do we make it
1297 accessible from Lisp, then? */
1298 DEFVAR_CONSOLE_LOCAL ("tty-erase-char", tty_erase_char /*
1299 The ERASE character as set by the user with stty.
1300 When this value cannot be determined or would be meaningless (on non-TTY
1301 consoles, for example), it is set to nil.
1305 /* While this should be CONST it can't be because some things
1306 (i.e. edebug) do manipulate it. */
1307 DEFVAR_CONSOLE_LOCAL ("defining-kbd-macro", defining_kbd_macro /*
1308 Non-nil while a console macro is being defined. Don't set this!
1311 DEFVAR_CONSOLE_LOCAL ("last-kbd-macro", last_kbd_macro /*
1312 Last kbd macro defined, as a vector of events; nil if none defined.
1315 DEFVAR_CONSOLE_LOCAL ("prefix-arg", prefix_arg /*
1316 The value of the prefix argument for the next editing command.
1317 It may be a number, or the symbol `-' for just a minus sign as arg,
1318 or a list whose car is a number for just one or more C-U's
1319 or nil if no argument has been specified.
1321 You cannot examine this variable to find the argument for this command
1322 since it has been set to nil by the time you can look.
1323 Instead, you should use the variable `current-prefix-arg', although
1324 normally commands can get this prefix argument with (interactive "P").
1327 DEFVAR_CONSOLE_LOCAL ("default-minibuffer-frame",
1328 default_minibuffer_frame /*
1329 Minibufferless frames use this frame's minibuffer.
1331 Emacs cannot create minibufferless frames unless this is set to an
1332 appropriate surrogate.
1334 XEmacs consults this variable only when creating minibufferless
1335 frames; once the frame is created, it sticks with its assigned
1336 minibuffer, no matter what this variable is set to. This means that
1337 this variable doesn't necessarily say anything meaningful about the
1338 current set of frames, or where the minibuffer is currently being
1342 DEFVAR_CONSOLE_LOCAL ("overriding-terminal-local-map",
1343 overriding_terminal_local_map /*
1344 Keymap that overrides all other local keymaps, for the selected console only.
1345 If this variable is non-nil, it is used as a keymap instead of the
1346 buffer's local map, and the minor mode keymaps and text property keymaps.
1349 /* Check for DEFVAR_CONSOLE_LOCAL without initializing the corresponding
1350 slot of console_local_flags and vice-versa. Must be done after all
1351 DEFVAR_CONSOLE_LOCAL() calls. */
1352 #define MARKED_SLOT(slot) \
1353 if ((XINT (console_local_flags.slot) != -2 && \
1354 XINT (console_local_flags.slot) != -3) \
1355 != !(NILP (XCONSOLE (Vconsole_local_symbols)->slot))) \
1357 #include "conslots.h"