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