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