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,
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;
786 /**********************************************************************/
787 /* Miscellaneous low-level functions */
788 /**********************************************************************/
791 unwind_init_sys_modes (Lisp_Object console)
793 reinit_initial_console ();
795 if (!no_redraw_on_reenter &&
796 CONSOLEP (console) &&
797 CONSOLE_LIVE_P (XCONSOLE (console)))
800 XFRAME (DEVICE_SELECTED_FRAME
801 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (console)))));
802 MARK_FRAME_CHANGED (f);
807 DEFUN ("suspend-emacs", Fsuspend_emacs, 0, 1, "", /*
808 Stop Emacs and return to superior process. You can resume later.
809 On systems that don't have job control, run a subshell instead.
811 If optional arg STUFFSTRING is non-nil, its characters are stuffed
812 to be read as terminal input by Emacs's superior shell.
814 Before suspending, run the normal hook `suspend-hook'.
815 After resumption run the normal hook `suspend-resume-hook'.
817 Some operating systems cannot stop the Emacs process and resume it later.
818 On such systems, Emacs will start a subshell and wait for it to exit.
822 int speccount = specpdl_depth ();
825 if (!NILP (stuffstring))
826 CHECK_STRING (stuffstring);
827 GCPRO1 (stuffstring);
829 /* There used to be a check that the initial console is TTY.
830 This is bogus. Even checking to see whether any console
831 is a controlling terminal is not correct -- maybe
832 the user used the -t option or something. If we want to
833 suspend, then we suspend. Period. */
835 /* Call value of suspend-hook. */
836 run_hook (Qsuspend_hook);
838 reset_initial_console ();
839 /* sys_suspend can get an error if it tries to fork a subshell
840 and the system resources aren't available for that. */
841 record_unwind_protect (unwind_init_sys_modes, Vcontrolling_terminal);
842 stuff_buffered_input (stuffstring);
844 /* the console is un-reset inside of the unwind-protect. */
845 unbind_to (speccount, Qnil);
848 /* It is possible that a size change occurred while we were
849 suspended. Assume one did just to be safe. It won't hurt
850 anything if one didn't. */
851 asynch_device_change_pending++;
854 /* Call value of suspend-resume-hook
855 if it is bound and value is non-nil. */
856 run_hook (Qsuspend_resume_hook);
862 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
863 Then in any case stuff anything Emacs has read ahead and not used. */
866 stuff_buffered_input (Lisp_Object stuffstring)
868 /* stuff_char works only in BSD, versions 4.2 and up. */
870 if (!CONSOLEP (Vcontrolling_terminal) ||
871 !CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal)))
874 if (STRINGP (stuffstring))
879 GET_STRING_EXT_DATA_ALLOCA (stuffstring, FORMAT_KEYBOARD, p, count);
881 stuff_char (XCONSOLE (Vcontrolling_terminal), *p++);
882 stuff_char (XCONSOLE (Vcontrolling_terminal), '\n');
884 /* Anything we have read ahead, put back for the shell to read. */
885 # if 0 /* oh, who cares about this silliness */
886 while (kbd_fetch_ptr != kbd_store_ptr)
888 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
889 kbd_fetch_ptr = kbd_buffer;
890 stuff_char (XCONSOLE (Vcontrolling_terminal), *kbd_fetch_ptr++);
896 DEFUN ("suspend-console", Fsuspend_console, 0, 1, "", /*
897 Suspend a console. For tty consoles, it sends a signal to suspend
898 the process in charge of the tty, and removes the devices and
899 frames of that console from the display.
901 If optional arg CONSOLE is non-nil, it is the console to be suspended.
902 Otherwise it is assumed to be the selected console.
904 Some operating systems cannot stop processes and resume them later.
905 On such systems, who knows what will happen.
910 struct console *con = decode_console (console);
912 if (CONSOLE_TTY_P (con))
915 * hide all the unhidden frames so the display code won't update
916 * them while the console is suspended.
918 Lisp_Object device = CONSOLE_SELECTED_DEVICE (con);
921 struct device *d = XDEVICE (device);
922 Lisp_Object frame_list = DEVICE_FRAME_LIST (d);
923 while (CONSP (frame_list))
925 struct frame *f = XFRAME (XCAR (frame_list));
926 if (FRAME_REPAINT_P (f))
928 frame_list = XCDR (frame_list);
931 reset_one_console (con);
932 event_stream_unselect_console (con);
933 sys_suspend_process (XINT (Fconsole_tty_controlling_process (console)));
935 #endif /* HAVE_TTY */
940 DEFUN ("resume-console", Fresume_console, 1, 1, "", /*
941 Re-initialize a previously suspended console.
942 For tty consoles, do stuff to the tty to make it sane again.
947 struct console *con = decode_console (console);
949 if (CONSOLE_TTY_P (con))
951 /* raise the selected frame */
952 Lisp_Object device = CONSOLE_SELECTED_DEVICE (con);
955 struct device *d = XDEVICE (device);
956 Lisp_Object frame = DEVICE_SELECTED_FRAME (d);
959 /* force the frame to be cleared */
960 SET_FRAME_CLEAR (XFRAME (frame));
961 Fraise_frame (frame);
964 init_one_console (con);
965 event_stream_select_console (con);
967 /* The same as in Fsuspend_emacs: it is possible that a size
968 change occurred while we were suspended. Assume one did just
969 to be safe. It won't hurt anything if one didn't. */
970 asynch_device_change_pending++;
973 #endif /* HAVE_TTY */
978 DEFUN ("set-input-mode", Fset_input_mode, 3, 5, 0, /*
979 Set mode of reading keyboard input.
980 First arg is ignored, for backward compatibility.
981 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
982 (no effect except in CBREAK mode).
983 Third arg META t means accept 8-bit input (for a Meta key).
984 META nil means ignore the top bit, on the assumption it is parity.
985 Otherwise, accept 8-bit input and don't use the top bit for Meta.
986 First three arguments only apply to TTY consoles.
987 Optional fourth arg QUIT if non-nil specifies character to use for quitting.
988 Optional fifth arg CONSOLE specifies console to make changes to; nil means
989 the selected console.
990 See also `current-input-mode'.
992 (ignored, flow, meta, quit, console))
994 struct console *con = decode_console (console);
995 int meta_key = (!CONSOLE_TTY_P (con) ? 1 :
996 EQ (meta, Qnil) ? 0 :
1002 CHECK_CHAR_COERCE_INT (quit);
1003 CONSOLE_QUIT_CHAR (con) =
1004 ((unsigned int) XCHAR (quit)) & (meta_key ? 0377 : 0177);
1008 if (CONSOLE_TTY_P (con))
1010 reset_one_console (con);
1011 TTY_FLAGS (con).flow_control = !NILP (flow);
1012 TTY_FLAGS (con).meta_key = meta_key;
1013 init_one_console (con);
1020 DEFUN ("current-input-mode", Fcurrent_input_mode, 0, 1, 0, /*
1021 Return information about the way Emacs currently reads keyboard input.
1022 Optional arg CONSOLE specifies console to return information about; nil means
1023 the selected console.
1024 The value is a list of the form (nil FLOW META QUIT), where
1025 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
1026 terminal; this does not apply if Emacs uses interrupt-driven input.
1027 META is t if accepting 8-bit input with 8th bit as Meta flag.
1028 META nil means ignoring the top bit, on the assumption it is parity.
1029 META is neither t nor nil if accepting 8-bit input and using
1030 all 8 bits as the character code.
1031 QUIT is the character Emacs currently uses to quit.
1032 FLOW, and META are only meaningful for TTY consoles.
1033 The elements of this list correspond to the arguments of
1038 struct console *con = decode_console (console);
1039 Lisp_Object flow, meta, quit;
1042 flow = CONSOLE_TTY_P (con) && TTY_FLAGS (con).flow_control ? Qt : Qnil;
1043 meta = (!CONSOLE_TTY_P (con) ? Qt :
1044 TTY_FLAGS (con).meta_key == 1 ? Qt :
1045 TTY_FLAGS (con).meta_key == 2 ? Qzero :
1051 quit = make_char (CONSOLE_QUIT_CHAR (con));
1053 return list4 (Qnil, flow, meta, quit);
1057 /************************************************************************/
1058 /* initialization */
1059 /************************************************************************/
1062 syms_of_console (void)
1064 DEFSUBR (Fvalid_console_type_p);
1065 DEFSUBR (Fconsole_type_list);
1066 DEFSUBR (Fcdfw_console);
1067 DEFSUBR (Fselected_console);
1068 DEFSUBR (Fselect_console);
1069 DEFSUBR (Fconsolep);
1070 DEFSUBR (Fconsole_live_p);
1071 DEFSUBR (Fconsole_type);
1072 DEFSUBR (Fconsole_name);
1073 DEFSUBR (Fconsole_connection);
1074 DEFSUBR (Ffind_console);
1075 DEFSUBR (Fget_console);
1076 DEFSUBR (Fdelete_console);
1077 DEFSUBR (Fconsole_list);
1078 DEFSUBR (Fconsole_device_list);
1079 DEFSUBR (Fconsole_enable_input);
1080 DEFSUBR (Fconsole_disable_input);
1081 DEFSUBR (Fconsole_on_window_system_p);
1082 DEFSUBR (Fsuspend_console);
1083 DEFSUBR (Fresume_console);
1085 DEFSUBR (Fsuspend_emacs);
1086 DEFSUBR (Fset_input_mode);
1087 DEFSUBR (Fcurrent_input_mode);
1089 defsymbol (&Qconsolep, "consolep");
1090 defsymbol (&Qconsole_live_p, "console-live-p");
1092 defsymbol (&Qcreate_console_hook, "create-console-hook");
1093 defsymbol (&Qdelete_console_hook, "delete-console-hook");
1095 defsymbol (&Qsuspend_hook, "suspend-hook");
1096 defsymbol (&Qsuspend_resume_hook, "suspend-resume-hook");
1100 console_type_create (void)
1102 the_console_type_entry_dynarr = Dynarr_new (console_type_entry);
1104 Vconsole_type_list = Qnil;
1105 staticpro (&Vconsole_type_list);
1107 /* Initialize the dead console type */
1108 INITIALIZE_CONSOLE_TYPE (dead, "dead", "console-dead-p");
1110 /* then reset the console-type lists, because `dead' is not really
1111 a valid console type */
1112 Dynarr_reset (the_console_type_entry_dynarr);
1113 Vconsole_type_list = Qnil;
1117 vars_of_console (void)
1119 DEFVAR_LISP ("create-console-hook", &Vcreate_console_hook /*
1120 Function or functions to call when a console is created.
1121 One argument, the newly-created console.
1122 This is called after the first frame has been created, but before
1123 calling the `create-device-hook' or `create-frame-hook'.
1124 Note that in general the console will not be selected.
1126 Vcreate_console_hook = Qnil;
1128 DEFVAR_LISP ("delete-console-hook", &Vdelete_console_hook /*
1129 Function or functions to call when a console is deleted.
1130 One argument, the to-be-deleted console.
1132 Vdelete_console_hook = Qnil;
1134 staticpro (&Vconsole_list);
1135 Vconsole_list = Qnil;
1136 staticpro (&Vselected_console);
1137 Vselected_console = Qnil;
1139 #ifdef HAVE_WINDOW_SYSTEM
1140 Fprovide (intern ("window-system"));
1144 /* The docstrings for DEFVAR_* are recorded externally by make-docfile. */
1146 /* Declaring this stuff as const produces 'Cannot reinitialize' messages
1147 from SunPro C's fix-and-continue feature (a way neato feature that
1148 makes debugging unbelievably more bearable) */
1149 #define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magicfun) do { \
1150 static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
1151 = { { { symbol_value_forward_lheader_initializer, \
1152 (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \
1153 forward_type }, magicfun }; \
1155 int offset = ((char *)symbol_value_forward_forward (&I_hate_C) \
1156 - (char *)&console_local_flags); \
1158 defvar_magic (lname, &I_hate_C); \
1160 *((Lisp_Object *)(offset + (char *)XCONSOLE (Vconsole_local_symbols))) \
1165 #define DEFVAR_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \
1166 DEFVAR_CONSOLE_LOCAL_1 (lname, field_name, \
1167 SYMVAL_SELECTED_CONSOLE_FORWARD, magicfun)
1168 #define DEFVAR_CONSOLE_LOCAL(lname, field_name) \
1169 DEFVAR_CONSOLE_LOCAL_MAGIC (lname, field_name, 0)
1170 #define DEFVAR_CONST_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \
1171 DEFVAR_CONSOLE_LOCAL_1 (lname, field_name, \
1172 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD, magicfun)
1173 #define DEFVAR_CONST_CONSOLE_LOCAL(lname, field_name) \
1174 DEFVAR_CONST_CONSOLE_LOCAL_MAGIC (lname, field_name, 0)
1176 #define DEFVAR_CONSOLE_DEFAULTS_MAGIC(lname, field_name, magicfun) \
1177 DEFVAR_SYMVAL_FWD(lname, &(console_local_flags.field_name), \
1178 SYMVAL_DEFAULT_CONSOLE_FORWARD, magicfun)
1179 #define DEFVAR_CONSOLE_DEFAULTS(lname, field_name) \
1180 DEFVAR_CONSOLE_DEFAULTS_MAGIC (lname, field_name, 0)
1183 nuke_all_console_slots (struct console *con, Lisp_Object zap)
1185 zero_lcrecord (con);
1187 #define MARKED_SLOT(x) con->x = (zap);
1188 #include "conslots.h"
1193 complex_vars_of_console (void)
1195 /* Make sure all markable slots in console_defaults
1196 are initialized reasonably, so mark_console won't choke.
1198 struct console *defs = alloc_lcrecord_type (struct console, lrecord_console);
1199 struct console *syms = alloc_lcrecord_type (struct console, lrecord_console);
1201 staticpro (&Vconsole_defaults);
1202 staticpro (&Vconsole_local_symbols);
1203 XSETCONSOLE (Vconsole_defaults, defs);
1204 XSETCONSOLE (Vconsole_local_symbols, syms);
1206 nuke_all_console_slots (syms, Qnil);
1207 nuke_all_console_slots (defs, Qnil);
1209 /* Set up the non-nil default values of various console slots.
1210 Must do these before making the first console.
1212 /* #### Anything needed here? */
1215 /* 0 means var is always local. Default used only at creation.
1216 * -1 means var is always local. Default used only at reset and
1218 * -2 means there's no lisp variable corresponding to this slot
1219 * and the default is only used at creation.
1220 * -3 means no Lisp variable. Default used only at reset and creation.
1221 * >0 is mask. Var is local if ((console->local_var_flags & mask) != 0)
1222 * Otherwise default is used.
1224 * #### We don't currently ever reset console variables, so there
1225 * is no current distinction between 0 and -1, and between -2 and -3.
1227 Lisp_Object always_local_resettable = make_int (-1);
1229 #if 0 /* not used */
1230 Lisp_Object always_local_no_default = make_int (0);
1231 Lisp_Object resettable = make_int (-3);
1234 /* Assign the local-flags to the slots that have default values.
1235 The local flag is a bit that is used in the console
1236 to say that it has its own local value for the slot.
1237 The local flag bits are in the local_var_flags slot of the
1240 nuke_all_console_slots (&console_local_flags, make_int (-2));
1241 console_local_flags.defining_kbd_macro = always_local_resettable;
1242 console_local_flags.last_kbd_macro = always_local_resettable;
1243 console_local_flags.prefix_arg = always_local_resettable;
1244 console_local_flags.default_minibuffer_frame = always_local_resettable;
1245 console_local_flags.overriding_terminal_local_map =
1246 always_local_resettable;
1248 console_local_flags.tty_erase_char = always_local_resettable;
1251 console_local_flags.function_key_map = make_int (1);
1253 /* #### Warning, 0x4000000 (that's six zeroes) is the largest number
1254 currently allowable due to the XINT() handling of this value.
1255 With some rearrangement you can get 4 more bits. */
1258 DEFVAR_CONSOLE_DEFAULTS ("default-function-key-map", function_key_map /*
1259 Default value of `function-key-map' for consoles that don't override it.
1260 This is the same as (default-value 'function-key-map).
1263 DEFVAR_CONSOLE_LOCAL ("function-key-map", function_key_map /*
1264 Keymap mapping ASCII function key sequences onto their preferred forms.
1265 This allows Emacs to recognize function keys sent from ASCII
1266 terminals at any point in a key sequence.
1268 The `read-key-sequence' function replaces any subsequence bound by
1269 `function-key-map' with its binding. More precisely, when the active
1270 keymaps have no binding for the current key sequence but
1271 `function-key-map' binds a suffix of the sequence to a vector or string,
1272 `read-key-sequence' replaces the matching suffix with its binding, and
1273 continues with the new sequence.
1275 The events that come from bindings in `function-key-map' are not
1276 themselves looked up in `function-key-map'.
1278 For example, suppose `function-key-map' binds `ESC O P' to [f1].
1279 Typing `ESC O P' to `read-key-sequence' would return
1280 \[#<keypress-event f1>]. Typing `C-x ESC O P' would return
1281 \[#<keypress-event control-X> #<keypress-event f1>]. If [f1]
1282 were a prefix key, typing `ESC O P x' would return
1283 \[#<keypress-event f1> #<keypress-event x>].
1287 /* ### Should this somehow go to TTY data? How do we make it
1288 accessible from Lisp, then? */
1289 DEFVAR_CONSOLE_LOCAL ("tty-erase-char", tty_erase_char /*
1290 The ERASE character as set by the user with stty.
1291 When this value cannot be determined or would be meaningless (on non-TTY
1292 consoles, for example), it is set to nil.
1296 /* While this should be CONST it can't be because some things
1297 (i.e. edebug) do manipulate it. */
1298 DEFVAR_CONSOLE_LOCAL ("defining-kbd-macro", defining_kbd_macro /*
1299 Non-nil while a console macro is being defined. Don't set this!
1302 DEFVAR_CONSOLE_LOCAL ("last-kbd-macro", last_kbd_macro /*
1303 Last kbd macro defined, as a vector of events; nil if none defined.
1306 DEFVAR_CONSOLE_LOCAL ("prefix-arg", prefix_arg /*
1307 The value of the prefix argument for the next editing command.
1308 It may be a number, or the symbol `-' for just a minus sign as arg,
1309 or a list whose car is a number for just one or more C-U's
1310 or nil if no argument has been specified.
1312 You cannot examine this variable to find the argument for this command
1313 since it has been set to nil by the time you can look.
1314 Instead, you should use the variable `current-prefix-arg', although
1315 normally commands can get this prefix argument with (interactive "P").
1318 DEFVAR_CONSOLE_LOCAL ("default-minibuffer-frame",
1319 default_minibuffer_frame /*
1320 Minibufferless frames use this frame's minibuffer.
1322 Emacs cannot create minibufferless frames unless this is set to an
1323 appropriate surrogate.
1325 XEmacs consults this variable only when creating minibufferless
1326 frames; once the frame is created, it sticks with its assigned
1327 minibuffer, no matter what this variable is set to. This means that
1328 this variable doesn't necessarily say anything meaningful about the
1329 current set of frames, or where the minibuffer is currently being
1333 DEFVAR_CONSOLE_LOCAL ("overriding-terminal-local-map",
1334 overriding_terminal_local_map /*
1335 Keymap that overrides all other local keymaps, for the selected console only.
1336 If this variable is non-nil, it is used as a keymap instead of the
1337 buffer's local map, and the minor mode keymaps and text property keymaps.
1340 /* Check for DEFVAR_CONSOLE_LOCAL without initializing the corresponding
1341 slot of console_local_flags and vice-versa. Must be done after all
1342 DEFVAR_CONSOLE_LOCAL() calls. */
1343 #define MARKED_SLOT(slot) \
1344 if ((XINT (console_local_flags.slot) != -2 && \
1345 XINT (console_local_flags.slot) != -3) \
1346 != !(NILP (XCONSOLE (Vconsole_local_symbols)->slot))) \
1348 #include "conslots.h"