Mercurial > hg > xemacs-beta
annotate src/console.c @ 4981:4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-02-05 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_lo_import):
* postgresql/postgresql.c (Fpq_lo_export):
* ldap/eldap.c (Fldap_open):
* ldap/eldap.c (Fldap_search_basic):
* ldap/eldap.c (Fldap_add):
* ldap/eldap.c (Fldap_modify):
* ldap/eldap.c (Fldap_delete):
* canna/canna_api.c (Fcanna_initialize):
* canna/canna_api.c (Fcanna_store_yomi):
* canna/canna_api.c (Fcanna_parse):
* canna/canna_api.c (Fcanna_henkan_begin):
EXTERNAL_TO_C_STRING returns its argument instead of storing it
in a parameter, and is renamed to EXTERNAL_TO_ITEXT. Similar
things happen to related macros. See entry in src/ChangeLog.
More Mule-izing of postgresql.c. Extract out common code
between `pq-connectdb' and `pq-connect-start'. Fix places
that signal an error string using a formatted string to instead
follow the standard and have a fixed reason followed by the
particular error message stored as one of the frobs.
src/ChangeLog addition:
2010-02-05 Ben Wing <ben@xemacs.org>
* console-msw.c (write_string_to_mswindows_debugging_output):
* console-msw.c (Fmswindows_message_box):
* console-x.c (x_perhaps_init_unseen_key_defaults):
* console.c:
* database.c (dbm_get):
* database.c (dbm_put):
* database.c (dbm_remove):
* database.c (berkdb_get):
* database.c (berkdb_put):
* database.c (berkdb_remove):
* database.c (Fopen_database):
* device-gtk.c (gtk_init_device):
* device-msw.c (msprinter_init_device_internal):
* device-msw.c (msprinter_default_printer):
* device-msw.c (msprinter_init_device):
* device-msw.c (sync_printer_with_devmode):
* device-msw.c (Fmsprinter_select_settings):
* device-x.c (sanity_check_geometry_resource):
* device-x.c (Dynarr_add_validified_lisp_string):
* device-x.c (x_init_device):
* device-x.c (Fx_put_resource):
* device-x.c (Fx_valid_keysym_name_p):
* device-x.c (Fx_set_font_path):
* dialog-msw.c (push_lisp_string_as_unicode):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-x.c (dbox_descriptor_to_widget_value):
* editfns.c (Fformat_time_string):
* editfns.c (Fencode_time):
* editfns.c (Fset_time_zone_rule):
* emacs.c (make_argc_argv):
* emacs.c (Fdump_emacs):
* emodules.c (emodules_load):
* eval.c:
* eval.c (maybe_signal_error_1):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (mswindows_wnd_proc):
* fileio.c (report_error_with_errno):
* fileio.c (Fsysnetunam):
* fileio.c (Fdo_auto_save):
* font-mgr.c (extract_fcapi_string):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_filename):
* frame-gtk.c (gtk_set_frame_text_value):
* frame-gtk.c (gtk_create_widgets):
* frame-msw.c (mswindows_init_frame_1):
* frame-msw.c (mswindows_set_title_from_ibyte):
* frame-msw.c (msprinter_init_frame_3):
* frame-x.c (x_set_frame_text_value):
* frame-x.c (x_set_frame_properties):
* frame-x.c (start_drag_internal_1):
* frame-x.c (x_cde_transfer_callback):
* frame-x.c (x_create_widgets):
* glyphs-eimage.c (my_jpeg_output_message):
* glyphs-eimage.c (jpeg_instantiate):
* glyphs-eimage.c (gif_instantiate):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (xbm_instantiate_1):
* glyphs-gtk.c (gtk_xbm_instantiate):
* glyphs-gtk.c (gtk_xpm_instantiate):
* glyphs-gtk.c (gtk_xface_instantiate):
* glyphs-gtk.c (cursor_font_instantiate):
* glyphs-gtk.c (gtk_redisplay_widget):
* glyphs-gtk.c (gtk_widget_instantiate_1):
* glyphs-gtk.c (gtk_add_tab_item):
* glyphs-msw.c (mswindows_xpm_instantiate):
* glyphs-msw.c (bmp_instantiate):
* glyphs-msw.c (mswindows_resource_instantiate):
* glyphs-msw.c (xbm_instantiate_1):
* glyphs-msw.c (mswindows_xbm_instantiate):
* glyphs-msw.c (mswindows_xface_instantiate):
* glyphs-msw.c (mswindows_redisplay_widget):
* glyphs-msw.c (mswindows_widget_instantiate):
* glyphs-msw.c (add_tree_item):
* glyphs-msw.c (add_tab_item):
* glyphs-msw.c (mswindows_combo_box_instantiate):
* glyphs-msw.c (mswindows_widget_query_string_geometry):
* glyphs-x.c (x_locate_pixmap_file):
* glyphs-x.c (xbm_instantiate_1):
* glyphs-x.c (x_xbm_instantiate):
* glyphs-x.c (extract_xpm_color_names):
* glyphs-x.c (x_xpm_instantiate):
* glyphs-x.c (x_xface_instantiate):
* glyphs-x.c (autodetect_instantiate):
* glyphs-x.c (safe_XLoadFont):
* glyphs-x.c (cursor_font_instantiate):
* glyphs-x.c (x_redisplay_widget):
* glyphs-x.c (Fchange_subwindow_property):
* glyphs-x.c (x_widget_instantiate):
* glyphs-x.c (x_tab_control_redisplay):
* glyphs.c (pixmap_to_lisp_data):
* gui-x.c (menu_separator_style_and_to_external):
* gui-x.c (add_accel_and_to_external):
* gui-x.c (button_item_to_widget_value):
* hpplay.c (player_error_internal):
* hpplay.c (play_sound_file):
* hpplay.c (play_sound_data):
* intl.c (Fset_current_locale):
* lisp.h:
* menubar-gtk.c (gtk_xemacs_set_accel_keys):
* menubar-msw.c (populate_menu_add_item):
* menubar-msw.c (populate_or_checksum_helper):
* menubar-x.c (menu_item_descriptor_to_widget_value_1):
* nt.c (init_user_info):
* nt.c (get_long_basename):
* nt.c (nt_get_resource):
* nt.c (init_mswindows_environment):
* nt.c (get_cached_volume_information):
* nt.c (mswindows_readdir):
* nt.c (read_unc_volume):
* nt.c (mswindows_stat):
* nt.c (mswindows_getdcwd):
* nt.c (mswindows_executable_type):
* nt.c (Fmswindows_short_file_name):
* ntplay.c (nt_play_sound_file):
* objects-gtk.c:
* objects-gtk.c (gtk_valid_color_name_p):
* objects-gtk.c (gtk_initialize_font_instance):
* objects-gtk.c (gtk_font_list):
* objects-msw.c (font_enum_callback_2):
* objects-msw.c (parse_font_spec):
* objects-x.c (x_parse_nearest_color):
* objects-x.c (x_valid_color_name_p):
* objects-x.c (x_initialize_font_instance):
* objects-x.c (x_font_instance_truename):
* objects-x.c (x_font_list):
* objects-xlike-inc.c (XFUN):
* objects-xlike-inc.c (xft_find_charset_font):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_create_process):
* process-nt.c (get_internet_address):
* process-nt.c (nt_open_network_stream):
* process-unix.c:
* process-unix.c (allocate_pty):
* process-unix.c (get_internet_address):
* process-unix.c (unix_canonicalize_host_name):
* process-unix.c (unix_open_network_stream):
* realpath.c:
* select-common.h (lisp_data_to_selection_data):
* select-gtk.c (symbol_to_gtk_atom):
* select-gtk.c (atom_to_symbol):
* select-msw.c (symbol_to_ms_cf):
* select-msw.c (mswindows_register_selection_data_type):
* select-x.c (symbol_to_x_atom):
* select-x.c (x_atom_to_symbol):
* select-x.c (hack_motif_clipboard_selection):
* select-x.c (Fx_store_cutbuffer_internal):
* sound.c (Fplay_sound_file):
* sound.c (Fplay_sound):
* sound.h (sound_perror):
* sysdep.c:
* sysdep.c (qxe_allocating_getcwd):
* sysdep.c (qxe_execve):
* sysdep.c (copy_in_passwd):
* sysdep.c (qxe_getpwnam):
* sysdep.c (qxe_ctime):
* sysdll.c (dll_open):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (search_linked_libs):
* sysdll.c (dll_error):
* sysfile.h:
* sysfile.h (PATHNAME_CONVERT_OUT_TSTR):
* sysfile.h (PATHNAME_CONVERT_OUT_UTF_8):
* sysfile.h (PATHNAME_CONVERT_OUT):
* sysfile.h (LISP_PATHNAME_CONVERT_OUT):
* syswindows.h (ITEXT_TO_TSTR):
* syswindows.h (LOCAL_FILE_FORMAT_TO_TSTR):
* syswindows.h (TSTR_TO_LOCAL_FILE_FORMAT):
* syswindows.h (LOCAL_FILE_FORMAT_TO_INTERNAL_MSWIN):
* syswindows.h (LISP_LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR):
* text.h:
* text.h (eicpy_ext_len):
* text.h (enum new_dfc_src_type):
* text.h (EXTERNAL_TO_ITEXT):
* text.h (GET_STRERROR):
* tooltalk.c (check_status):
* tooltalk.c (Fadd_tooltalk_message_arg):
* tooltalk.c (Fadd_tooltalk_pattern_attribute):
* tooltalk.c (Fadd_tooltalk_pattern_arg):
* win32.c (tstr_to_local_file_format):
* win32.c (mswindows_lisp_error_1):
* win32.c (mswindows_report_process_error):
* win32.c (Fmswindows_shell_execute):
* win32.c (mswindows_read_link_1):
Changes involving external/internal format conversion,
mostly code cleanup and renaming.
1. Eliminate the previous macros like LISP_STRING_TO_EXTERNAL
that stored its result in a parameter. The new version of
LISP_STRING_TO_EXTERNAL returns its result through the
return value, same as the previous NEW_LISP_STRING_TO_EXTERNAL.
Use the new-style macros throughout the code.
2. Rename C_STRING_TO_EXTERNAL and friends to ITEXT_TO_EXTERNAL,
in keeping with overall naming rationalization involving
Itext and related types.
Macros involved in previous two:
EXTERNAL_TO_C_STRING -> EXTERNAL_TO_ITEXT
EXTERNAL_TO_C_STRING_MALLOC -> EXTERNAL_TO_ITEXT_MALLOC
SIZED_EXTERNAL_TO_C_STRING -> SIZED_EXTERNAL_TO_ITEXT
SIZED_EXTERNAL_TO_C_STRING_MALLOC -> SIZED_EXTERNAL_TO_ITEXT_MALLOC
C_STRING_TO_EXTERNAL -> ITEXT_TO_EXTERNAL
C_STRING_TO_EXTERNAL_MALLOC -> ITEXT_TO_EXTERNAL_MALLOC
LISP_STRING_TO_EXTERNAL
LISP_STRING_TO_EXTERNAL_MALLOC
LISP_STRING_TO_TSTR
C_STRING_TO_TSTR -> ITEXT_TO_TSTR
TSTR_TO_C_STRING -> TSTR_TO_ITEXT
The following four still return their values through parameters,
since they have more than one value to return:
C_STRING_TO_SIZED_EXTERNAL -> ITEXT_TO_SIZED_EXTERNAL
LISP_STRING_TO_SIZED_EXTERNAL
C_STRING_TO_SIZED_EXTERNAL_MALLOC -> ITEXT_TO_SIZED_EXTERNAL_MALLOC
LISP_STRING_TO_SIZED_EXTERNAL_MALLOC
Sometimes additional casts had to be inserted, since the old
macros played strange games and completely defeated the type system
of the store params.
3. Rewrite many places where direct calls to TO_EXTERNAL_FORMAT
occurred with calls to one of the convenience macros listed above,
or to make_extstring().
4. Eliminate SIZED_C_STRING macros (they were hardly used, anyway)
and use a direct call to TO_EXTERNAL_FORMAT or TO_INTERNAL_FORMAT.
4. Use LISP_PATHNAME_CONVERT_OUT in many places instead of something
like LISP_STRING_TO_EXTERNAL(..., Qfile_name).
5. Eliminate some temporary variables that are no longer necessary
now that we return a value rather than storing it into a variable.
6. Some Mule-izing in database.c.
7. Error functions:
-- A bit of code cleanup in maybe_signal_error_1.
-- Eliminate report_file_type_error; it's just an alias for
signal_error_2 with params in a different order.
-- Fix some places in the hostname-handling code that directly
inserted externally-retrieved error strings into the
supposed ASCII "reason" param instead of doing the right thing
and sticking text descriptive of what was going on in "reason"
and putting the external message in a frob.
8. Use Ascbyte instead of CIbyte in process-unix.c and maybe one
or two other places.
9. Some code cleanup in copy_in_passwd() in sysdep.c.
10. Fix a real bug due to accidental variable shadowing in
tstr_to_local_file_format() in win32.c.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 05 Feb 2010 11:02:24 -0600 |
| parents | a98ca4640147 |
| children | ae48681c47fa |
| 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) | |
| 4846 | 172 printing_unreadable_lcrecord (obj, XSTRING_DATA (con->name)); |
| 428 | 173 |
| 800 | 174 write_fmt_string (printcharfun, "#<%s-console", |
| 175 !CONSOLE_LIVE_P (con) ? "dead" : CONSOLE_TYPE_NAME (con)); | |
| 440 | 176 if (CONSOLE_LIVE_P (con) && !NILP (CONSOLE_CONNECTION (con))) |
| 800 | 177 write_fmt_string_lisp (printcharfun, " on %S", 1, |
| 178 CONSOLE_CONNECTION (con)); | |
| 179 write_fmt_string (printcharfun, " 0x%x>", con->header.uid); | |
| 428 | 180 } |
| 181 | |
| 934 | 182 DEFINE_LRECORD_IMPLEMENTATION ("console", console, |
| 183 0, /*dumpable-flag*/ | |
| 184 mark_console, print_console, 0, 0, 0, | |
| 185 console_description, | |
| 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 { |
| 203 Lisp_Object console; | |
| 3017 | 204 struct console *con = ALLOC_LCRECORD_TYPE (struct console, &lrecord_console); |
| 428 | 205 struct gcpro gcpro1; |
| 206 | |
| 3017 | 207 COPY_LCRECORD (con, XCONSOLE (Vconsole_defaults)); |
| 428 | 208 |
| 793 | 209 console = wrap_console (con); |
| 428 | 210 GCPRO1 (console); |
| 211 | |
| 1204 | 212 con->conmeths = decode_console_type (type, ERROR_ME); |
| 213 con->contype = get_console_variant (type); | |
| 771 | 214 con->command_builder = allocate_command_builder (console, 1); |
| 428 | 215 con->function_key_map = Fmake_sparse_keymap (Qnil); |
| 1204 | 216 set_quit_events (con, make_char (7)); /* C-g */ |
| 428 | 217 |
| 218 UNGCPRO; | |
| 219 return con; | |
| 220 } | |
| 221 | |
| 222 struct console * | |
| 223 decode_console (Lisp_Object console) | |
| 224 { | |
| 225 if (NILP (console)) | |
| 226 console = Fselected_console (); | |
| 227 /* quietly accept devices and frames for the console arg */ | |
| 228 if (DEVICEP (console) || FRAMEP (console)) | |
| 229 console = DEVICE_CONSOLE (decode_device (console)); | |
| 230 CHECK_LIVE_CONSOLE (console); | |
| 231 return XCONSOLE (console); | |
| 232 } | |
| 233 | |
| 234 | |
| 235 struct console_methods * | |
| 578 | 236 decode_console_type (Lisp_Object type, Error_Behavior errb) |
| 428 | 237 { |
| 238 int i; | |
| 239 | |
| 240 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++) | |
| 241 if (EQ (type, Dynarr_at (the_console_type_entry_dynarr, i).symbol)) | |
| 242 return Dynarr_at (the_console_type_entry_dynarr, i).meths; | |
| 243 | |
| 563 | 244 maybe_invalid_constant ("Invalid console type", type, Qconsole, errb); |
| 428 | 245 |
| 246 return 0; | |
| 247 } | |
| 248 | |
| 934 | 249 enum console_variant |
| 250 get_console_variant (Lisp_Object type) | |
| 251 { | |
| 252 if (EQ (type, Qtty)) | |
| 1204 | 253 return tty_console; |
| 934 | 254 |
| 255 if (EQ (type, Qgtk)) | |
| 1204 | 256 return gtk_console; |
| 934 | 257 |
| 258 if (EQ (type, Qx)) | |
| 1204 | 259 return x_console; |
| 934 | 260 |
| 261 if (EQ (type, Qmswindows)) | |
| 1204 | 262 return mswindows_console; |
| 934 | 263 |
| 1346 | 264 if (EQ (type, Qmsprinter)) |
| 265 return msprinter_console; | |
| 266 | |
| 934 | 267 if (EQ (type, Qstream)) |
| 1204 | 268 return stream_console; |
| 934 | 269 |
| 2500 | 270 ABORT (); /* should never happen */ |
| 934 | 271 return dead_console; |
| 272 } | |
| 273 | |
| 428 | 274 int |
| 275 valid_console_type_p (Lisp_Object type) | |
| 276 { | |
| 277 return decode_console_type (type, ERROR_ME_NOT) != 0; | |
| 278 } | |
| 279 | |
| 280 DEFUN ("valid-console-type-p", Fvalid_console_type_p, 1, 1, 0, /* | |
| 444 | 281 Return t if CONSOLE-TYPE is a valid console type. |
| 3025 | 282 Valid types are `x', `tty', `mswindows', `msprinter', `gtk', and `stream'. |
| 428 | 283 */ |
| 284 (console_type)) | |
| 285 { | |
| 286 return valid_console_type_p (console_type) ? Qt : Qnil; | |
| 287 } | |
| 288 | |
| 289 DEFUN ("console-type-list", Fconsole_type_list, 0, 0, 0, /* | |
| 290 Return a list of valid console types. | |
| 291 */ | |
| 292 ()) | |
| 293 { | |
| 294 return Fcopy_sequence (Vconsole_type_list); | |
| 295 } | |
| 296 | |
| 297 DEFUN ("cdfw-console", Fcdfw_console, 1, 1, 0, /* | |
| 298 Given a console, device, frame, or window, return the associated console. | |
| 299 Return nil otherwise. | |
| 300 */ | |
| 444 | 301 (object)) |
| 428 | 302 { |
| 444 | 303 return CDFW_CONSOLE (object); |
| 428 | 304 } |
| 305 | |
| 872 | 306 int |
| 307 console_live_p (struct console *c) | |
| 308 { | |
| 309 return CONSOLE_LIVE_P (c); | |
| 310 } | |
| 311 | |
| 312 Lisp_Object | |
| 313 console_device_list (struct console *c) | |
| 314 { | |
| 315 return CONSOLE_DEVICE_LIST (c); | |
| 316 } | |
| 317 | |
| 428 | 318 |
| 319 DEFUN ("selected-console", Fselected_console, 0, 0, 0, /* | |
| 320 Return the console which is currently active. | |
| 321 */ | |
| 322 ()) | |
| 323 { | |
| 324 return Vselected_console; | |
| 325 } | |
| 326 | |
| 327 /* Called from selected_device_1(), called from selected_frame_1(), | |
| 328 called from Fselect_window() */ | |
| 329 void | |
| 330 select_console_1 (Lisp_Object console) | |
| 331 { | |
| 332 /* perhaps this should do something more complicated */ | |
| 333 Vselected_console = console; | |
| 334 | |
| 335 /* #### Schedule this to be removed in 19.14 */ | |
| 336 #ifdef HAVE_X_WINDOWS | |
| 337 if (CONSOLE_X_P (XCONSOLE (console))) | |
| 338 Vwindow_system = Qx; | |
| 339 else | |
| 340 #endif | |
| 462 | 341 #ifdef HAVE_GTK |
| 342 if (CONSOLE_GTK_P (XCONSOLE (console))) | |
| 343 Vwindow_system = Qgtk; | |
| 344 else | |
| 345 #endif | |
| 428 | 346 #ifdef HAVE_MS_WINDOWS |
| 347 if (CONSOLE_MSWINDOWS_P (XCONSOLE (console))) | |
| 348 Vwindow_system = Qmswindows; | |
| 349 else | |
| 350 #endif | |
| 351 Vwindow_system = Qnil; | |
| 352 } | |
| 353 | |
| 354 DEFUN ("select-console", Fselect_console, 1, 1, 0, /* | |
| 355 Select the console CONSOLE. | |
| 356 Subsequent editing commands apply to its selected device, selected frame, | |
| 357 and selected window. The selection of CONSOLE lasts until the next time | |
| 358 the user does something to select a different console, or until the next | |
| 359 time this function is called. | |
| 360 */ | |
| 361 (console)) | |
| 362 { | |
| 363 Lisp_Object device; | |
| 364 | |
| 365 CHECK_LIVE_CONSOLE (console); | |
| 366 | |
| 367 device = CONSOLE_SELECTED_DEVICE (XCONSOLE (console)); | |
| 368 if (!NILP (device)) | |
| 369 { | |
| 370 struct device *d = XDEVICE (device); | |
| 371 Lisp_Object frame = DEVICE_SELECTED_FRAME (d); | |
| 372 if (!NILP (frame)) | |
| 373 { | |
| 374 struct frame *f = XFRAME(frame); | |
| 375 Fselect_window (FRAME_SELECTED_WINDOW (f), Qnil); | |
| 376 } | |
| 377 else | |
| 563 | 378 invalid_operation ("Can't select console with no frames", Qunbound); |
| 428 | 379 } |
| 380 else | |
| 563 | 381 invalid_operation ("Can't select a console with no devices", Qunbound); |
| 428 | 382 return Qnil; |
| 383 } | |
| 384 | |
| 385 void | |
| 386 set_console_last_nonminibuf_frame (struct console *con, | |
| 387 Lisp_Object frame) | |
| 388 { | |
| 389 con->last_nonminibuf_frame = frame; | |
| 390 } | |
| 391 | |
| 392 DEFUN ("consolep", Fconsolep, 1, 1, 0, /* | |
| 393 Return non-nil if OBJECT is a console. | |
| 394 */ | |
| 395 (object)) | |
| 396 { | |
| 397 return CONSOLEP (object) ? Qt : Qnil; | |
| 398 } | |
| 399 | |
| 400 DEFUN ("console-live-p", Fconsole_live_p, 1, 1, 0, /* | |
| 401 Return non-nil if OBJECT is a console that has not been deleted. | |
| 402 */ | |
| 403 (object)) | |
| 404 { | |
| 405 return CONSOLEP (object) && CONSOLE_LIVE_P (XCONSOLE (object)) ? Qt : Qnil; | |
| 406 } | |
| 407 | |
| 408 DEFUN ("console-type", Fconsole_type, 0, 1, 0, /* | |
| 444 | 409 Return the console type (e.g. `x' or `tty') of CONSOLE. |
| 1346 | 410 Value is |
| 411 `tty' for a tty console (a character-only terminal), | |
| 428 | 412 `x' for a console that is an X display, |
| 1346 | 413 `mswindows' for a console that is an MS Windows connection, |
| 414 `msprinter' for a console that is an MS Windows printer connection, | |
| 415 `gtk' for a console that is a GTK connection, | |
| 428 | 416 `stream' for a stream console (which acts like a stdio stream), and |
| 417 `dead' for a deleted console. | |
| 418 */ | |
| 419 (console)) | |
| 420 { | |
| 421 /* don't call decode_console() because we want to allow for dead | |
| 422 consoles. */ | |
| 423 if (NILP (console)) | |
| 424 console = Fselected_console (); | |
| 425 CHECK_CONSOLE (console); | |
| 426 return CONSOLE_TYPE (XCONSOLE (console)); | |
| 427 } | |
| 428 | |
| 429 DEFUN ("console-name", Fconsole_name, 0, 1, 0, /* | |
| 444 | 430 Return the name of CONSOLE. |
| 428 | 431 */ |
| 432 (console)) | |
| 433 { | |
| 434 return CONSOLE_NAME (decode_console (console)); | |
| 435 } | |
| 436 | |
| 437 DEFUN ("console-connection", Fconsole_connection, 0, 1, 0, /* | |
| 438 Return the connection of the specified console. | |
| 439 CONSOLE defaults to the selected console if omitted. | |
| 440 */ | |
| 441 (console)) | |
| 442 { | |
| 443 return CONSOLE_CONNECTION (decode_console (console)); | |
| 444 } | |
| 445 | |
| 446 static Lisp_Object | |
| 447 semi_canonicalize_console_connection (struct console_methods *meths, | |
| 578 | 448 Lisp_Object name, Error_Behavior errb) |
| 428 | 449 { |
| 440 | 450 if (HAS_CONTYPE_METH_P (meths, semi_canonicalize_console_connection)) |
| 451 return CONTYPE_METH (meths, semi_canonicalize_console_connection, | |
| 452 (name, errb)); | |
| 453 else | |
| 454 return CONTYPE_METH_OR_GIVEN (meths, canonicalize_console_connection, | |
| 455 (name, errb), name); | |
| 428 | 456 } |
| 457 | |
| 458 static Lisp_Object | |
| 459 canonicalize_console_connection (struct console_methods *meths, | |
| 578 | 460 Lisp_Object name, Error_Behavior errb) |
| 428 | 461 { |
| 440 | 462 if (HAS_CONTYPE_METH_P (meths, canonicalize_console_connection)) |
| 463 return CONTYPE_METH (meths, canonicalize_console_connection, | |
| 464 (name, errb)); | |
| 465 else | |
| 466 return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_console_connection, | |
| 467 (name, errb), name); | |
| 428 | 468 } |
| 469 | |
| 470 static Lisp_Object | |
| 471 find_console_of_type (struct console_methods *meths, Lisp_Object canon) | |
| 472 { | |
| 473 Lisp_Object concons; | |
| 474 | |
| 475 CONSOLE_LOOP (concons) | |
| 476 { | |
| 477 Lisp_Object console = XCAR (concons); | |
| 478 | |
| 479 if (EQ (CONMETH_TYPE (meths), CONSOLE_TYPE (XCONSOLE (console))) | |
| 480 && internal_equal (CONSOLE_CANON_CONNECTION (XCONSOLE (console)), | |
| 481 canon, 0)) | |
| 482 return console; | |
| 483 } | |
| 484 | |
| 485 return Qnil; | |
| 486 } | |
| 487 | |
| 488 DEFUN ("find-console", Ffind_console, 1, 2, 0, /* | |
| 489 Look for an existing console attached to connection CONNECTION. | |
| 490 Return the console if found; otherwise, return nil. | |
| 491 | |
| 492 If TYPE is specified, only return consoles of that type; otherwise, | |
| 493 return consoles of any type. (It is possible, although unlikely, | |
| 494 that two consoles of different types could have the same connection | |
| 495 name; in such a case, the first console found is returned.) | |
| 496 */ | |
| 497 (connection, type)) | |
| 498 { | |
| 499 Lisp_Object canon = Qnil; | |
| 500 struct gcpro gcpro1; | |
| 501 | |
| 502 GCPRO1 (canon); | |
| 503 | |
| 504 if (!NILP (type)) | |
| 505 { | |
| 506 struct console_methods *conmeths = decode_console_type (type, ERROR_ME); | |
| 507 canon = canonicalize_console_connection (conmeths, connection, | |
| 508 ERROR_ME_NOT); | |
| 509 if (UNBOUNDP (canon)) | |
| 510 RETURN_UNGCPRO (Qnil); | |
| 511 | |
| 512 RETURN_UNGCPRO (find_console_of_type (conmeths, canon)); | |
| 513 } | |
| 514 else | |
| 515 { | |
| 516 int i; | |
| 517 | |
| 518 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++) | |
| 519 { | |
| 520 struct console_methods *conmeths = | |
| 521 Dynarr_at (the_console_type_entry_dynarr, i).meths; | |
| 522 canon = canonicalize_console_connection (conmeths, connection, | |
| 523 ERROR_ME_NOT); | |
| 524 if (!UNBOUNDP (canon)) | |
| 525 { | |
| 526 Lisp_Object console = find_console_of_type (conmeths, canon); | |
| 527 if (!NILP (console)) | |
| 528 RETURN_UNGCPRO (console); | |
| 529 } | |
| 530 } | |
| 531 | |
| 532 RETURN_UNGCPRO (Qnil); | |
| 533 } | |
| 534 } | |
| 535 | |
| 536 DEFUN ("get-console", Fget_console, 1, 2, 0, /* | |
| 537 Look for an existing console attached to connection CONNECTION. | |
| 538 Return the console if found; otherwise, signal an error. | |
| 539 | |
| 540 If TYPE is specified, only return consoles of that type; otherwise, | |
| 541 return consoles of any type. (It is possible, although unlikely, | |
| 542 that two consoles of different types could have the same connection | |
| 543 name; in such a case, the first console found is returned.) | |
| 544 */ | |
| 545 (connection, type)) | |
| 546 { | |
| 547 Lisp_Object console = Ffind_console (connection, type); | |
| 548 if (NILP (console)) | |
| 549 { | |
| 550 if (NILP (type)) | |
| 563 | 551 invalid_argument ("No such console", connection); |
| 428 | 552 else |
| 563 | 553 invalid_argument_2 ("No such console", type, connection); |
| 428 | 554 } |
| 555 return console; | |
| 556 } | |
| 557 | |
| 558 Lisp_Object | |
| 559 create_console (Lisp_Object name, Lisp_Object type, Lisp_Object connection, | |
| 560 Lisp_Object props) | |
| 561 { | |
| 562 /* This function can GC */ | |
| 563 struct console *con; | |
| 564 Lisp_Object console; | |
| 565 struct gcpro gcpro1; | |
| 566 | |
| 567 console = Ffind_console (connection, type); | |
| 568 if (!NILP (console)) | |
| 569 return console; | |
| 570 | |
| 1204 | 571 con = allocate_console (type); |
| 793 | 572 console = wrap_console (con); |
| 428 | 573 |
| 574 GCPRO1 (console); | |
| 575 | |
| 576 CONSOLE_NAME (con) = name; | |
| 577 CONSOLE_CONNECTION (con) = | |
| 578 semi_canonicalize_console_connection (con->conmeths, connection, | |
| 579 ERROR_ME); | |
| 580 CONSOLE_CANON_CONNECTION (con) = | |
| 581 canonicalize_console_connection (con->conmeths, connection, | |
| 582 ERROR_ME); | |
| 583 | |
| 584 MAYBE_CONMETH (con, init_console, (con, props)); | |
| 585 | |
| 586 /* Do it this way so that the console list is in order of creation */ | |
| 587 Vconsole_list = nconc2 (Vconsole_list, Fcons (console, Qnil)); | |
| 853 | 588 note_object_created (console); |
| 428 | 589 |
| 440 | 590 if (CONMETH_OR_GIVEN (con, initially_selected_for_input, (con), 0)) |
| 428 | 591 event_stream_select_console (con); |
| 592 | |
| 593 UNGCPRO; | |
| 594 return console; | |
| 595 } | |
| 596 | |
| 597 void | |
| 598 add_entry_to_console_type_list (Lisp_Object symbol, | |
| 599 struct console_methods *meths) | |
| 600 { | |
| 601 struct console_type_entry entry; | |
| 602 | |
| 603 entry.symbol = symbol; | |
| 604 entry.meths = meths; | |
| 605 Dynarr_add (the_console_type_entry_dynarr, entry); | |
| 606 Vconsole_type_list = Fcons (symbol, Vconsole_type_list); | |
| 607 } | |
| 608 | |
| 609 /* find a console other than the selected one. Prefer non-stream | |
| 610 consoles over stream consoles. */ | |
| 611 | |
| 612 static Lisp_Object | |
| 613 find_other_console (Lisp_Object console) | |
| 614 { | |
| 615 Lisp_Object concons; | |
| 616 | |
| 617 /* look for a non-stream console */ | |
| 618 CONSOLE_LOOP (concons) | |
| 619 { | |
| 620 Lisp_Object con = XCAR (concons); | |
| 621 if (!CONSOLE_STREAM_P (XCONSOLE (con)) | |
| 622 && !EQ (con, console) | |
| 623 && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))) | |
| 624 && !NILP (DEVICE_SELECTED_FRAME | |
| 625 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))))) | |
| 626 break; | |
| 627 } | |
| 628 if (!NILP (concons)) | |
| 629 return XCAR (concons); | |
| 630 | |
| 631 /* OK, now look for a stream console */ | |
| 632 CONSOLE_LOOP (concons) | |
| 633 { | |
| 634 Lisp_Object con = XCAR (concons); | |
| 635 if (!EQ (con, console) | |
| 636 && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))) | |
| 637 && !NILP (DEVICE_SELECTED_FRAME | |
| 638 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))))) | |
| 639 break; | |
| 640 } | |
| 641 if (!NILP (concons)) | |
| 642 return XCAR (concons); | |
| 643 | |
| 644 /* Sorry, there ain't none */ | |
| 645 return Qnil; | |
| 646 } | |
| 647 | |
| 648 static int | |
| 649 find_nonminibuffer_frame_not_on_console_predicate (Lisp_Object frame, | |
| 650 void *closure) | |
| 651 { | |
| 652 Lisp_Object console; | |
| 653 | |
| 826 | 654 console = VOID_TO_LISP (closure); |
| 428 | 655 if (FRAME_MINIBUF_ONLY_P (XFRAME (frame))) |
| 656 return 0; | |
| 657 if (EQ (console, FRAME_CONSOLE (XFRAME (frame)))) | |
| 658 return 0; | |
| 659 return 1; | |
| 660 } | |
| 661 | |
| 662 static Lisp_Object | |
| 663 find_nonminibuffer_frame_not_on_console (Lisp_Object console) | |
| 664 { | |
| 665 return find_some_frame (find_nonminibuffer_frame_not_on_console_predicate, | |
| 666 LISP_TO_VOID (console)); | |
| 667 } | |
| 668 | |
| 617 | 669 static void |
| 670 nuke_all_console_slots (struct console *con, Lisp_Object zap) | |
| 671 { | |
| 3017 | 672 ZERO_LCRECORD (con); |
| 617 | 673 |
| 1204 | 674 #define MARKED_SLOT(x) con->x = zap; |
| 617 | 675 #include "conslots.h" |
| 676 } | |
| 677 | |
| 428 | 678 /* Delete console CON. |
| 679 | |
| 680 If FORCE is non-zero, allow deletion of the only frame. | |
| 681 | |
| 682 If CALLED_FROM_KILL_EMACS is non-zero, then, if | |
| 683 deleting the last console, just delete it, | |
| 684 instead of calling `save-buffers-kill-emacs'. | |
| 685 | |
| 686 If FROM_IO_ERROR is non-zero, then the console is gone due | |
| 687 to an I/O error. This affects what happens if we exit | |
| 688 (we do an emergency exit instead of `save-buffers-kill-emacs'.) | |
| 689 */ | |
| 690 | |
| 691 void | |
| 692 delete_console_internal (struct console *con, int force, | |
| 693 int called_from_kill_emacs, int from_io_error) | |
| 694 { | |
| 695 /* This function can GC */ | |
| 696 Lisp_Object console; | |
| 697 struct gcpro gcpro1; | |
| 698 | |
| 699 /* OK to delete an already-deleted console. */ | |
| 700 if (!CONSOLE_LIVE_P (con)) | |
| 701 return; | |
| 702 | |
| 793 | 703 console = wrap_console (con); |
| 853 | 704 |
| 705 if (!force) | |
| 706 check_allowed_operation (OPERATION_DELETE_OBJECT, console, Qnil); | |
| 707 | |
| 428 | 708 GCPRO1 (console); |
| 709 | |
| 710 if (!called_from_kill_emacs) | |
| 711 { | |
| 712 int down_we_go = 0; | |
| 713 | |
| 714 if ((XINT (Flength (Vconsole_list)) == 1) | |
| 715 /* if we just created the console, it might not be listed, | |
| 716 or something ... */ | |
| 717 && !NILP (memq_no_quit (console, Vconsole_list))) | |
| 718 down_we_go = 1; | |
| 719 /* If there aren't any nonminibuffer frames that would | |
| 720 be left, then exit. */ | |
| 721 else if (NILP (find_nonminibuffer_frame_not_on_console (console))) | |
| 722 down_we_go = 1; | |
| 723 | |
| 724 if (down_we_go) | |
| 725 { | |
| 726 if (!force) | |
| 563 | 727 invalid_operation ("Attempt to delete the only frame", Qunbound); |
| 428 | 728 else if (from_io_error) |
| 729 { | |
| 730 /* Mayday mayday! We're going down! */ | |
| 731 stderr_out (" Autosaving and exiting...\n"); | |
| 732 Vwindow_system = Qnil; /* let it lie! */ | |
| 733 preparing_for_armageddon = 1; | |
| 734 Fkill_emacs (make_int (70)); | |
| 735 } | |
| 736 else | |
| 737 { | |
| 738 call0 (Qsave_buffers_kill_emacs); | |
| 739 UNGCPRO; | |
| 740 /* If we get here, the user said they didn't want | |
| 741 to exit, so don't. */ | |
| 742 return; | |
| 743 } | |
| 744 } | |
| 745 } | |
| 746 | |
| 747 /* Breathe a sigh of relief. We're still alive. */ | |
| 748 | |
| 749 { | |
| 750 Lisp_Object frmcons, devcons; | |
| 751 | |
| 752 /* First delete all frames without their own minibuffers, | |
| 753 to avoid errors coming from attempting to delete a frame | |
| 754 that is a surrogate for another frame. | |
| 755 | |
| 756 We don't set "called_from_delete_console" because we want the | |
| 757 device to go ahead and get deleted if we delete the last frame | |
| 758 on a device. We won't run into trouble here because for any | |
| 759 frame without a minibuffer, there has to be another one on | |
| 760 the same console with a minibuffer, and we're not deleting that, | |
| 761 so delete_console_internal() won't get recursively called. | |
| 762 | |
| 763 WRONG! With surrogate minibuffers this isn't true. Frames | |
| 764 with only a minibuffer are not enough to prevent | |
| 765 delete_frame_internal from triggering a device deletion. */ | |
| 766 CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, con) | |
| 767 { | |
| 768 struct frame *f = XFRAME (XCAR (frmcons)); | |
| 769 /* delete_frame_internal() might do anything such as run hooks, | |
| 770 so be defensive. */ | |
| 771 if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f)) | |
| 772 delete_frame_internal (f, 1, 1, from_io_error); | |
| 773 | |
| 774 if (!CONSOLE_LIVE_P (con)) /* make sure the delete-*-hook didn't | |
| 775 go ahead and delete anything */ | |
| 776 { | |
| 777 UNGCPRO; | |
| 778 return; | |
| 779 } | |
| 780 } | |
| 781 | |
| 782 CONSOLE_DEVICE_LOOP (devcons, con) | |
| 783 { | |
| 784 struct device *d = XDEVICE (XCAR (devcons)); | |
| 785 /* delete_device_internal() might do anything such as run hooks, | |
| 786 so be defensive. */ | |
| 787 if (DEVICE_LIVE_P (d)) | |
| 788 delete_device_internal (d, 1, 1, from_io_error); | |
| 789 if (!CONSOLE_LIVE_P (con)) /* make sure the delete-*-hook didn't | |
| 790 go ahead and delete anything */ | |
| 791 { | |
| 792 UNGCPRO; | |
| 793 return; | |
| 794 } | |
| 795 } | |
| 796 } | |
| 797 | |
| 798 CONSOLE_SELECTED_DEVICE (con) = Qnil; | |
| 799 | |
| 800 /* try to select another console */ | |
| 801 | |
| 802 if (EQ (console, Fselected_console ())) | |
| 803 { | |
| 804 Lisp_Object other_dev = find_other_console (console); | |
| 805 if (!NILP (other_dev)) | |
| 806 Fselect_console (other_dev); | |
| 807 else | |
| 808 { | |
| 809 /* necessary? */ | |
| 810 Vselected_console = Qnil; | |
| 811 Vwindow_system = Qnil; | |
| 812 } | |
| 813 } | |
| 814 | |
| 815 if (con->input_enabled) | |
| 816 event_stream_unselect_console (con); | |
| 817 | |
| 818 MAYBE_CONMETH (con, delete_console, (con)); | |
| 819 | |
| 820 Vconsole_list = delq_no_quit (console, Vconsole_list); | |
| 617 | 821 |
| 428 | 822 RESET_CHANGED_SET_FLAGS; |
| 617 | 823 |
| 824 /* Nobody should be accessing anything in this object any more, and | |
| 825 making all Lisp_Objects Qnil allows for better GC'ing in case a | |
| 826 pointer to the dead console continues to hang around. Zero all | |
| 827 other structs in case someone tries to access something through | |
| 828 them. */ | |
| 829 nuke_all_console_slots (con, Qnil); | |
| 428 | 830 con->conmeths = dead_console_methods; |
| 1204 | 831 con->contype = dead_console; |
| 853 | 832 note_object_deleted (console); |
| 428 | 833 |
| 834 UNGCPRO; | |
| 835 } | |
| 836 | |
| 837 void | |
| 838 io_error_delete_console (Lisp_Object console) | |
| 839 { | |
| 840 delete_console_internal (XCONSOLE (console), 1, 0, 1); | |
| 841 } | |
| 842 | |
| 843 DEFUN ("delete-console", Fdelete_console, 1, 2, 0, /* | |
| 844 Delete CONSOLE, permanently eliminating it from use. | |
| 845 Normally, you cannot delete the last non-minibuffer-only frame (you must | |
| 846 use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional | |
| 847 second argument FORCE is non-nil, you can delete the last frame. (This | |
| 848 will automatically call `save-buffers-kill-emacs'.) | |
| 849 */ | |
| 850 (console, force)) | |
| 851 { | |
| 852 CHECK_CONSOLE (console); | |
| 853 delete_console_internal (XCONSOLE (console), !NILP (force), 0, 0); | |
| 854 return Qnil; | |
| 855 } | |
| 856 | |
| 857 DEFUN ("console-list", Fconsole_list, 0, 0, 0, /* | |
| 858 Return a list of all consoles. | |
| 859 */ | |
| 860 ()) | |
| 861 { | |
| 862 return Fcopy_sequence (Vconsole_list); | |
| 863 } | |
| 864 | |
| 865 DEFUN ("console-device-list", Fconsole_device_list, 0, 1, 0, /* | |
| 866 Return a list of all devices on CONSOLE. | |
| 444 | 867 If CONSOLE is nil, the selected console is used. |
| 428 | 868 */ |
| 869 (console)) | |
| 870 { | |
| 871 return Fcopy_sequence (CONSOLE_DEVICE_LIST (decode_console (console))); | |
| 872 } | |
| 873 | |
| 874 DEFUN ("console-enable-input", Fconsole_enable_input, 1, 1, 0, /* | |
| 875 Enable input on console CONSOLE. | |
| 876 */ | |
| 877 (console)) | |
| 878 { | |
| 879 struct console *con = decode_console (console); | |
| 880 if (!con->input_enabled) | |
| 881 event_stream_select_console (con); | |
| 882 return Qnil; | |
| 883 } | |
| 884 | |
| 885 DEFUN ("console-disable-input", Fconsole_disable_input, 1, 1, 0, /* | |
| 886 Disable input on console CONSOLE. | |
| 887 */ | |
| 888 (console)) | |
| 889 { | |
| 890 struct console *con = decode_console (console); | |
| 891 if (con->input_enabled) | |
| 892 event_stream_unselect_console (con); | |
| 893 return Qnil; | |
| 894 } | |
| 895 | |
| 896 DEFUN ("console-on-window-system-p", Fconsole_on_window_system_p, 0, 1, 0, /* | |
| 444 | 897 Return t if CONSOLE is on a window system. |
| 898 If CONSOLE is nil, the selected console is used. | |
| 428 | 899 This generally means that there is support for the mouse, the menubar, |
| 900 the toolbar, glyphs, etc. | |
| 901 */ | |
| 902 (console)) | |
| 903 { | |
| 904 Lisp_Object type = CONSOLE_TYPE (decode_console (console)); | |
| 905 | |
| 906 return !EQ (type, Qtty) && !EQ (type, Qstream) ? Qt : Qnil; | |
| 907 } | |
| 908 | |
| 909 | |
| 910 | |
| 911 /**********************************************************************/ | |
| 912 /* Miscellaneous low-level functions */ | |
| 913 /**********************************************************************/ | |
| 914 | |
| 915 static Lisp_Object | |
| 916 unwind_init_sys_modes (Lisp_Object console) | |
| 917 { | |
| 918 reinit_initial_console (); | |
| 919 | |
| 920 if (!no_redraw_on_reenter && | |
| 921 CONSOLEP (console) && | |
| 922 CONSOLE_LIVE_P (XCONSOLE (console))) | |
| 923 { | |
| 924 struct frame *f = | |
| 925 XFRAME (DEVICE_SELECTED_FRAME | |
| 926 (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (console))))); | |
| 927 MARK_FRAME_CHANGED (f); | |
| 928 } | |
| 929 return Qnil; | |
| 930 } | |
| 931 | |
| 932 DEFUN ("suspend-emacs", Fsuspend_emacs, 0, 1, "", /* | |
| 933 Stop Emacs and return to superior process. You can resume later. | |
| 934 On systems that don't have job control, run a subshell instead. | |
| 935 | |
| 936 If optional arg STUFFSTRING is non-nil, its characters are stuffed | |
| 937 to be read as terminal input by Emacs's superior shell. | |
| 938 | |
| 939 Before suspending, run the normal hook `suspend-hook'. | |
| 940 After resumption run the normal hook `suspend-resume-hook'. | |
| 941 | |
| 942 Some operating systems cannot stop the Emacs process and resume it later. | |
| 943 On such systems, Emacs will start a subshell and wait for it to exit. | |
| 944 */ | |
| 945 (stuffstring)) | |
| 946 { | |
| 947 int speccount = specpdl_depth (); | |
| 948 struct gcpro gcpro1; | |
| 949 | |
| 950 if (!NILP (stuffstring)) | |
| 951 CHECK_STRING (stuffstring); | |
| 952 GCPRO1 (stuffstring); | |
| 953 | |
| 954 /* There used to be a check that the initial console is TTY. | |
| 955 This is bogus. Even checking to see whether any console | |
| 956 is a controlling terminal is not correct -- maybe | |
| 957 the user used the -t option or something. If we want to | |
| 958 suspend, then we suspend. Period. */ | |
| 959 | |
| 960 /* Call value of suspend-hook. */ | |
| 961 run_hook (Qsuspend_hook); | |
| 962 | |
| 963 reset_initial_console (); | |
| 964 /* sys_suspend can get an error if it tries to fork a subshell | |
| 965 and the system resources aren't available for that. */ | |
| 966 record_unwind_protect (unwind_init_sys_modes, Vcontrolling_terminal); | |
| 967 stuff_buffered_input (stuffstring); | |
| 968 sys_suspend (); | |
| 969 /* the console is un-reset inside of the unwind-protect. */ | |
| 771 | 970 unbind_to (speccount); |
| 428 | 971 |
| 972 #ifdef SIGWINCH | |
| 973 /* It is possible that a size change occurred while we were | |
| 974 suspended. Assume one did just to be safe. It won't hurt | |
| 975 anything if one didn't. */ | |
| 976 asynch_device_change_pending++; | |
| 977 #endif | |
| 978 | |
| 979 /* Call value of suspend-resume-hook | |
| 980 if it is bound and value is non-nil. */ | |
| 981 run_hook (Qsuspend_resume_hook); | |
| 982 | |
| 983 UNGCPRO; | |
| 984 return Qnil; | |
| 985 } | |
| 986 | |
| 987 /* If STUFFSTRING is a string, stuff its contents as pending terminal input. | |
| 988 Then in any case stuff anything Emacs has read ahead and not used. */ | |
| 989 | |
| 990 void | |
| 2286 | 991 stuff_buffered_input ( |
| 3146 | 992 #if defined(BSD) && defined(HAVE_TTY) |
| 2286 | 993 Lisp_Object stuffstring |
| 994 #else | |
| 995 Lisp_Object UNUSED (stuffstring) | |
| 996 #endif | |
| 997 ) | |
| 428 | 998 { |
| 999 /* stuff_char works only in BSD, versions 4.2 and up. */ | |
| 3146 | 1000 #if defined(BSD) && defined(HAVE_TTY) |
| 428 | 1001 if (!CONSOLEP (Vcontrolling_terminal) || |
| 1002 !CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal))) | |
| 1003 return; | |
| 1004 | |
| 1005 if (STRINGP (stuffstring)) | |
| 1006 { | |
| 665 | 1007 Bytecount count; |
| 428 | 1008 Extbyte *p; |
| 1009 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1010 LISP_STRING_TO_SIZED_EXTERNAL (stuffstring, p, count, Qkeyboard); |
| 428 | 1011 while (count-- > 0) |
| 1012 stuff_char (XCONSOLE (Vcontrolling_terminal), *p++); | |
| 1013 stuff_char (XCONSOLE (Vcontrolling_terminal), '\n'); | |
| 1014 } | |
| 1015 /* Anything we have read ahead, put back for the shell to read. */ | |
| 1016 # if 0 /* oh, who cares about this silliness */ | |
| 1017 while (kbd_fetch_ptr != kbd_store_ptr) | |
| 1018 { | |
| 1019 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE) | |
| 1020 kbd_fetch_ptr = kbd_buffer; | |
| 1021 stuff_char (XCONSOLE (Vcontrolling_terminal), *kbd_fetch_ptr++); | |
| 1022 } | |
| 1023 # endif | |
| 3146 | 1024 #endif /* BSD && HAVE_TTY */ |
| 428 | 1025 } |
| 1026 | |
| 1027 DEFUN ("suspend-console", Fsuspend_console, 0, 1, "", /* | |
| 1028 Suspend a console. For tty consoles, it sends a signal to suspend | |
| 1029 the process in charge of the tty, and removes the devices and | |
| 1030 frames of that console from the display. | |
| 1031 | |
| 1032 If optional arg CONSOLE is non-nil, it is the console to be suspended. | |
| 1033 Otherwise it is assumed to be the selected console. | |
| 1034 | |
| 1035 Some operating systems cannot stop processes and resume them later. | |
| 1036 On such systems, who knows what will happen. | |
| 1037 */ | |
| 2340 | 1038 (USED_IF_TTY (console))) |
| 428 | 1039 { |
| 1040 #ifdef HAVE_TTY | |
| 1041 struct console *con = decode_console (console); | |
| 1042 | |
| 1043 if (CONSOLE_TTY_P (con)) | |
| 1044 { | |
| 1045 /* | |
| 1046 * hide all the unhidden frames so the display code won't update | |
| 1047 * them while the console is suspended. | |
| 1048 */ | |
| 1049 Lisp_Object device = CONSOLE_SELECTED_DEVICE (con); | |
| 1050 if (!NILP (device)) | |
| 1051 { | |
| 1052 struct device *d = XDEVICE (device); | |
| 1053 Lisp_Object frame_list = DEVICE_FRAME_LIST (d); | |
| 1054 while (CONSP (frame_list)) | |
| 1055 { | |
| 1056 struct frame *f = XFRAME (XCAR (frame_list)); | |
| 1057 if (FRAME_REPAINT_P (f)) | |
| 1058 f->visible = -1; | |
| 1059 frame_list = XCDR (frame_list); | |
| 1060 } | |
| 1061 } | |
| 1062 reset_one_console (con); | |
| 1063 event_stream_unselect_console (con); | |
| 1064 sys_suspend_process (XINT (Fconsole_tty_controlling_process (console))); | |
| 1065 } | |
| 1066 #endif /* HAVE_TTY */ | |
| 1067 | |
| 1068 return Qnil; | |
| 1069 } | |
| 1070 | |
| 1071 DEFUN ("resume-console", Fresume_console, 1, 1, "", /* | |
| 1072 Re-initialize a previously suspended console. | |
| 1073 For tty consoles, do stuff to the tty to make it sane again. | |
| 1074 */ | |
| 2340 | 1075 (USED_IF_TTY (console))) |
| 428 | 1076 { |
| 1077 #ifdef HAVE_TTY | |
| 1078 struct console *con = decode_console (console); | |
| 1079 | |
| 1080 if (CONSOLE_TTY_P (con)) | |
| 1081 { | |
| 1082 /* raise the selected frame */ | |
| 1083 Lisp_Object device = CONSOLE_SELECTED_DEVICE (con); | |
| 1084 if (!NILP (device)) | |
| 1085 { | |
| 1086 struct device *d = XDEVICE (device); | |
| 1087 Lisp_Object frame = DEVICE_SELECTED_FRAME (d); | |
| 1088 if (!NILP (frame)) | |
| 1089 { | |
| 1090 /* force the frame to be cleared */ | |
| 1091 SET_FRAME_CLEAR (XFRAME (frame)); | |
| 1092 Fraise_frame (frame); | |
| 1093 } | |
| 1094 } | |
| 1095 init_one_console (con); | |
| 1096 event_stream_select_console (con); | |
| 1097 #ifdef SIGWINCH | |
| 1098 /* The same as in Fsuspend_emacs: it is possible that a size | |
| 1099 change occurred while we were suspended. Assume one did just | |
| 1100 to be safe. It won't hurt anything if one didn't. */ | |
| 1101 asynch_device_change_pending++; | |
| 1102 #endif | |
| 1103 } | |
| 1104 #endif /* HAVE_TTY */ | |
| 1105 | |
| 1106 return Qnil; | |
| 1107 } | |
| 1108 | |
| 1109 DEFUN ("set-input-mode", Fset_input_mode, 3, 5, 0, /* | |
| 1110 Set mode of reading keyboard input. | |
| 1204 | 1111 First arg (formerly INTERRUPT-INPUT) is ignored, for backward compatibility. |
| 428 | 1112 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal |
| 1113 (no effect except in CBREAK mode). | |
| 1114 Third arg META t means accept 8-bit input (for a Meta key). | |
| 1115 META nil means ignore the top bit, on the assumption it is parity. | |
| 1116 Otherwise, accept 8-bit input and don't use the top bit for Meta. | |
| 1117 First three arguments only apply to TTY consoles. | |
| 1118 Optional fourth arg QUIT if non-nil specifies character to use for quitting. | |
| 1119 Optional fifth arg CONSOLE specifies console to make changes to; nil means | |
| 1120 the selected console. | |
| 1121 See also `current-input-mode'. | |
| 1122 */ | |
| 2340 | 1123 (UNUSED (ignored), USED_IF_TTY (flow), meta, quit, console)) |
| 428 | 1124 { |
| 1125 struct console *con = decode_console (console); | |
| 1126 int meta_key = (!CONSOLE_TTY_P (con) ? 1 : | |
| 1127 EQ (meta, Qnil) ? 0 : | |
| 1128 EQ (meta, Qt) ? 1 : | |
| 1129 2); | |
| 1130 | |
| 1131 if (!NILP (quit)) | |
| 1132 { | |
| 1204 | 1133 if (CHAR_OR_CHAR_INTP (quit) && !meta_key) |
| 1134 set_quit_events (con, make_char (XCHAR_OR_CHAR_INT (quit) & 0177)); | |
| 1135 else | |
| 1136 set_quit_events (con, quit); | |
| 428 | 1137 } |
| 1138 | |
| 1139 #ifdef HAVE_TTY | |
| 1140 if (CONSOLE_TTY_P (con)) | |
| 1141 { | |
| 1142 reset_one_console (con); | |
| 1143 TTY_FLAGS (con).flow_control = !NILP (flow); | |
| 1144 TTY_FLAGS (con).meta_key = meta_key; | |
| 1145 init_one_console (con); | |
| 444 | 1146 MARK_FRAME_CHANGED (XFRAME (CONSOLE_SELECTED_FRAME (con))); |
| 428 | 1147 } |
| 1148 #endif | |
| 1149 | |
| 1150 return Qnil; | |
| 1151 } | |
| 1152 | |
| 1153 DEFUN ("current-input-mode", Fcurrent_input_mode, 0, 1, 0, /* | |
| 1154 Return information about the way Emacs currently reads keyboard input. | |
| 1155 Optional arg CONSOLE specifies console to return information about; nil means | |
| 1156 the selected console. | |
| 1157 The value is a list of the form (nil FLOW META QUIT), where | |
| 1158 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the | |
| 1159 terminal; this does not apply if Emacs uses interrupt-driven input. | |
| 1160 META is t if accepting 8-bit input with 8th bit as Meta flag. | |
| 1161 META nil means ignoring the top bit, on the assumption it is parity. | |
| 1162 META is neither t nor nil if accepting 8-bit input and using | |
| 1163 all 8 bits as the character code. | |
| 1164 QUIT is the character Emacs currently uses to quit. | |
| 1165 FLOW, and META are only meaningful for TTY consoles. | |
| 1166 The elements of this list correspond to the arguments of | |
| 1167 `set-input-mode'. | |
| 1168 */ | |
| 1169 (console)) | |
| 1170 { | |
| 1171 struct console *con = decode_console (console); | |
| 1204 | 1172 Lisp_Object flow, meta; |
| 428 | 1173 |
| 1174 #ifdef HAVE_TTY | |
| 1175 flow = CONSOLE_TTY_P (con) && TTY_FLAGS (con).flow_control ? Qt : Qnil; | |
| 1176 meta = (!CONSOLE_TTY_P (con) ? Qt : | |
| 1177 TTY_FLAGS (con).meta_key == 1 ? Qt : | |
| 1178 TTY_FLAGS (con).meta_key == 2 ? Qzero : | |
| 1179 Qnil); | |
| 1180 #else | |
| 1181 flow = Qnil; | |
| 1182 meta = Qt; | |
| 1183 #endif | |
| 1184 | |
| 1204 | 1185 return list4 (Qnil, flow, meta, CONSOLE_QUIT_CHAR (con)); |
| 428 | 1186 } |
| 1187 | |
| 1188 | |
| 1189 /************************************************************************/ | |
| 1190 /* initialization */ | |
| 1191 /************************************************************************/ | |
| 1192 | |
| 1193 void | |
| 1194 syms_of_console (void) | |
| 1195 { | |
| 442 | 1196 INIT_LRECORD_IMPLEMENTATION (console); |
| 3092 | 1197 #ifdef NEW_GC |
| 1198 #ifdef HAVE_TTY | |
| 1199 INIT_LRECORD_IMPLEMENTATION (tty_console); | |
| 1200 #endif | |
| 1201 INIT_LRECORD_IMPLEMENTATION (stream_console); | |
| 3263 | 1202 #endif /* NEW_GC */ |
| 442 | 1203 |
| 428 | 1204 DEFSUBR (Fvalid_console_type_p); |
| 1205 DEFSUBR (Fconsole_type_list); | |
| 1206 DEFSUBR (Fcdfw_console); | |
| 1207 DEFSUBR (Fselected_console); | |
| 1208 DEFSUBR (Fselect_console); | |
| 1209 DEFSUBR (Fconsolep); | |
| 1210 DEFSUBR (Fconsole_live_p); | |
| 1211 DEFSUBR (Fconsole_type); | |
| 1212 DEFSUBR (Fconsole_name); | |
| 1213 DEFSUBR (Fconsole_connection); | |
| 1214 DEFSUBR (Ffind_console); | |
| 1215 DEFSUBR (Fget_console); | |
| 1216 DEFSUBR (Fdelete_console); | |
| 1217 DEFSUBR (Fconsole_list); | |
| 1218 DEFSUBR (Fconsole_device_list); | |
| 1219 DEFSUBR (Fconsole_enable_input); | |
| 1220 DEFSUBR (Fconsole_disable_input); | |
| 1221 DEFSUBR (Fconsole_on_window_system_p); | |
| 1222 DEFSUBR (Fsuspend_console); | |
| 1223 DEFSUBR (Fresume_console); | |
| 1224 | |
| 1225 DEFSUBR (Fsuspend_emacs); | |
| 1226 DEFSUBR (Fset_input_mode); | |
| 1227 DEFSUBR (Fcurrent_input_mode); | |
| 1228 | |
| 563 | 1229 DEFSYMBOL (Qconsolep); |
| 1230 DEFSYMBOL (Qconsole_live_p); | |
| 428 | 1231 |
| 563 | 1232 DEFSYMBOL (Qcreate_console_hook); |
| 1233 DEFSYMBOL (Qdelete_console_hook); | |
| 428 | 1234 |
| 563 | 1235 DEFSYMBOL (Qsuspend_hook); |
| 1236 DEFSYMBOL (Qsuspend_resume_hook); | |
| 428 | 1237 } |
| 1238 | |
| 1204 | 1239 static const struct memory_description cte_description_1[] = { |
| 440 | 1240 { XD_LISP_OBJECT, offsetof (console_type_entry, symbol) }, |
| 2551 | 1241 { XD_BLOCK_PTR, offsetof (console_type_entry, meths), 1, |
| 1242 { &console_methods_description } }, | |
| 428 | 1243 { XD_END } |
| 1244 }; | |
| 1245 | |
| 1204 | 1246 static const struct sized_memory_description cte_description = { |
| 440 | 1247 sizeof (console_type_entry), |
| 428 | 1248 cte_description_1 |
| 1249 }; | |
| 1250 | |
| 1204 | 1251 static const struct memory_description cted_description_1[] = { |
| 440 | 1252 XD_DYNARR_DESC (console_type_entry_dynarr, &cte_description), |
| 428 | 1253 { XD_END } |
| 1254 }; | |
| 1255 | |
| 1204 | 1256 const struct sized_memory_description cted_description = { |
| 440 | 1257 sizeof (console_type_entry_dynarr), |
| 428 | 1258 cted_description_1 |
| 1259 }; | |
| 1260 | |
| 1204 | 1261 static const struct memory_description console_methods_description_1[] = { |
| 440 | 1262 { XD_LISP_OBJECT, offsetof (struct console_methods, symbol) }, |
| 1263 { XD_LISP_OBJECT, offsetof (struct console_methods, predicate_symbol) }, | |
| 1264 { XD_LISP_OBJECT, offsetof (struct console_methods, image_conversion_list) }, | |
| 428 | 1265 { XD_END } |
| 1266 }; | |
| 1267 | |
| 1204 | 1268 const struct sized_memory_description console_methods_description = { |
| 440 | 1269 sizeof (struct console_methods), |
| 428 | 1270 console_methods_description_1 |
| 1271 }; | |
| 1272 | |
| 1273 | |
| 1274 void | |
| 1275 console_type_create (void) | |
| 1276 { | |
| 1277 the_console_type_entry_dynarr = Dynarr_new (console_type_entry); | |
| 2367 | 1278 dump_add_root_block_ptr (&the_console_type_entry_dynarr, &cted_description); |
| 428 | 1279 |
| 1280 Vconsole_type_list = Qnil; | |
| 1281 staticpro (&Vconsole_type_list); | |
| 1282 | |
| 1283 /* Initialize the dead console type */ | |
| 1284 INITIALIZE_CONSOLE_TYPE (dead, "dead", "console-dead-p"); | |
| 1285 | |
| 1286 /* then reset the console-type lists, because `dead' is not really | |
| 1287 a valid console type */ | |
| 1288 Dynarr_reset (the_console_type_entry_dynarr); | |
| 1289 Vconsole_type_list = Qnil; | |
| 1290 } | |
| 1291 | |
| 1292 void | |
| 1293 reinit_vars_of_console (void) | |
| 1294 { | |
| 1295 staticpro_nodump (&Vconsole_list); | |
| 1296 Vconsole_list = Qnil; | |
| 1297 staticpro_nodump (&Vselected_console); | |
| 1298 Vselected_console = Qnil; | |
| 1299 } | |
| 1300 | |
| 1301 void | |
| 1302 vars_of_console (void) | |
| 1303 { | |
| 1304 DEFVAR_LISP ("create-console-hook", &Vcreate_console_hook /* | |
| 1305 Function or functions to call when a console is created. | |
| 1306 One argument, the newly-created console. | |
| 1307 This is called after the first frame has been created, but before | |
| 1308 calling the `create-device-hook' or `create-frame-hook'. | |
| 1309 Note that in general the console will not be selected. | |
| 1310 */ ); | |
| 1311 Vcreate_console_hook = Qnil; | |
| 1312 | |
| 1313 DEFVAR_LISP ("delete-console-hook", &Vdelete_console_hook /* | |
| 1314 Function or functions to call when a console is deleted. | |
| 1315 One argument, the to-be-deleted console. | |
| 1316 */ ); | |
| 1317 Vdelete_console_hook = Qnil; | |
| 1318 | |
| 1319 #ifdef HAVE_WINDOW_SYSTEM | |
| 1320 Fprovide (intern ("window-system")); | |
| 1321 #endif | |
| 1322 } | |
| 1323 | |
| 643 | 1324 /* The docstrings for DEFVAR_* are recorded externally by make-docfile. */ |
| 3263 | 1325 #ifdef NEW_GC |
| 2720 | 1326 #define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magic_fun) \ |
| 1327 do { \ | |
| 1328 struct symbol_value_forward *I_hate_C = \ | |
| 1329 alloc_lrecord_type (struct symbol_value_forward, \ | |
| 1330 &lrecord_symbol_value_forward); \ | |
| 1331 /*mcpro ((Lisp_Object) I_hate_C);*/ \ | |
| 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 */ | |
| 3017 | 1407 struct console *defs = ALLOC_LCRECORD_TYPE (struct console, &lrecord_console); |
| 1408 struct console *syms = ALLOC_LCRECORD_TYPE (struct console, &lrecord_console); | |
| 428 | 1409 |
| 1410 staticpro_nodump (&Vconsole_defaults); | |
| 1411 staticpro_nodump (&Vconsole_local_symbols); | |
| 793 | 1412 Vconsole_defaults = wrap_console (defs); |
| 1413 Vconsole_local_symbols = wrap_console (syms); | |
| 428 | 1414 |
| 1415 nuke_all_console_slots (syms, Qnil); | |
| 1416 nuke_all_console_slots (defs, Qnil); | |
| 1417 | |
| 1418 /* Set up the non-nil default values of various console slots. | |
| 1419 Must do these before making the first console. | |
| 1420 */ | |
| 1204 | 1421 |
| 1422 /* ... Nothing here for the moment. | |
| 1423 #### Console-local variables should probably be eliminated.*/ | |
| 428 | 1424 |
| 1425 { | |
| 1426 /* 0 means var is always local. Default used only at creation. | |
| 1427 * -1 means var is always local. Default used only at reset and | |
| 1428 * creation. | |
| 1429 * -2 means there's no lisp variable corresponding to this slot | |
| 1430 * and the default is only used at creation. | |
| 1431 * -3 means no Lisp variable. Default used only at reset and creation. | |
| 1432 * >0 is mask. Var is local if ((console->local_var_flags & mask) != 0) | |
| 1433 * Otherwise default is used. | |
| 1434 * | |
| 1435 * #### We don't currently ever reset console variables, so there | |
| 1436 * is no current distinction between 0 and -1, and between -2 and -3. | |
| 1437 */ | |
| 1438 Lisp_Object always_local_resettable = make_int (-1); | |
| 1439 | |
| 1440 #if 0 /* not used */ | |
| 1441 Lisp_Object always_local_no_default = make_int (0); | |
| 1442 Lisp_Object resettable = make_int (-3); | |
| 1443 #endif | |
| 1444 | |
| 1445 /* Assign the local-flags to the slots that have default values. | |
| 1446 The local flag is a bit that is used in the console | |
| 1447 to say that it has its own local value for the slot. | |
| 1448 The local flag bits are in the local_var_flags slot of the | |
| 1449 console. */ | |
| 1450 | |
| 1451 nuke_all_console_slots (&console_local_flags, make_int (-2)); | |
| 1452 console_local_flags.defining_kbd_macro = always_local_resettable; | |
| 1453 console_local_flags.last_kbd_macro = always_local_resettable; | |
| 1454 console_local_flags.prefix_arg = always_local_resettable; | |
| 1455 console_local_flags.default_minibuffer_frame = always_local_resettable; | |
| 1456 console_local_flags.overriding_terminal_local_map = | |
| 1457 always_local_resettable; | |
| 1458 #ifdef HAVE_TTY | |
| 1459 console_local_flags.tty_erase_char = always_local_resettable; | |
| 1460 #endif | |
| 1461 | |
| 1462 console_local_flags.function_key_map = make_int (1); | |
| 1463 | |
| 1464 /* #### Warning, 0x4000000 (that's six zeroes) is the largest number | |
| 1465 currently allowable due to the XINT() handling of this value. | |
| 1466 With some rearrangement you can get 4 more bits. */ | |
| 1467 } | |
| 1468 } | |
| 1469 | |
| 1470 | |
| 1471 #define CONSOLE_SLOTS_SIZE (offsetof (struct console, CONSOLE_SLOTS_LAST_NAME) - offsetof (struct console, CONSOLE_SLOTS_FIRST_NAME) + sizeof (Lisp_Object)) | |
| 1472 #define CONSOLE_SLOTS_COUNT (CONSOLE_SLOTS_SIZE / sizeof (Lisp_Object)) | |
| 1473 | |
| 1474 void | |
| 771 | 1475 reinit_complex_vars_of_console_runtime_only (void) |
| 428 | 1476 { |
| 1477 struct console *defs, *syms; | |
| 1478 | |
| 1479 common_init_complex_vars_of_console (); | |
| 1480 | |
| 1481 defs = XCONSOLE (Vconsole_defaults); | |
| 1482 syms = XCONSOLE (Vconsole_local_symbols); | |
| 1483 memcpy (&defs->CONSOLE_SLOTS_FIRST_NAME, | |
| 1484 console_defaults_saved_slots, | |
| 1485 CONSOLE_SLOTS_SIZE); | |
| 1486 memcpy (&syms->CONSOLE_SLOTS_FIRST_NAME, | |
| 1487 console_local_symbols_saved_slots, | |
| 1488 CONSOLE_SLOTS_SIZE); | |
| 1489 } | |
| 1490 | |
| 1491 | |
| 1204 | 1492 static const struct memory_description console_slots_description_1[] = { |
| 440 | 1493 { XD_LISP_OBJECT_ARRAY, 0, CONSOLE_SLOTS_COUNT }, |
| 428 | 1494 { XD_END } |
| 1495 }; | |
| 1496 | |
| 1204 | 1497 static const struct sized_memory_description console_slots_description = { |
| 428 | 1498 CONSOLE_SLOTS_SIZE, |
| 1499 console_slots_description_1 | |
| 1500 }; | |
| 1501 | |
| 1502 void | |
| 1503 complex_vars_of_console (void) | |
| 1504 { | |
| 1505 struct console *defs, *syms; | |
| 1506 | |
| 1507 common_init_complex_vars_of_console (); | |
| 1508 | |
| 1509 defs = XCONSOLE (Vconsole_defaults); | |
| 1510 syms = XCONSOLE (Vconsole_local_symbols); | |
| 1511 console_defaults_saved_slots = &defs->CONSOLE_SLOTS_FIRST_NAME; | |
| 1512 console_local_symbols_saved_slots = &syms->CONSOLE_SLOTS_FIRST_NAME; | |
| 2367 | 1513 dump_add_root_block_ptr (&console_defaults_saved_slots, &console_slots_description); |
| 1514 dump_add_root_block_ptr (&console_local_symbols_saved_slots, &console_slots_description); | |
| 428 | 1515 |
| 1516 DEFVAR_CONSOLE_DEFAULTS ("default-function-key-map", function_key_map /* | |
| 1517 Default value of `function-key-map' for consoles that don't override it. | |
| 1518 This is the same as (default-value 'function-key-map). | |
| 1519 */ ); | |
| 1520 | |
| 1521 DEFVAR_CONSOLE_LOCAL ("function-key-map", function_key_map /* | |
| 1522 Keymap mapping ASCII function key sequences onto their preferred forms. | |
| 1523 This allows Emacs to recognize function keys sent from ASCII | |
| 1524 terminals at any point in a key sequence. | |
| 1525 | |
| 1526 The `read-key-sequence' function replaces any subsequence bound by | |
| 1527 `function-key-map' with its binding. More precisely, when the active | |
| 1528 keymaps have no binding for the current key sequence but | |
| 1529 `function-key-map' binds a suffix of the sequence to a vector or string, | |
| 1530 `read-key-sequence' replaces the matching suffix with its binding, and | |
| 2027 | 1531 continues with the new sequence. See `key-binding'. |
| 428 | 1532 |
| 1533 The events that come from bindings in `function-key-map' are not | |
| 1534 themselves looked up in `function-key-map'. | |
| 1535 | |
| 1536 For example, suppose `function-key-map' binds `ESC O P' to [f1]. | |
| 1537 Typing `ESC O P' to `read-key-sequence' would return | |
| 1538 \[#<keypress-event f1>]. Typing `C-x ESC O P' would return | |
| 1539 \[#<keypress-event control-X> #<keypress-event f1>]. If [f1] | |
| 1540 were a prefix key, typing `ESC O P x' would return | |
| 1541 \[#<keypress-event f1> #<keypress-event x>]. | |
| 1542 */ ); | |
| 1543 | |
| 1544 #ifdef HAVE_TTY | |
| 440 | 1545 /* #### Should this somehow go to TTY data? How do we make it |
| 428 | 1546 accessible from Lisp, then? */ |
| 1547 DEFVAR_CONSOLE_LOCAL ("tty-erase-char", tty_erase_char /* | |
| 1548 The ERASE character as set by the user with stty. | |
| 1549 When this value cannot be determined or would be meaningless (on non-TTY | |
| 1550 consoles, for example), it is set to nil. | |
| 1551 */ ); | |
| 1552 #endif | |
| 1553 | |
| 442 | 1554 /* While this should be const it can't be because some things |
| 428 | 1555 (i.e. edebug) do manipulate it. */ |
| 1556 DEFVAR_CONSOLE_LOCAL ("defining-kbd-macro", defining_kbd_macro /* | |
| 442 | 1557 Non-nil while a keyboard macro is being defined. Don't set this! |
| 428 | 1558 */ ); |
| 1559 | |
| 1560 DEFVAR_CONSOLE_LOCAL ("last-kbd-macro", last_kbd_macro /* | |
| 442 | 1561 Last keyboard macro defined, as a vector of events; nil if none defined. |
| 428 | 1562 */ ); |
| 1563 | |
| 1564 DEFVAR_CONSOLE_LOCAL ("prefix-arg", prefix_arg /* | |
| 1565 The value of the prefix argument for the next editing command. | |
| 1566 It may be a number, or the symbol `-' for just a minus sign as arg, | |
| 1567 or a list whose car is a number for just one or more C-U's | |
| 1568 or nil if no argument has been specified. | |
| 1569 | |
| 1570 You cannot examine this variable to find the argument for this command | |
| 1571 since it has been set to nil by the time you can look. | |
| 1572 Instead, you should use the variable `current-prefix-arg', although | |
| 1573 normally commands can get this prefix argument with (interactive "P"). | |
| 1574 */ ); | |
| 1575 | |
| 1576 DEFVAR_CONSOLE_LOCAL ("default-minibuffer-frame", | |
| 1577 default_minibuffer_frame /* | |
| 1578 Minibufferless frames use this frame's minibuffer. | |
| 1579 | |
| 1580 Emacs cannot create minibufferless frames unless this is set to an | |
| 1581 appropriate surrogate. | |
| 1582 | |
| 1583 XEmacs consults this variable only when creating minibufferless | |
| 1584 frames; once the frame is created, it sticks with its assigned | |
| 1585 minibuffer, no matter what this variable is set to. This means that | |
| 1586 this variable doesn't necessarily say anything meaningful about the | |
| 1587 current set of frames, or where the minibuffer is currently being | |
| 1588 displayed. | |
| 1589 */ ); | |
| 1590 | |
| 1591 DEFVAR_CONSOLE_LOCAL ("overriding-terminal-local-map", | |
| 1592 overriding_terminal_local_map /* | |
| 1593 Keymap that overrides all other local keymaps, for the selected console only. | |
| 1594 If this variable is non-nil, it is used as a keymap instead of the | |
| 1595 buffer's local map, and the minor mode keymaps and text property keymaps. | |
| 1596 */ ); | |
| 1597 | |
| 1598 /* Check for DEFVAR_CONSOLE_LOCAL without initializing the corresponding | |
| 1599 slot of console_local_flags and vice-versa. Must be done after all | |
| 1600 DEFVAR_CONSOLE_LOCAL() calls. */ | |
| 1601 #define MARKED_SLOT(slot) \ | |
| 1602 if ((XINT (console_local_flags.slot) != -2 && \ | |
| 1603 XINT (console_local_flags.slot) != -3) \ | |
| 1604 != !(NILP (XCONSOLE (Vconsole_local_symbols)->slot))) \ | |
| 2500 | 1605 ABORT (); |
| 428 | 1606 #include "conslots.h" |
| 1607 } |