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