Mercurial > hg > xemacs-beta
annotate src/console.c @ 5602:c9e5612f5424
Support the MP library on recent FreeBSD, have it pass relevant tests.
src/ChangeLog addition:
2011-11-26 Aidan Kehoe <kehoea@parhasard.net>
* number-mp.c (bignum_to_string):
Don't overwrite the accumulator we've just set up for this
function.
* number-mp.c (BIGNUM_TO_TYPE):
mp_itom() doesn't necessarily do what this code used to think with
negative numbers, it can treat them as unsigned ints. Subtract
numbers from bignum_zero instead of multiplying them by -1 to
convert them to their negative equivalents.
* number-mp.c (bignum_to_int):
* number-mp.c (bignum_to_uint):
* number-mp.c (bignum_to_long):
* number-mp.c (bignum_to_ulong):
* number-mp.c (bignum_to_double):
Use the changed BIGNUM_TO_TYPE() in these functions.
* number-mp.c (bignum_ceil):
* number-mp.c (bignum_floor):
In these functions, be more careful about rounding to positive and
negative infinity, respectively. Don't use the sign of QUOTIENT
when working out out whether to add or subtract one, rather use
the sign QUOTIENT would have if arbitrary-precision division were
done.
* number-mp.h:
* number-mp.h (MP_GCD):
Wrap #include <mp.h> in BEGIN_C_DECLS/END_C_DECLS.
* number.c (Fbigfloat_get_precision):
* number.c (Fbigfloat_set_precision):
Don't attempt to call XBIGFLOAT_GET_PREC if this build doesn't
support big floats.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 26 Nov 2011 17:59:14 +0000 |
| parents | 56144c8593a8 |
| children |
| 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 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5529
diff
changeset
|
707 if ((XFIXNUM (Flength (Vconsole_list)) == 1) |
| 428 | 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; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5529
diff
changeset
|
727 Fkill_emacs (make_fixnum (70)); |
| 428 | 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); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5529
diff
changeset
|
1057 sys_suspend_process (XFIXNUM (Fconsole_tty_controlling_process (console))); |
| 428 | 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 */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5529
diff
changeset
|
1439 Lisp_Object always_local_resettable = make_fixnum (-1); |
| 428 | 1440 |
| 1441 #if 0 /* not used */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5529
diff
changeset
|
1442 Lisp_Object always_local_no_default = make_fixnum (0); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5529
diff
changeset
|
1443 Lisp_Object resettable = make_fixnum (-3); |
| 428 | 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); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5529
diff
changeset
|
1454 nuke_all_console_slots (&console_local_flags, make_fixnum (-2)); |
| 428 | 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 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5529
diff
changeset
|
1465 console_local_flags.function_key_map = make_fixnum (1); |
| 428 | 1466 |
| 1467 /* #### Warning, 0x4000000 (that's six zeroes) is the largest number | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5529
diff
changeset
|
1468 currently allowable due to the XFIXNUM() handling of this value. |
| 428 | 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) \ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5529
diff
changeset
|
1610 assert ((XFIXNUM (console_local_flags.slot) != -2 && \ |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5529
diff
changeset
|
1611 XFIXNUM (console_local_flags.slot) != -3) \ |
|
5050
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 } |