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