Mercurial > hg > xemacs-beta
annotate src/symbols.c @ 4952:19a72041c5ed
Mule-izing, various fixes related to char * arguments
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (print_pgresult):
* postgresql/postgresql.c (Fpq_conn_defaults):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_result_status):
* postgresql/postgresql.c (Fpq_res_status):
Mule-ize large parts of it.
2010-01-26 Ben Wing <ben@xemacs.org>
* ldap/eldap.c (print_ldap):
* ldap/eldap.c (allocate_ldap):
Use write_ascstring().
src/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (build_ascstring):
* alloc.c (build_msg_cistring):
* alloc.c (staticpro_1):
* alloc.c (staticpro_name):
* alloc.c (staticpro_nodump_1):
* alloc.c (staticpro_nodump_name):
* alloc.c (unstaticpro_nodump_1):
* alloc.c (mcpro_1):
* alloc.c (mcpro_name):
* alloc.c (object_memory_usage_stats):
* alloc.c (common_init_alloc_early):
* alloc.c (init_alloc_once_early):
* buffer.c (print_buffer):
* buffer.c (vars_of_buffer):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.c (init_initial_directory):
* bytecode.c (invalid_byte_code):
* bytecode.c (print_compiled_function):
* bytecode.c (mark_compiled_function):
* chartab.c (print_table_entry):
* chartab.c (print_char_table):
* config.h.in:
* console-gtk.c:
* console-gtk.c (gtk_device_to_console_connection):
* console-gtk.c (gtk_semi_canonicalize_console_connection):
* console-gtk.c (gtk_canonicalize_console_connection):
* console-gtk.c (gtk_semi_canonicalize_device_connection):
* console-gtk.c (gtk_canonicalize_device_connection):
* console-stream.c (stream_init_frame_1):
* console-stream.c (vars_of_console_stream):
* console-stream.c (init_console_stream):
* console-x.c (x_semi_canonicalize_console_connection):
* console-x.c (x_semi_canonicalize_device_connection):
* console-x.c (x_canonicalize_device_connection):
* console-x.h:
* data.c (eq_with_ebola_notice):
* data.c (Fsubr_interactive):
* data.c (Fnumber_to_string):
* data.c (digit_to_number):
* device-gtk.c (gtk_init_device):
* device-msw.c (print_devmode):
* device-x.c (x_event_name):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-msw.c (vars_of_dialog_mswindows):
* doc.c (weird_doc):
* doc.c (Fsnarf_documentation):
* doc.c (vars_of_doc):
* dumper.c (pdump):
* dynarr.c:
* dynarr.c (Dynarr_realloc):
* editfns.c (Fuser_real_login_name):
* editfns.c (get_home_directory):
* elhash.c (print_hash_table_data):
* elhash.c (print_hash_table):
* emacs.c (main_1):
* emacs.c (vars_of_emacs):
* emodules.c:
* emodules.c (_emodules_list):
* emodules.c (Fload_module):
* emodules.c (Funload_module):
* emodules.c (Flist_modules):
* emodules.c (find_make_module):
* emodules.c (attempt_module_delete):
* emodules.c (emodules_load):
* emodules.c (emodules_doc_subr):
* emodules.c (emodules_doc_sym):
* emodules.c (syms_of_module):
* emodules.c (vars_of_module):
* emodules.h:
* eval.c (print_subr):
* eval.c (signal_call_debugger):
* eval.c (build_error_data):
* eval.c (signal_error):
* eval.c (maybe_signal_error):
* eval.c (signal_continuable_error):
* eval.c (maybe_signal_continuable_error):
* eval.c (signal_error_2):
* eval.c (maybe_signal_error_2):
* eval.c (signal_continuable_error_2):
* eval.c (maybe_signal_continuable_error_2):
* eval.c (signal_ferror):
* eval.c (maybe_signal_ferror):
* eval.c (signal_continuable_ferror):
* eval.c (maybe_signal_continuable_ferror):
* eval.c (signal_ferror_with_frob):
* eval.c (maybe_signal_ferror_with_frob):
* eval.c (signal_continuable_ferror_with_frob):
* eval.c (maybe_signal_continuable_ferror_with_frob):
* eval.c (syntax_error):
* eval.c (syntax_error_2):
* eval.c (maybe_syntax_error):
* eval.c (sferror):
* eval.c (sferror_2):
* eval.c (maybe_sferror):
* eval.c (invalid_argument):
* eval.c (invalid_argument_2):
* eval.c (maybe_invalid_argument):
* eval.c (invalid_constant):
* eval.c (invalid_constant_2):
* eval.c (maybe_invalid_constant):
* eval.c (invalid_operation):
* eval.c (invalid_operation_2):
* eval.c (maybe_invalid_operation):
* eval.c (invalid_change):
* eval.c (invalid_change_2):
* eval.c (maybe_invalid_change):
* eval.c (invalid_state):
* eval.c (invalid_state_2):
* eval.c (maybe_invalid_state):
* eval.c (wtaerror):
* eval.c (stack_overflow):
* eval.c (out_of_memory):
* eval.c (print_multiple_value):
* eval.c (issue_call_trapping_problems_warning):
* eval.c (backtrace_specials):
* eval.c (backtrace_unevalled_args):
* eval.c (Fbacktrace):
* eval.c (warn_when_safe):
* event-Xt.c (modwarn):
* event-Xt.c (modbarf):
* event-Xt.c (check_modifier):
* event-Xt.c (store_modifier):
* event-Xt.c (emacs_Xt_format_magic_event):
* event-Xt.c (describe_event):
* event-gtk.c (dragndrop_data_received):
* event-gtk.c (store_modifier):
* event-gtk.c (gtk_reset_modifier_mapping):
* event-msw.c (dde_eval_string):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (FROB):
* event-msw.c (emacs_mswindows_format_magic_event):
* event-stream.c (external_debugging_print_event):
* event-stream.c (execute_help_form):
* event-stream.c (vars_of_event_stream):
* events.c (print_event_1):
* events.c (print_event):
* events.c (event_equal):
* extents.c (print_extent_1):
* extents.c (print_extent):
* extents.c (vars_of_extents):
* faces.c (print_face):
* faces.c (complex_vars_of_faces):
* file-coding.c:
* file-coding.c (print_coding_system):
* file-coding.c (print_coding_system_in_print_method):
* file-coding.c (default_query_method):
* file-coding.c (find_coding_system):
* file-coding.c (make_coding_system_1):
* file-coding.c (chain_print):
* file-coding.c (undecided_print):
* file-coding.c (gzip_print):
* file-coding.c (vars_of_file_coding):
* file-coding.c (complex_vars_of_file_coding):
* fileio.c:
* fileio.c (report_file_type_error):
* fileio.c (report_error_with_errno):
* fileio.c (report_file_error):
* fileio.c (barf_or_query_if_file_exists):
* fileio.c (vars_of_fileio):
* floatfns.c (matherr):
* fns.c (print_bit_vector):
* fns.c (Fmapconcat):
* fns.c (add_suffix_to_symbol):
* fns.c (add_prefix_to_symbol):
* frame-gtk.c:
* frame-gtk.c (Fgtk_window_id):
* frame-x.c (def):
* frame-x.c (x_cde_transfer_callback):
* frame.c:
* frame.c (Fmake_frame):
* gc.c (show_gc_cursor_and_message):
* gc.c (vars_of_gc):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (gtk_print_image_instance):
* glyphs-msw.c (mswindows_print_image_instance):
* glyphs-x.c (x_print_image_instance):
* glyphs-x.c (update_widget_face):
* glyphs.c (make_string_from_file):
* glyphs.c (print_image_instance):
* glyphs.c (signal_image_error):
* glyphs.c (signal_image_error_2):
* glyphs.c (signal_double_image_error):
* glyphs.c (signal_double_image_error_2):
* glyphs.c (xbm_mask_file_munging):
* glyphs.c (pixmap_to_lisp_data):
* glyphs.h:
* gui.c (gui_item_display_flush_left):
* hpplay.c (player_error_internal):
* hpplay.c (myHandler):
* intl-win32.c:
* intl-win32.c (langcode_to_lang):
* intl-win32.c (sublangcode_to_lang):
* intl-win32.c (Fmswindows_get_locale_info):
* intl-win32.c (lcid_to_locale_mule_or_no):
* intl-win32.c (mswindows_multibyte_to_unicode_print):
* intl-win32.c (complex_vars_of_intl_win32):
* keymap.c:
* keymap.c (print_keymap):
* keymap.c (ensure_meta_prefix_char_keymapp):
* keymap.c (Fkey_description):
* keymap.c (Ftext_char_description):
* lisp.h:
* lisp.h (struct):
* lisp.h (DECLARE_INLINE_HEADER):
* lread.c (Fload_internal):
* lread.c (locate_file):
* lread.c (read_escape):
* lread.c (read_raw_string):
* lread.c (read1):
* lread.c (read_list):
* lread.c (read_compiled_function):
* lread.c (init_lread):
* lrecord.h:
* marker.c (print_marker):
* marker.c (marker_equal):
* menubar-msw.c (displayable_menu_item):
* menubar-x.c (command_builder_operate_menu_accelerator):
* menubar.c (vars_of_menubar):
* minibuf.c (reinit_complex_vars_of_minibuf):
* minibuf.c (complex_vars_of_minibuf):
* mule-charset.c (Fmake_charset):
* mule-charset.c (complex_vars_of_mule_charset):
* mule-coding.c (iso2022_print):
* mule-coding.c (fixed_width_query):
* number.c (bignum_print):
* number.c (ratio_print):
* number.c (bigfloat_print):
* number.c (bigfloat_finalize):
* objects-msw.c:
* objects-msw.c (mswindows_color_to_string):
* objects-msw.c (mswindows_color_list):
* objects-tty.c:
* objects-tty.c (tty_font_list):
* objects-tty.c (tty_find_charset_font):
* objects-xlike-inc.c (xft_find_charset_font):
* objects-xlike-inc.c (endif):
* print.c:
* print.c (write_istring):
* print.c (write_ascstring):
* print.c (Fterpri):
* print.c (Fprint):
* print.c (print_error_message):
* print.c (print_vector_internal):
* print.c (print_cons):
* print.c (print_string):
* print.c (printing_unreadable_object):
* print.c (print_internal):
* print.c (print_float):
* print.c (print_symbol):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_canonicalize_host_name):
* process-unix.c (unix_canonicalize_host_name):
* process.c (print_process):
* process.c (report_process_error):
* process.c (report_network_error):
* process.c (make_process_internal):
* process.c (Fstart_process_internal):
* process.c (status_message):
* process.c (putenv_internal):
* process.c (vars_of_process):
* process.h:
* profile.c (vars_of_profile):
* rangetab.c (print_range_table):
* realpath.c (vars_of_realpath):
* redisplay.c (vars_of_redisplay):
* search.c (wordify):
* search.c (Freplace_match):
* sheap.c (sheap_adjust_h):
* sound.c (report_sound_error):
* sound.c (Fplay_sound_file):
* specifier.c (print_specifier):
* symbols.c (Fsubr_name):
* symbols.c (do_symval_forwarding):
* symbols.c (set_default_buffer_slot_variable):
* symbols.c (set_default_console_slot_variable):
* symbols.c (store_symval_forwarding):
* symbols.c (default_value):
* symbols.c (defsymbol_massage_name_1):
* symbols.c (defsymbol_massage_name_nodump):
* symbols.c (defsymbol_massage_name):
* symbols.c (defsymbol_massage_multiword_predicate_nodump):
* symbols.c (defsymbol_massage_multiword_predicate):
* symbols.c (defsymbol_nodump):
* symbols.c (defsymbol):
* symbols.c (defkeyword):
* symbols.c (defkeyword_massage_name):
* symbols.c (check_module_subr):
* symbols.c (deferror_1):
* symbols.c (deferror):
* symbols.c (deferror_massage_name):
* symbols.c (deferror_massage_name_and_message):
* symbols.c (defvar_magic):
* symeval.h:
* symeval.h (DEFVAR_SYMVAL_FWD):
* sysdep.c:
* sysdep.c (init_system_name):
* sysdll.c:
* sysdll.c (MAYBE_PREPEND_UNDERSCORE):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (dll_error):
* sysdll.c (dll_open):
* sysdll.c (dll_close):
* sysdll.c (image_for_address):
* sysdll.c (my_find_image):
* sysdll.c (search_linked_libs):
* sysdll.h:
* sysfile.h:
* sysfile.h (DEFAULT_DIRECTORY_FALLBACK):
* syswindows.h:
* tests.c (DFC_CHECK_LENGTH):
* tests.c (DFC_CHECK_CONTENT):
* tests.c (Ftest_hash_tables):
* text.c (vars_of_text):
* text.h:
* tooltalk.c (tt_opnum_string):
* tooltalk.c (tt_message_arg_ival_string):
* tooltalk.c (Ftooltalk_default_procid):
* tooltalk.c (Ftooltalk_default_session):
* tooltalk.c (init_tooltalk):
* tooltalk.c (vars_of_tooltalk):
* ui-gtk.c (Fdll_load):
* ui-gtk.c (type_to_marshaller_type):
* ui-gtk.c (Fgtk_import_function_internal):
* ui-gtk.c (emacs_gtk_object_printer):
* ui-gtk.c (emacs_gtk_boxed_printer):
* unicode.c (unicode_to_ichar):
* unicode.c (unicode_print):
* unicode.c (unicode_query):
* unicode.c (vars_of_unicode):
* unicode.c (complex_vars_of_unicode):
* win32.c:
* win32.c (mswindows_report_process_error):
* window.c (print_window):
* xemacs.def.in.in:
BASIC IDEA: Further fixing up uses of char * and CIbyte *
to reflect their actual semantics; Mule-izing some code;
redoing of the not-yet-working code to handle message translation.
Clean up code to handle message-translation (not yet working).
Create separate versions of build_msg_string() for working with
Ibyte *, CIbyte *, and Ascbyte * arguments. Assert that Ascbyte *
arguments are pure-ASCII. Make build_msg_string() be the same
as build_msg_ascstring(). Create same three versions of GETTEXT()
and DEFER_GETTEXT(). Also create build_defer_string() and
variants for the equivalent of DEFER_GETTEXT() when building a
string. Remove old CGETTEXT(). Clean up code where GETTEXT(),
DEFER_GETTEXT(), build_msg_string(), etc. was being called and
introduce some new calls to build_msg_string(), etc. Remove
GETTEXT() from calls to weird_doc() -- we assume that the
message snarfer knows about weird_doc(). Remove uses of
DEFER_GETTEXT() from error messages in sysdep.c and instead use
special comments /* @@@begin-snarf@@@ */ and /* @@@end-snarf@@@ */
that the message snarfer presumably knows about.
Create build_ascstring() and use it in many instances in place
of build_string(). The purpose of having Ascbyte * variants is
to make the code more self-documenting in terms of what sort of
semantics is expected for char * strings. In fact in the process
of looking for uses of build_string(), much improperly Mule-ized
was discovered.
Mule-ize a lot of code as described in previous paragraph,
e.g. in sysdep.c.
Make the error functions take Ascbyte * strings and fix up a
couple of places where non-pure-ASCII strings were being passed in
(file-coding.c, mule-coding.c, unicode.c). (It's debatable whether
we really need to make the error functions work this way. It
helps catch places where code is written in a way that message
translation won't work, but we may well never implement message
translation.)
Make staticpro() and friends take Ascbyte * strings instead of
raw char * strings. Create a const_Ascbyte_ptr dynarr type
to describe what's held by staticpro_names[] and friends,
create pdump descriptions for const_Ascbyte_ptr dynarrs, and
use them in place of specially-crafted staticpro descriptions.
Mule-ize certain other functions (e.g. x_event_name) by correcting
raw use of char * to Ascbyte *, Rawbyte * or another such type,
and raw use of char[] buffers to another type (usually Ascbyte[]).
Change many uses of write_c_string() to write_msg_string(),
write_ascstring(), etc.
Mule-ize emodules.c, emodules.h, sysdll.h.
Fix some un-Mule-ized code in intl-win32.c.
A comment in event-Xt.c and the limitations of the message
snarfer (make-msgfile or whatever) is presumably incorrect --
it should be smart enough to handle function calls spread over
more than one line. Clean up code in event-Xt.c that was
written awkwardly for this reason.
In config.h.in, instead of NEED_ERROR_CHECK_TYPES_INLINES,
create a more general XEMACS_DEFS_NEEDS_INLINE_DECLS to
indicate when inlined functions need to be declared in
xemacs.defs.in.in, and make use of it in xemacs.defs.in.in.
We need to do this because postgresql.c now calls qxestrdup(),
which is an inline function.
Make nconc2() and other such functions MODULE_API and put
them in xemacs.defs.in.in since postgresql.c now uses them.
Clean up indentation in lread.c and a few other places.
In text.h, document ASSERT_ASCTEXT_ASCII() and
ASSERT_ASCTEXT_ASCII_LEN(), group together the stand-in
encodings and add some more for DLL symbols, function and
variable names, etc.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Tue, 26 Jan 2010 23:22:30 -0600 |
| parents | 9113c5044de8 |
| children | 304aebb79cd3 |
| rev | line source |
|---|---|
| 428 | 1 /* "intern" and friends -- moved here from lread.c and data.c |
| 2 Copyright (C) 1985-1989, 1992-1994 Free Software Foundation, Inc. | |
|
4940
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
3 Copyright (C) 1995, 2000, 2001, 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: FSF 19.30. */ | |
| 23 | |
| 24 /* This file has been Mule-ized. */ | |
| 25 | |
| 26 /* NOTE: | |
| 27 | |
| 28 The value cell of a symbol can contain a simple value or one of | |
| 29 various symbol-value-magic objects. Some of these objects can | |
| 30 chain into other kinds of objects. Here is a table of possibilities: | |
| 31 | |
| 32 1a) simple value | |
| 33 1b) Qunbound | |
| 34 1c) symbol-value-forward, excluding Qunbound | |
| 35 2) symbol-value-buffer-local -> 1a or 1b or 1c | |
| 36 3) symbol-value-lisp-magic -> 1a or 1b or 1c | |
| 37 4) symbol-value-lisp-magic -> symbol-value-buffer-local -> 1a or 1b or 1c | |
| 38 5) symbol-value-varalias | |
| 39 6) symbol-value-lisp-magic -> symbol-value-varalias | |
| 40 | |
| 41 The "chain" of a symbol-value-buffer-local is its current_value slot. | |
| 42 | |
| 43 The "chain" of a symbol-value-lisp-magic is its shadowed slot, which | |
| 44 applies for handler types without associated handlers. | |
| 45 | |
| 46 All other fields in all the structures (including the "shadowed" slot | |
| 47 in a symbol-value-varalias) can *only* contain a simple value or Qunbound. | |
| 48 | |
| 49 */ | |
| 50 | |
| 51 /* #### Ugh, though, this file does awful things with symbol-value-magic | |
| 52 objects. This ought to be cleaned up. */ | |
| 53 | |
| 54 #include <config.h> | |
| 55 #include "lisp.h" | |
| 56 | |
| 57 #include "buffer.h" /* for Vbuffer_defaults */ | |
| 872 | 58 #include "console-impl.h" |
| 428 | 59 #include "elhash.h" |
| 60 | |
| 61 Lisp_Object Qad_advice_info, Qad_activate; | |
| 62 | |
| 63 Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound; | |
| 64 Lisp_Object Qlocal_predicate, Qmake_local; | |
| 65 | |
| 66 Lisp_Object Qboundp, Qglobally_boundp, Qmakunbound; | |
| 67 Lisp_Object Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value; | |
| 68 Lisp_Object Qset_default, Qsetq_default; | |
| 69 Lisp_Object Qmake_variable_buffer_local, Qmake_local_variable; | |
| 70 Lisp_Object Qkill_local_variable, Qkill_console_local_variable; | |
| 71 Lisp_Object Qsymbol_value_in_buffer, Qsymbol_value_in_console; | |
| 72 Lisp_Object Qlocal_variable_p; | |
| 73 | |
| 74 Lisp_Object Qconst_integer, Qconst_boolean, Qconst_object; | |
| 75 Lisp_Object Qconst_specifier; | |
| 76 Lisp_Object Qdefault_buffer, Qcurrent_buffer, Qconst_current_buffer; | |
| 77 Lisp_Object Qdefault_console, Qselected_console, Qconst_selected_console; | |
| 78 | |
| 79 static Lisp_Object maybe_call_magic_handler (Lisp_Object sym, | |
| 80 Lisp_Object funsym, | |
| 81 int nargs, ...); | |
| 82 static Lisp_Object fetch_value_maybe_past_magic (Lisp_Object sym, | |
| 83 Lisp_Object follow_past_lisp_magic); | |
| 84 static Lisp_Object *value_slot_past_magic (Lisp_Object sym); | |
| 85 static Lisp_Object follow_varalias_pointers (Lisp_Object symbol, | |
| 86 Lisp_Object follow_past_lisp_magic); | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
87 static Lisp_Object map_varalias_chain (Lisp_Object symbol, |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
88 Lisp_Object follow_past_lisp_magic, |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
89 Lisp_Object (*fn) (Lisp_Object arg)); |
| 428 | 90 |
| 91 | |
| 92 static Lisp_Object | |
| 93 mark_symbol (Lisp_Object obj) | |
| 94 { | |
| 440 | 95 Lisp_Symbol *sym = XSYMBOL (obj); |
| 428 | 96 |
| 97 mark_object (sym->value); | |
| 98 mark_object (sym->function); | |
| 793 | 99 mark_object (sym->name); |
| 428 | 100 if (!symbol_next (sym)) |
| 101 return sym->plist; | |
| 102 else | |
| 103 { | |
| 104 mark_object (sym->plist); | |
| 105 /* Mark the rest of the symbols in the obarray hash-chain */ | |
| 106 sym = symbol_next (sym); | |
| 793 | 107 return wrap_symbol (sym); |
| 428 | 108 } |
| 109 } | |
| 110 | |
| 1204 | 111 static const struct memory_description symbol_description[] = { |
| 440 | 112 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, next) }, |
| 113 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, name) }, | |
| 114 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, value) }, | |
| 115 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, function) }, | |
| 116 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, plist) }, | |
| 428 | 117 { XD_END } |
| 118 }; | |
| 119 | |
| 442 | 120 /* Symbol plists are directly accessible, so we need to protect against |
| 121 invalid property list structure */ | |
| 122 | |
| 123 static Lisp_Object | |
| 124 symbol_getprop (Lisp_Object symbol, Lisp_Object property) | |
| 125 { | |
| 126 return external_plist_get (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME); | |
| 127 } | |
| 128 | |
| 129 static int | |
| 130 symbol_putprop (Lisp_Object symbol, Lisp_Object property, Lisp_Object value) | |
| 131 { | |
| 132 external_plist_put (&XSYMBOL (symbol)->plist, property, value, 0, ERROR_ME); | |
| 133 return 1; | |
| 134 } | |
| 135 | |
| 136 static int | |
| 137 symbol_remprop (Lisp_Object symbol, Lisp_Object property) | |
| 138 { | |
| 139 return external_remprop (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME); | |
| 140 } | |
| 141 | |
| 934 | 142 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("symbol", symbol, |
| 143 1, /*dumpable-flag*/ | |
| 144 mark_symbol, print_symbol, | |
| 145 0, 0, 0, symbol_description, | |
| 146 symbol_getprop, | |
| 147 symbol_putprop, | |
| 148 symbol_remprop, | |
| 149 Fsymbol_plist, | |
| 150 Lisp_Symbol); | |
| 428 | 151 |
| 152 /**********************************************************************/ | |
| 153 /* Intern */ | |
| 154 /**********************************************************************/ | |
| 155 | |
| 156 /* #### using a vector here is way bogus. Use a hash table instead. */ | |
| 157 | |
| 158 Lisp_Object Vobarray; | |
| 159 | |
| 160 static Lisp_Object initial_obarray; | |
| 161 | |
| 162 /* oblookup stores the bucket number here, for the sake of Funintern. */ | |
| 163 | |
| 164 static int oblookup_last_bucket_number; | |
| 165 | |
| 166 static Lisp_Object | |
| 167 check_obarray (Lisp_Object obarray) | |
| 168 { | |
| 169 while (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0) | |
| 170 { | |
| 171 /* If Vobarray is now invalid, force it to be valid. */ | |
| 172 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray; | |
| 173 | |
| 174 obarray = wrong_type_argument (Qvectorp, obarray); | |
| 175 } | |
| 176 return obarray; | |
| 177 } | |
| 178 | |
| 179 Lisp_Object | |
| 867 | 180 intern_int (const Ibyte *str) |
| 428 | 181 { |
| 771 | 182 Bytecount len = qxestrlen (str); |
| 428 | 183 Lisp_Object obarray = Vobarray; |
| 184 | |
| 185 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0) | |
| 186 obarray = check_obarray (obarray); | |
| 187 | |
| 188 { | |
| 771 | 189 Lisp_Object tem = oblookup (obarray, str, len); |
| 428 | 190 if (SYMBOLP (tem)) |
| 191 return tem; | |
| 192 } | |
| 193 | |
| 771 | 194 return Fintern (make_string (str, len), obarray); |
| 195 } | |
| 196 | |
| 197 Lisp_Object | |
| 867 | 198 intern (const CIbyte *str) |
| 771 | 199 { |
| 867 | 200 return intern_int ((Ibyte *) str); |
| 428 | 201 } |
| 202 | |
| 814 | 203 Lisp_Object |
| 867 | 204 intern_converting_underscores_to_dashes (const CIbyte *str) |
| 814 | 205 { |
| 206 Bytecount len = strlen (str); | |
| 867 | 207 CIbyte *tmp = alloca_extbytes (len + 1); |
| 814 | 208 Bytecount i; |
| 209 strcpy (tmp, str); | |
| 210 for (i = 0; i < len; i++) | |
| 211 if (tmp[i] == '_') | |
| 212 tmp[i] = '-'; | |
| 867 | 213 return intern_int ((Ibyte *) tmp); |
| 814 | 214 } |
| 215 | |
| 428 | 216 DEFUN ("intern", Fintern, 1, 2, 0, /* |
| 217 Return the canonical symbol whose name is STRING. | |
| 218 If there is none, one is created by this function and returned. | |
| 444 | 219 Optional second argument OBARRAY specifies the obarray to use; |
| 220 it defaults to the value of the variable `obarray'. | |
| 428 | 221 */ |
| 222 (string, obarray)) | |
| 223 { | |
| 224 Lisp_Object object, *ptr; | |
| 793 | 225 Lisp_Object symbol; |
| 428 | 226 Bytecount len; |
| 227 | |
| 228 if (NILP (obarray)) obarray = Vobarray; | |
| 229 obarray = check_obarray (obarray); | |
| 230 | |
| 231 CHECK_STRING (string); | |
| 232 | |
| 233 len = XSTRING_LENGTH (string); | |
| 234 object = oblookup (obarray, XSTRING_DATA (string), len); | |
| 235 if (!INTP (object)) | |
| 236 /* Found it */ | |
| 237 return object; | |
| 238 | |
| 239 ptr = &XVECTOR_DATA (obarray)[XINT (object)]; | |
| 240 | |
| 241 object = Fmake_symbol (string); | |
| 793 | 242 symbol = object; |
| 428 | 243 |
| 244 if (SYMBOLP (*ptr)) | |
| 793 | 245 XSYMBOL_NEXT (symbol) = XSYMBOL (*ptr); |
| 428 | 246 else |
| 793 | 247 XSYMBOL_NEXT (symbol) = 0; |
| 428 | 248 *ptr = object; |
| 249 | |
| 826 | 250 if (string_byte (XSYMBOL_NAME (symbol), 0) == ':' && EQ (obarray, Vobarray)) |
| 428 | 251 { |
| 252 /* The LISP way is to put keywords in their own package, but we | |
| 253 don't have packages, so we do something simpler. Someday, | |
| 254 maybe we'll have packages and then this will be reworked. | |
| 255 --Stig. */ | |
| 793 | 256 XSYMBOL_VALUE (symbol) = object; |
| 428 | 257 } |
| 258 | |
| 259 return object; | |
| 260 } | |
| 261 | |
|
4355
a2af1ff1761f
Provide a DEFAULT argument in #'intern-soft.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4337
diff
changeset
|
262 DEFUN ("intern-soft", Fintern_soft, 1, 3, 0, /* |
| 428 | 263 Return the canonical symbol named NAME, or nil if none exists. |
| 264 NAME may be a string or a symbol. If it is a symbol, that exact | |
| 265 symbol is searched for. | |
| 444 | 266 Optional second argument OBARRAY specifies the obarray to use; |
| 267 it defaults to the value of the variable `obarray'. | |
|
4355
a2af1ff1761f
Provide a DEFAULT argument in #'intern-soft.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4337
diff
changeset
|
268 Optional third argument DEFAULT says what Lisp object to return if there is |
|
a2af1ff1761f
Provide a DEFAULT argument in #'intern-soft.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4337
diff
changeset
|
269 no canonical symbol named NAME, and defaults to nil. |
| 428 | 270 */ |
|
4355
a2af1ff1761f
Provide a DEFAULT argument in #'intern-soft.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4337
diff
changeset
|
271 (name, obarray, default_)) |
| 428 | 272 { |
| 273 Lisp_Object tem; | |
| 793 | 274 Lisp_Object string; |
| 428 | 275 |
| 276 if (NILP (obarray)) obarray = Vobarray; | |
| 277 obarray = check_obarray (obarray); | |
| 278 | |
| 279 if (!SYMBOLP (name)) | |
| 280 { | |
| 281 CHECK_STRING (name); | |
| 793 | 282 string = name; |
| 428 | 283 } |
| 284 else | |
| 285 string = symbol_name (XSYMBOL (name)); | |
| 286 | |
| 793 | 287 tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string)); |
| 428 | 288 if (INTP (tem) || (SYMBOLP (name) && !EQ (name, tem))) |
|
4355
a2af1ff1761f
Provide a DEFAULT argument in #'intern-soft.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4337
diff
changeset
|
289 return default_; |
| 428 | 290 else |
| 291 return tem; | |
| 292 } | |
| 293 | |
| 294 DEFUN ("unintern", Funintern, 1, 2, 0, /* | |
| 295 Delete the symbol named NAME, if any, from OBARRAY. | |
| 296 The value is t if a symbol was found and deleted, nil otherwise. | |
| 297 NAME may be a string or a symbol. If it is a symbol, that symbol | |
| 298 is deleted, if it belongs to OBARRAY--no other symbol is deleted. | |
| 444 | 299 OBARRAY defaults to the value of the variable `obarray'. |
| 428 | 300 */ |
| 301 (name, obarray)) | |
| 302 { | |
| 303 Lisp_Object tem; | |
| 793 | 304 Lisp_Object string; |
| 428 | 305 int hash; |
| 306 | |
| 307 if (NILP (obarray)) obarray = Vobarray; | |
| 308 obarray = check_obarray (obarray); | |
| 309 | |
| 310 if (SYMBOLP (name)) | |
| 311 string = symbol_name (XSYMBOL (name)); | |
| 312 else | |
| 313 { | |
| 314 CHECK_STRING (name); | |
| 793 | 315 string = name; |
| 428 | 316 } |
| 317 | |
| 793 | 318 tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string)); |
| 428 | 319 if (INTP (tem)) |
| 320 return Qnil; | |
| 321 /* If arg was a symbol, don't delete anything but that symbol itself. */ | |
| 322 if (SYMBOLP (name) && !EQ (name, tem)) | |
| 323 return Qnil; | |
| 324 | |
| 325 hash = oblookup_last_bucket_number; | |
| 326 | |
| 327 if (EQ (XVECTOR_DATA (obarray)[hash], tem)) | |
| 328 { | |
| 329 if (XSYMBOL (tem)->next) | |
| 793 | 330 XVECTOR_DATA (obarray)[hash] = wrap_symbol (XSYMBOL (tem)->next); |
| 428 | 331 else |
| 332 XVECTOR_DATA (obarray)[hash] = Qzero; | |
| 333 } | |
| 334 else | |
| 335 { | |
| 336 Lisp_Object tail, following; | |
| 337 | |
| 338 for (tail = XVECTOR_DATA (obarray)[hash]; | |
| 339 XSYMBOL (tail)->next; | |
| 340 tail = following) | |
| 341 { | |
| 793 | 342 following = wrap_symbol (XSYMBOL (tail)->next); |
| 428 | 343 if (EQ (following, tem)) |
| 344 { | |
| 345 XSYMBOL (tail)->next = XSYMBOL (following)->next; | |
| 346 break; | |
| 347 } | |
| 348 } | |
| 349 } | |
| 350 return Qt; | |
| 351 } | |
| 352 | |
| 353 /* Return the symbol in OBARRAY whose names matches the string | |
| 354 of SIZE characters at PTR. If there is no such symbol in OBARRAY, | |
| 355 return the index into OBARRAY that the string hashes to. | |
| 356 | |
| 357 Also store the bucket number in oblookup_last_bucket_number. */ | |
| 358 | |
| 359 Lisp_Object | |
| 867 | 360 oblookup (Lisp_Object obarray, const Ibyte *ptr, Bytecount size) |
| 428 | 361 { |
| 490 | 362 unsigned int hash, obsize; |
| 440 | 363 Lisp_Symbol *tail; |
| 428 | 364 Lisp_Object bucket; |
| 365 | |
| 366 if (!VECTORP (obarray) || | |
| 367 (obsize = XVECTOR_LENGTH (obarray)) == 0) | |
| 368 { | |
| 369 obarray = check_obarray (obarray); | |
| 370 obsize = XVECTOR_LENGTH (obarray); | |
| 371 } | |
| 372 hash = hash_string (ptr, size) % obsize; | |
| 373 oblookup_last_bucket_number = hash; | |
| 374 bucket = XVECTOR_DATA (obarray)[hash]; | |
| 375 if (ZEROP (bucket)) | |
| 376 ; | |
| 377 else if (!SYMBOLP (bucket)) | |
| 563 | 378 signal_error (Qinvalid_state, "Bad data in guts of obarray", Qunbound); /* Like CADR error message */ |
| 428 | 379 else |
| 380 for (tail = XSYMBOL (bucket); ;) | |
| 381 { | |
| 793 | 382 if (XSTRING_LENGTH (tail->name) == size && |
| 383 !memcmp (XSTRING_DATA (tail->name), ptr, size)) | |
| 428 | 384 { |
| 793 | 385 return wrap_symbol (tail); |
| 428 | 386 } |
| 387 tail = symbol_next (tail); | |
| 388 if (!tail) | |
| 389 break; | |
| 390 } | |
| 391 return make_int (hash); | |
| 392 } | |
| 393 | |
| 490 | 394 /* An excellent string hashing function. |
| 395 Adapted from glib's g_str_hash(). | |
| 396 Investigation by Karl Nelson <kenelson@ece.ucdavis.edu>. | |
| 397 Do a web search for "g_str_hash X31_HASH" if you want to know more. */ | |
| 398 unsigned int | |
| 867 | 399 hash_string (const Ibyte *ptr, Bytecount len) |
| 428 | 400 { |
| 490 | 401 unsigned int hash; |
| 402 | |
| 403 for (hash = 0; len; len--, ptr++) | |
| 404 /* (31 * hash) will probably be optimized to ((hash << 5) - hash). */ | |
| 405 hash = 31 * hash + *ptr; | |
| 406 | |
| 407 return hash; | |
| 428 | 408 } |
| 409 | |
| 410 /* Map FN over OBARRAY. The mapping is stopped when FN returns a | |
| 411 non-zero value. */ | |
| 412 void | |
| 413 map_obarray (Lisp_Object obarray, | |
| 414 int (*fn) (Lisp_Object, void *), void *arg) | |
| 415 { | |
| 416 REGISTER int i; | |
| 417 | |
| 418 CHECK_VECTOR (obarray); | |
| 419 for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--) | |
| 420 { | |
| 421 Lisp_Object tail = XVECTOR_DATA (obarray)[i]; | |
| 422 if (SYMBOLP (tail)) | |
| 423 while (1) | |
| 424 { | |
| 440 | 425 Lisp_Symbol *next; |
| 428 | 426 if ((*fn) (tail, arg)) |
| 427 return; | |
| 428 next = symbol_next (XSYMBOL (tail)); | |
| 429 if (!next) | |
| 430 break; | |
| 793 | 431 tail = wrap_symbol (next); |
| 428 | 432 } |
| 433 } | |
| 434 } | |
| 435 | |
| 436 static int | |
| 437 mapatoms_1 (Lisp_Object sym, void *arg) | |
| 438 { | |
| 439 call1 (*(Lisp_Object *)arg, sym); | |
| 440 return 0; | |
| 441 } | |
| 442 | |
| 443 DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /* | |
| 444 Call FUNCTION on every symbol in OBARRAY. | |
| 445 OBARRAY defaults to the value of `obarray'. | |
| 446 */ | |
| 447 (function, obarray)) | |
| 448 { | |
| 442 | 449 struct gcpro gcpro1; |
| 450 | |
| 428 | 451 if (NILP (obarray)) |
| 452 obarray = Vobarray; | |
| 453 obarray = check_obarray (obarray); | |
| 454 | |
| 442 | 455 GCPRO1 (obarray); |
| 428 | 456 map_obarray (obarray, mapatoms_1, &function); |
| 442 | 457 UNGCPRO; |
| 428 | 458 return Qnil; |
| 459 } | |
| 460 | |
| 461 | |
| 462 /**********************************************************************/ | |
| 463 /* Apropos */ | |
| 464 /**********************************************************************/ | |
| 465 | |
| 466 struct appropos_mapper_closure | |
| 467 { | |
| 468 Lisp_Object regexp; | |
| 469 Lisp_Object predicate; | |
| 470 Lisp_Object accumulation; | |
| 471 }; | |
| 472 | |
| 473 static int | |
| 474 apropos_mapper (Lisp_Object symbol, void *arg) | |
| 475 { | |
| 476 struct appropos_mapper_closure *closure = | |
| 477 (struct appropos_mapper_closure *) arg; | |
| 478 Bytecount match = fast_lisp_string_match (closure->regexp, | |
| 479 Fsymbol_name (symbol)); | |
| 480 | |
| 481 if (match >= 0 && | |
| 482 (NILP (closure->predicate) || | |
| 483 !NILP (call1 (closure->predicate, symbol)))) | |
| 484 closure->accumulation = Fcons (symbol, closure->accumulation); | |
| 485 | |
| 486 return 0; | |
| 487 } | |
| 488 | |
| 489 DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /* | |
| 444 | 490 Return a list of all symbols whose names contain match for REGEXP. |
| 491 If optional 2nd arg PREDICATE is non-nil, only symbols for which | |
| 492 \(funcall PREDICATE SYMBOL) returns non-nil are returned. | |
| 428 | 493 */ |
| 494 (regexp, predicate)) | |
| 495 { | |
| 496 struct appropos_mapper_closure closure; | |
| 442 | 497 struct gcpro gcpro1; |
| 428 | 498 |
| 499 CHECK_STRING (regexp); | |
| 500 | |
| 501 closure.regexp = regexp; | |
| 502 closure.predicate = predicate; | |
| 503 closure.accumulation = Qnil; | |
| 442 | 504 GCPRO1 (closure.accumulation); |
| 428 | 505 map_obarray (Vobarray, apropos_mapper, &closure); |
| 506 closure.accumulation = Fsort (closure.accumulation, Qstring_lessp); | |
| 442 | 507 UNGCPRO; |
| 428 | 508 return closure.accumulation; |
| 509 } | |
| 510 | |
| 511 | |
| 512 /* Extract and set components of symbols */ | |
| 513 | |
| 514 static void set_up_buffer_local_cache (Lisp_Object sym, | |
| 515 struct symbol_value_buffer_local *bfwd, | |
| 516 struct buffer *buf, | |
| 517 Lisp_Object new_alist_el, | |
| 518 int set_it_p); | |
| 519 | |
| 520 DEFUN ("boundp", Fboundp, 1, 1, 0, /* | |
| 521 Return t if SYMBOL's value is not void. | |
| 522 */ | |
| 523 (symbol)) | |
| 524 { | |
| 525 CHECK_SYMBOL (symbol); | |
| 526 return UNBOUNDP (find_symbol_value (symbol)) ? Qnil : Qt; | |
| 527 } | |
| 528 | |
| 529 DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /* | |
| 530 Return t if SYMBOL has a global (non-bound) value. | |
| 531 This is for the byte-compiler; you really shouldn't be using this. | |
| 532 */ | |
| 533 (symbol)) | |
| 534 { | |
| 535 CHECK_SYMBOL (symbol); | |
| 536 return UNBOUNDP (top_level_value (symbol)) ? Qnil : Qt; | |
| 537 } | |
| 538 | |
| 539 DEFUN ("fboundp", Ffboundp, 1, 1, 0, /* | |
| 540 Return t if SYMBOL's function definition is not void. | |
| 541 */ | |
| 542 (symbol)) | |
| 543 { | |
| 544 CHECK_SYMBOL (symbol); | |
| 545 return UNBOUNDP (XSYMBOL (symbol)->function) ? Qnil : Qt; | |
| 546 } | |
| 547 | |
| 548 /* Return non-zero if SYM's value or function (the current contents of | |
| 549 which should be passed in as VAL) is constant, i.e. unsettable. */ | |
| 550 | |
| 551 static int | |
| 552 symbol_is_constant (Lisp_Object sym, Lisp_Object val) | |
| 553 { | |
| 554 /* #### - I wonder if it would be better to just have a new magic value | |
| 555 type and make nil, t, and all keywords have that same magic | |
| 556 constant_symbol value. This test is awfully specific about what is | |
| 557 constant and what isn't. --Stig */ | |
| 558 if (EQ (sym, Qnil) || | |
| 559 EQ (sym, Qt)) | |
| 560 return 1; | |
| 561 | |
| 562 if (SYMBOL_VALUE_MAGIC_P (val)) | |
| 563 switch (XSYMBOL_VALUE_MAGIC_TYPE (val)) | |
| 564 { | |
| 565 case SYMVAL_CONST_OBJECT_FORWARD: | |
| 566 case SYMVAL_CONST_SPECIFIER_FORWARD: | |
| 567 case SYMVAL_CONST_FIXNUM_FORWARD: | |
| 568 case SYMVAL_CONST_BOOLEAN_FORWARD: | |
| 569 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: | |
| 570 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: | |
| 571 return 1; | |
| 572 default: break; /* Warning suppression */ | |
| 573 } | |
| 574 | |
| 575 /* We don't return true for keywords here because they are handled | |
| 576 specially by reject_constant_symbols(). */ | |
| 577 return 0; | |
| 578 } | |
| 579 | |
| 580 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is | |
| 581 non-zero) to NEWVAL. Make sure this is allowed. | |
| 582 FOLLOW_PAST_LISP_MAGIC specifies whether we delve past | |
| 583 symbol-value-lisp-magic objects. */ | |
| 584 | |
| 585 void | |
| 586 reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p, | |
| 587 Lisp_Object follow_past_lisp_magic) | |
| 588 { | |
| 589 Lisp_Object val = | |
| 590 (function_p ? XSYMBOL (sym)->function | |
| 591 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic)); | |
| 592 | |
| 593 if (SYMBOL_VALUE_MAGIC_P (val) && | |
| 594 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD) | |
| 563 | 595 invalid_change ("Use `set-specifier' to change a specifier's value", |
| 596 sym); | |
| 428 | 597 |
| 996 | 598 if ( |
| 599 #ifdef HAVE_SHLIB | |
| 600 !(unloading_module && UNBOUNDP(newval)) && | |
| 601 #endif | |
| 602 (symbol_is_constant (sym, val) | |
|
4793
8b50bee3c88c
Remove attempted support for 1996-era emacs without self-quoting keywords.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4677
diff
changeset
|
603 #ifndef NO_NEED_TO_HANDLE_21_4_CODE |
|
8b50bee3c88c
Remove attempted support for 1996-era emacs without self-quoting keywords.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4677
diff
changeset
|
604 || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)) |
|
8b50bee3c88c
Remove attempted support for 1996-era emacs without self-quoting keywords.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4677
diff
changeset
|
605 #endif |
|
8b50bee3c88c
Remove attempted support for 1996-era emacs without self-quoting keywords.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4677
diff
changeset
|
606 )) |
| 563 | 607 signal_error_1 (Qsetting_constant, |
| 608 UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval)); | |
| 428 | 609 } |
| 610 | |
| 611 /* Verify that it's ok to make SYM buffer-local. This rejects | |
| 612 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC | |
| 613 specifies whether we delve into symbol-value-lisp-magic objects. | |
| 614 (Should be a symbol indicating what action is being taken; that way, | |
| 615 we don't delve if there's a handler for that action, but do otherwise.) */ | |
| 616 | |
| 617 static void | |
| 618 verify_ok_for_buffer_local (Lisp_Object sym, | |
| 619 Lisp_Object follow_past_lisp_magic) | |
| 620 { | |
| 621 Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic); | |
| 622 | |
| 623 if (symbol_is_constant (sym, val)) | |
| 624 goto not_ok; | |
| 625 if (SYMBOL_VALUE_MAGIC_P (val)) | |
| 626 switch (XSYMBOL_VALUE_MAGIC_TYPE (val)) | |
| 627 { | |
| 628 case SYMVAL_DEFAULT_BUFFER_FORWARD: | |
| 629 case SYMVAL_DEFAULT_CONSOLE_FORWARD: | |
| 630 /* #### It's theoretically possible for it to be reasonable | |
| 631 to have both console-local and buffer-local variables, | |
| 632 but I don't want to consider that right now. */ | |
| 633 case SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 634 goto not_ok; | |
| 635 default: break; /* Warning suppression */ | |
| 636 } | |
| 637 | |
| 638 return; | |
| 639 | |
| 640 not_ok: | |
| 563 | 641 invalid_change ("Symbol may not be buffer-local", sym); |
| 428 | 642 } |
| 643 | |
| 644 DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /* | |
| 645 Make SYMBOL's value be void. | |
| 646 */ | |
| 647 (symbol)) | |
| 648 { | |
| 649 Fset (symbol, Qunbound); | |
| 650 return symbol; | |
| 651 } | |
| 652 | |
| 653 DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /* | |
| 654 Make SYMBOL's function definition be void. | |
| 655 */ | |
| 656 (symbol)) | |
| 657 { | |
| 658 CHECK_SYMBOL (symbol); | |
| 659 reject_constant_symbols (symbol, Qunbound, 1, Qt); | |
| 660 XSYMBOL (symbol)->function = Qunbound; | |
| 661 return symbol; | |
| 662 } | |
| 663 | |
| 664 DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /* | |
| 665 Return SYMBOL's function definition. Error if that is void. | |
| 666 */ | |
| 667 (symbol)) | |
| 668 { | |
| 669 CHECK_SYMBOL (symbol); | |
| 670 if (UNBOUNDP (XSYMBOL (symbol)->function)) | |
| 671 signal_void_function_error (symbol); | |
| 672 return XSYMBOL (symbol)->function; | |
| 673 } | |
| 674 | |
| 675 DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /* | |
| 676 Return SYMBOL's property list. | |
| 677 */ | |
| 678 (symbol)) | |
| 679 { | |
| 680 CHECK_SYMBOL (symbol); | |
| 681 return XSYMBOL (symbol)->plist; | |
| 682 } | |
| 683 | |
| 684 DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /* | |
| 685 Return SYMBOL's name, a string. | |
| 686 */ | |
| 687 (symbol)) | |
| 688 { | |
| 689 CHECK_SYMBOL (symbol); | |
| 793 | 690 return XSYMBOL (symbol)->name; |
| 428 | 691 } |
| 692 | |
| 693 DEFUN ("fset", Ffset, 2, 2, 0, /* | |
| 694 Set SYMBOL's function definition to NEWDEF, and return NEWDEF. | |
| 695 */ | |
| 696 (symbol, newdef)) | |
| 697 { | |
| 698 /* This function can GC */ | |
| 699 CHECK_SYMBOL (symbol); | |
| 700 reject_constant_symbols (symbol, newdef, 1, Qt); | |
| 701 if (!NILP (Vautoload_queue) && !UNBOUNDP (XSYMBOL (symbol)->function)) | |
| 702 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function), | |
| 703 Vautoload_queue); | |
| 704 XSYMBOL (symbol)->function = newdef; | |
| 705 /* Handle automatic advice activation */ | |
| 706 if (CONSP (XSYMBOL (symbol)->plist) && | |
| 707 !NILP (Fget (symbol, Qad_advice_info, Qnil))) | |
| 708 { | |
| 709 call2 (Qad_activate, symbol, Qnil); | |
| 710 newdef = XSYMBOL (symbol)->function; | |
| 711 } | |
| 712 return newdef; | |
| 713 } | |
| 714 | |
| 715 /* FSFmacs */ | |
| 716 DEFUN ("define-function", Fdefine_function, 2, 2, 0, /* | |
| 717 Set SYMBOL's function definition to NEWDEF, and return NEWDEF. | |
| 718 Associates the function with the current load file, if any. | |
| 719 */ | |
| 720 (symbol, newdef)) | |
| 721 { | |
| 722 /* This function can GC */ | |
| 723 Ffset (symbol, newdef); | |
|
4535
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4503
diff
changeset
|
724 LOADHIST_ATTACH (Fcons (Qdefun, symbol)); |
| 428 | 725 return newdef; |
| 726 } | |
| 727 | |
| 3368 | 728 DEFUN ("subr-name", Fsubr_name, 1, 1, 0, /* |
| 729 Return name of function SUBR. | |
| 730 SUBR must be a built-in function. | |
| 731 */ | |
| 732 (subr)) | |
| 733 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
734 const Ascbyte *name; |
| 3497 | 735 CHECK_SUBR (subr); |
| 736 | |
| 3368 | 737 name = XSUBR (subr)->name; |
| 3379 | 738 return make_string ((const Ibyte *)name, strlen (name)); |
| 3368 | 739 } |
| 428 | 740 |
|
4336
cdc2f70d4319
Provide #'special-form-p, for the use of advice.el, perhaps other files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3497
diff
changeset
|
741 DEFUN ("special-form-p", Fspecial_form_p, 1, 1, 0, /* |
|
4337
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
742 Return whether SUBR is a special form. |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
743 |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
744 A special form is a built-in function (a subr, that is a function |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
745 implemented in C, not Lisp) which does not necessarily evaluate all its |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
746 arguments. Much of the basic XEmacs Lisp syntax is implemented by means of |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
747 special forms; examples are `let', `condition-case', `defun', `setq' and so |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
748 on. |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
749 |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
750 If you intend to write a Lisp function that does not necessarily evaluate |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
751 all its arguments, the portable (across emacs variants, and across Lisp |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
752 implementations) way to go about it is to write a macro instead. See |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
753 `defmacro' and `backquote'. |
|
4336
cdc2f70d4319
Provide #'special-form-p, for the use of advice.el, perhaps other files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3497
diff
changeset
|
754 */ |
|
cdc2f70d4319
Provide #'special-form-p, for the use of advice.el, perhaps other files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3497
diff
changeset
|
755 (subr)) |
|
cdc2f70d4319
Provide #'special-form-p, for the use of advice.el, perhaps other files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3497
diff
changeset
|
756 { |
|
4337
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
757 subr = indirect_function (subr, 0); |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
758 return (SUBRP (subr) && XSUBR (subr)->max_args == UNEVALLED) ? Qt : Qnil; |
|
4336
cdc2f70d4319
Provide #'special-form-p, for the use of advice.el, perhaps other files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3497
diff
changeset
|
759 } |
|
cdc2f70d4319
Provide #'special-form-p, for the use of advice.el, perhaps other files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3497
diff
changeset
|
760 |
| 428 | 761 DEFUN ("setplist", Fsetplist, 2, 2, 0, /* |
| 762 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST. | |
| 763 */ | |
| 764 (symbol, newplist)) | |
| 765 { | |
| 766 CHECK_SYMBOL (symbol); | |
| 767 | |
| 768 XSYMBOL (symbol)->plist = newplist; | |
| 769 return newplist; | |
| 770 } | |
| 771 | |
| 772 | |
| 773 /**********************************************************************/ | |
| 774 /* symbol-value */ | |
| 775 /**********************************************************************/ | |
| 776 | |
|
4940
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
777 /* |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
778 NOTE NOTE NOTE: |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
779 --------------- |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
780 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
781 There are various different uses of "magic" with regard to symbols, |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
782 and they need to be distinguished: |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
783 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
784 1. `symbol-value-magic' class of objects (struct symbol_value_magic): |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
785 A set of Lisp object types used as the value of a variable with any |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
786 behavior other than just a plain repository of a value. This |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
787 includes buffer-local variables, console-local variables, read-only |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
788 variables, variable aliases, variables that are linked to a C |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
789 variable, etc. The more specific types are: |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
790 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
791 -- `symbol-value-forward': Variables that forward to a C variable. |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
792 NOTE:This includes built-in buffer-local and console-local |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
793 variables, since they forward to an element in a buffer or |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
794 console structure. |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
795 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
796 -- `symbol-value-buffer-local': Variables on which |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
797 `make-local-variable' or `make-variable-buffer-local' have |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
798 been called. |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
799 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
800 -- `symbol-value-lisp-magic': See below. |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
801 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
802 -- `symbol-value-varalias': Variable aliases. |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
803 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
804 2. `symbol-value-lisp-magic': Variables on which |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
805 `dontusethis-set-symbol-value-handler' have been called. These |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
806 variables are extra-magic in that operations that would normally |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
807 change their value instead get forwarded out to Lisp handlers, |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
808 which can do anything they want. (NOTE: Handlers for getting a |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
809 variable's value aren't implemented yet.) |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
810 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
811 3. "magicfun" handlers on C-forwarding variables, declared with any |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
812 of the following: |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
813 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
814 -- DEFVAR_LISP_MAGIC |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
815 -- DEFVAR_INT_MAGIC |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
816 -- DEFVAR_BOOL_MAGIC, |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
817 -- DEFVAR_BUFFER_LOCAL_MAGIC |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
818 -- DEFVAR_BUFFER_DEFAULTS_MAGIC |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
819 -- DEFVAR_CONSOLE_LOCAL_MAGIC |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
820 -- DEFVAR_CONSOLE_DEFAULTS_MAGIC |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
821 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
822 Here, the "magic function" is a handler that is notified whenever the |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
823 value of a variable is changed, so that some other updating can take |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
824 place (e.g. setting redisplay-related dirty bits, updating a cache, |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
825 etc.). |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
826 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
827 Note that DEFVAR_LISP_MAGIC does *NOT* have anything to do with |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
828 `symbol-value-lisp-magic'. The former refers to variables that can |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
829 hold an arbitrary Lisp object and forward to a C variable declared |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
830 `Lisp_Object foo', and have a "magicfun" as just described; the |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
831 latter are variables that have Lisp-level handlers that function |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
832 in *PLACE* of normal variable-setting mechanisms, and are established |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
833 with `dontusethis-set-symbol-value-handler', as described above. |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
834 */ |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
835 |
| 428 | 836 /* If the contents of the value cell of a symbol is one of the following |
| 837 three types of objects, then the symbol is "magic" in that setting | |
| 838 and retrieving its value doesn't just set or retrieve the raw | |
| 839 contents of the value cell. None of these objects can escape to | |
| 840 the user level, so there is no loss of generality. | |
| 841 | |
| 842 If a symbol is "unbound", then the contents of its value cell is | |
| 843 Qunbound. Despite appearances, this is *not* a symbol, but is a | |
| 844 symbol-value-forward object. This is so that printing it results | |
| 845 in "INTERNAL OBJECT (XEmacs bug?)", in case it leaks to Lisp, somehow. | |
| 846 | |
| 847 Logically all of the following objects are "symbol-value-magic" | |
| 848 objects, and there are some games played w.r.t. this (#### this | |
| 849 should be cleaned up). SYMBOL_VALUE_MAGIC_P is true for all of | |
| 850 the object types. XSYMBOL_VALUE_MAGIC_TYPE returns the type of | |
| 851 symbol-value-magic object. There are more than three types | |
| 852 returned by this macro: in particular, symbol-value-forward | |
| 853 has eight subtypes, and symbol-value-buffer-local has two. See | |
| 854 symeval.h. | |
| 855 | |
| 856 1. symbol-value-forward | |
| 857 | |
| 858 symbol-value-forward is used for variables whose actual contents | |
| 859 are stored in a C variable of some sort, and for Qunbound. The | |
| 860 lcheader.next field (which is only used to chain together free | |
| 861 lcrecords) holds a pointer to the actual C variable. Included | |
| 862 in this type are "buffer-local" variables that are actually | |
| 863 stored in the buffer object itself; in this case, the "pointer" | |
| 864 is an offset into the struct buffer structure. | |
| 865 | |
| 866 The subtypes are as follows: | |
| 867 | |
| 868 SYMVAL_OBJECT_FORWARD: | |
| 869 (declare with DEFVAR_LISP) | |
| 870 The value of this variable is stored in a C variable of type | |
| 871 "Lisp_Object". Setting this variable sets the C variable. | |
| 872 Accessing this variable retrieves a value from the C variable. | |
| 873 These variables can be buffer-local -- in this case, the | |
| 874 raw symbol-value field gets converted into a | |
| 875 symbol-value-buffer-local, whose "current_value" slot contains | |
| 876 the symbol-value-forward. (See below.) | |
| 877 | |
| 878 SYMVAL_FIXNUM_FORWARD: | |
| 458 | 879 (declare with DEFVAR_INT) |
| 880 Similar to SYMVAL_OBJECT_FORWARD except that the C variable | |
| 881 is of type "Fixnum", a typedef for "EMACS_INT", and the corresponding | |
| 882 lisp variable is always the corresponding integer. | |
| 883 | |
| 428 | 884 SYMVAL_BOOLEAN_FORWARD: |
| 458 | 885 (declare with DEFVAR_BOOL) |
| 428 | 886 Similar to SYMVAL_OBJECT_FORWARD except that the C variable |
| 458 | 887 is of type "int" and is a boolean. |
| 428 | 888 |
| 889 SYMVAL_CONST_OBJECT_FORWARD: | |
| 890 SYMVAL_CONST_FIXNUM_FORWARD: | |
| 891 SYMVAL_CONST_BOOLEAN_FORWARD: | |
| 892 (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or | |
| 893 DEFVAR_CONST_BOOL) | |
| 894 Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or | |
| 895 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot | |
| 896 be changed. | |
| 897 | |
| 898 SYMVAL_CONST_SPECIFIER_FORWARD: | |
| 899 (declare with DEFVAR_SPECIFIER) | |
| 440 | 900 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that the error |
| 901 message you get when attempting to set the value says to use | |
| 428 | 902 `set-specifier' instead. |
| 903 | |
| 904 SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 905 (declare with DEFVAR_BUFFER_LOCAL) | |
| 906 This is used for built-in buffer-local variables -- i.e. | |
| 907 Lisp variables whose value is stored in the "struct buffer". | |
| 908 Variables of this sort always forward into C "Lisp_Object" | |
| 909 fields (although there's no reason in principle that other | |
| 910 types for ints and booleans couldn't be added). Note that | |
| 911 some of these variables are automatically local in each | |
| 912 buffer, while some are only local when they become set | |
| 913 (similar to `make-variable-buffer-local'). In these latter | |
| 914 cases, of course, the default value shows through in all | |
| 915 buffers in which the variable doesn't have a local value. | |
| 916 This is implemented by making sure the "struct buffer" field | |
| 917 always contains the correct value (whether it's local or | |
| 918 a default) and maintaining a mask in the "struct buffer" | |
| 919 indicating which fields are local. When `set-default' is | |
| 920 called on a variable that's not always local to all buffers, | |
| 921 it loops through each buffer and sets the corresponding | |
| 922 field in each buffer without a local value for the field, | |
| 923 according to the mask. | |
| 924 | |
| 925 Calling `make-local-variable' on a variable of this sort | |
| 926 only has the effect of maybe changing the current buffer's mask. | |
| 927 Calling `make-variable-buffer-local' on a variable of this | |
| 928 sort has no effect at all. | |
| 929 | |
| 930 SYMVAL_CONST_CURRENT_BUFFER_FORWARD: | |
| 931 (declare with DEFVAR_CONST_BUFFER_LOCAL) | |
| 932 Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the | |
| 933 value cannot be set. | |
| 934 | |
| 935 SYMVAL_DEFAULT_BUFFER_FORWARD: | |
| 936 (declare with DEFVAR_BUFFER_DEFAULTS) | |
| 937 This is used for the Lisp variables that contain the | |
| 938 default values of built-in buffer-local variables. Setting | |
| 939 or referencing one of these variables forwards into a slot | |
| 940 in the special struct buffer Vbuffer_defaults. | |
| 941 | |
| 942 SYMVAL_UNBOUND_MARKER: | |
| 943 This is used for only one object, Qunbound. | |
| 944 | |
| 945 SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 946 (declare with DEFVAR_CONSOLE_LOCAL) | |
| 947 This is used for built-in console-local variables -- i.e. | |
| 948 Lisp variables whose value is stored in the "struct console". | |
| 949 These work just like built-in buffer-local variables. | |
| 950 However, calling `make-local-variable' or | |
| 951 `make-variable-buffer-local' on one of these variables | |
| 952 is currently disallowed because that would entail having | |
| 953 both console-local and buffer-local variables, which is | |
| 954 trickier to implement. | |
| 955 | |
| 956 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: | |
| 957 (declare with DEFVAR_CONST_CONSOLE_LOCAL) | |
| 958 Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the | |
| 959 value cannot be set. | |
| 960 | |
| 961 SYMVAL_DEFAULT_CONSOLE_FORWARD: | |
| 962 (declare with DEFVAR_CONSOLE_DEFAULTS) | |
| 963 This is used for the Lisp variables that contain the | |
| 964 default values of built-in console-local variables. Setting | |
| 965 or referencing one of these variables forwards into a slot | |
| 966 in the special struct console Vconsole_defaults. | |
| 967 | |
| 968 | |
| 969 2. symbol-value-buffer-local | |
| 970 | |
| 971 symbol-value-buffer-local is used for variables that have had | |
| 972 `make-local-variable' or `make-variable-buffer-local' applied | |
| 973 to them. This object contains an alist mapping buffers to | |
| 974 values. In addition, the object contains a "current value", | |
| 975 which is the value in some buffer. Whenever you access the | |
| 976 variable with `symbol-value' or set it with `set' or `setq', | |
| 977 things are switched around so that the "current value" | |
| 978 refers to the current buffer, if it wasn't already. This | |
| 979 way, repeated references to a variable in the same buffer | |
| 980 are almost as efficient as if the variable weren't buffer | |
| 981 local. Note that the alist may not be up-to-date w.r.t. | |
| 982 the buffer whose value is current, as the "current value" | |
| 983 cache is normally only flushed into the alist when the | |
| 984 buffer it refers to changes. | |
| 985 | |
| 986 Note also that it is possible for `make-local-variable' | |
| 987 or `make-variable-buffer-local' to be called on a variable | |
| 988 that forwards into a C variable (i.e. a variable whose | |
| 989 value cell is a symbol-value-forward). In this case, | |
| 990 the value cell becomes a symbol-value-buffer-local (as | |
| 991 always), and the symbol-value-forward moves into | |
| 992 the "current value" cell in this object. Also, in | |
| 993 this case the "current value" *always* refers to the | |
| 994 current buffer, so that the values of the C variable | |
| 995 always is the correct value for the current buffer. | |
| 996 set_buffer_internal() automatically updates the current-value | |
| 997 cells of all buffer-local variables that forward into C | |
| 998 variables. (There is a list of all buffer-local variables | |
| 999 that is maintained for this and other purposes.) | |
| 1000 | |
| 1001 Note that only certain types of `symbol-value-forward' objects | |
| 1002 can find their way into the "current value" cell of a | |
| 1003 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD, | |
| 1004 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and | |
| 1005 SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot | |
| 1006 be buffer-local because they are unsettable; | |
| 1007 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that | |
| 1008 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local | |
| 1009 does not have much of an effect (it's already buffer-local); and | |
| 1010 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because | |
| 1011 that's not currently implemented. | |
| 1012 | |
| 1013 | |
| 1014 3. symbol-value-varalias | |
| 1015 | |
| 1016 A symbol-value-varalias object is used for variables that | |
| 1017 are aliases for other variables. This object contains | |
| 1018 the symbol that this variable is aliased to. | |
| 1019 symbol-value-varalias objects cannot occur anywhere within | |
| 1020 a symbol-value-buffer-local object, and most of the | |
| 1021 low-level functions below do not accept them; you need | |
| 1022 to call follow_varalias_pointers to get the actual | |
| 1023 symbol to operate on. */ | |
| 1024 | |
| 1204 | 1025 static const struct memory_description symbol_value_buffer_local_description[] = { |
| 1026 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, default_value) }, | |
| 1027 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_value) }, | |
| 1028 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_buffer) }, | |
| 1029 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_alist_element) }, | |
| 1030 { XD_END } | |
| 1031 }; | |
| 1032 | |
| 428 | 1033 static Lisp_Object |
| 1034 mark_symbol_value_buffer_local (Lisp_Object obj) | |
| 1035 { | |
| 1036 struct symbol_value_buffer_local *bfwd; | |
| 1037 | |
| 800 | 1038 #ifdef ERROR_CHECK_TYPES |
| 428 | 1039 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL || |
| 1040 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL); | |
| 1041 #endif | |
| 1042 | |
| 1043 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj); | |
| 1044 mark_object (bfwd->default_value); | |
| 1045 mark_object (bfwd->current_value); | |
| 1046 mark_object (bfwd->current_buffer); | |
| 1047 return bfwd->current_alist_element; | |
| 1048 } | |
| 1049 | |
| 1204 | 1050 |
| 1051 static const struct memory_description symbol_value_lisp_magic_description[] = { | |
| 1052 { XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, handler), MAGIC_HANDLER_MAX }, | |
| 1053 { XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, harg), MAGIC_HANDLER_MAX }, | |
| 1054 { XD_LISP_OBJECT, offsetof (struct symbol_value_lisp_magic, shadowed) }, | |
| 1055 { XD_END } | |
| 1056 }; | |
| 1057 | |
| 428 | 1058 static Lisp_Object |
| 1059 mark_symbol_value_lisp_magic (Lisp_Object obj) | |
| 1060 { | |
| 1061 struct symbol_value_lisp_magic *bfwd; | |
| 1062 int i; | |
| 1063 | |
| 1064 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC); | |
| 1065 | |
| 1066 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj); | |
| 1067 for (i = 0; i < MAGIC_HANDLER_MAX; i++) | |
| 1068 { | |
| 1069 mark_object (bfwd->handler[i]); | |
| 1070 mark_object (bfwd->harg[i]); | |
| 1071 } | |
| 1072 return bfwd->shadowed; | |
| 1073 } | |
| 1074 | |
| 1204 | 1075 static const struct memory_description symbol_value_varalias_description[] = { |
| 1076 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, aliasee) }, | |
| 1077 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, shadowed) }, | |
| 1078 { XD_END } | |
| 1079 }; | |
| 1080 | |
| 428 | 1081 static Lisp_Object |
| 1082 mark_symbol_value_varalias (Lisp_Object obj) | |
| 1083 { | |
| 1084 struct symbol_value_varalias *bfwd; | |
| 1085 | |
| 1086 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS); | |
| 1087 | |
| 1088 bfwd = XSYMBOL_VALUE_VARALIAS (obj); | |
| 1089 mark_object (bfwd->shadowed); | |
| 1090 return bfwd->aliasee; | |
| 1091 } | |
| 1092 | |
| 1093 /* Should never, ever be called. (except by an external debugger) */ | |
| 1094 void | |
| 2286 | 1095 print_symbol_value_magic (Lisp_Object obj, Lisp_Object printcharfun, |
| 1096 int UNUSED (escapeflag)) | |
| 428 | 1097 { |
| 800 | 1098 write_fmt_string (printcharfun, |
| 1099 "#<INTERNAL OBJECT (XEmacs bug?) (%s type %d) 0x%lx>", | |
| 1100 XRECORD_LHEADER_IMPLEMENTATION (obj)->name, | |
| 1101 XSYMBOL_VALUE_MAGIC_TYPE (obj), | |
| 1102 (long) XPNTR (obj)); | |
| 428 | 1103 } |
| 1104 | |
| 1204 | 1105 static const struct memory_description symbol_value_forward_description[] = { |
| 428 | 1106 { XD_END } |
| 1107 }; | |
| 1108 | |
| 934 | 1109 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward", |
| 1110 symbol_value_forward, | |
| 1111 1, /*dumpable-flag*/ | |
| 1112 0, | |
| 1113 print_symbol_value_magic, 0, 0, 0, | |
| 1114 symbol_value_forward_description, | |
| 1115 struct symbol_value_forward); | |
| 1116 | |
| 1117 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local", | |
| 1118 symbol_value_buffer_local, | |
| 1119 1, /*dumpable-flag*/ | |
| 1120 mark_symbol_value_buffer_local, | |
| 1121 print_symbol_value_magic, 0, 0, 0, | |
| 1122 symbol_value_buffer_local_description, | |
| 1123 struct symbol_value_buffer_local); | |
| 1124 | |
| 1125 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic", | |
| 1126 symbol_value_lisp_magic, | |
| 1127 1, /*dumpable-flag*/ | |
| 1128 mark_symbol_value_lisp_magic, | |
| 1129 print_symbol_value_magic, 0, 0, 0, | |
| 1130 symbol_value_lisp_magic_description, | |
| 1131 struct symbol_value_lisp_magic); | |
| 1132 | |
| 1133 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias", | |
| 1134 symbol_value_varalias, | |
| 1135 1, /*dumpable-flag*/ | |
| 1136 mark_symbol_value_varalias, | |
| 1137 print_symbol_value_magic, 0, 0, 0, | |
| 1138 symbol_value_varalias_description, | |
| 1139 struct symbol_value_varalias); | |
| 1140 | |
| 428 | 1141 |
| 1142 /* Getting and setting values of symbols */ | |
| 1143 | |
| 1144 /* Given the raw contents of a symbol value cell, return the Lisp value of | |
| 1145 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local, | |
| 1146 symbol-value-lisp-magic, or symbol-value-varalias. | |
| 1147 | |
| 1148 BUFFER specifies a buffer, and is used for built-in buffer-local | |
| 1149 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD. | |
| 1150 Note that such variables are never encapsulated in a | |
| 1151 symbol-value-buffer-local structure. | |
| 1152 | |
| 1153 CONSOLE specifies a console, and is used for built-in console-local | |
| 1154 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD. | |
| 1155 Note that such variables are (currently) never encapsulated in a | |
| 1156 symbol-value-buffer-local structure. | |
| 1157 */ | |
| 1158 | |
| 1159 static Lisp_Object | |
| 1160 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer, | |
| 1161 struct console *console) | |
| 1162 { | |
| 442 | 1163 const struct symbol_value_forward *fwd; |
| 428 | 1164 |
| 1165 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 1166 return valcontents; | |
| 1167 | |
| 1168 fwd = XSYMBOL_VALUE_FORWARD (valcontents); | |
| 1169 switch (fwd->magic.type) | |
| 1170 { | |
| 1171 case SYMVAL_FIXNUM_FORWARD: | |
| 1172 case SYMVAL_CONST_FIXNUM_FORWARD: | |
| 458 | 1173 return make_int (*((Fixnum *)symbol_value_forward_forward (fwd))); |
| 428 | 1174 |
| 1175 case SYMVAL_BOOLEAN_FORWARD: | |
| 1176 case SYMVAL_CONST_BOOLEAN_FORWARD: | |
| 1177 return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil; | |
| 1178 | |
| 1179 case SYMVAL_OBJECT_FORWARD: | |
| 1180 case SYMVAL_CONST_OBJECT_FORWARD: | |
| 1181 case SYMVAL_CONST_SPECIFIER_FORWARD: | |
| 1182 return *((Lisp_Object *)symbol_value_forward_forward (fwd)); | |
| 1183 | |
| 1184 case SYMVAL_DEFAULT_BUFFER_FORWARD: | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1185 return (*((Lisp_Object *)((Rawbyte *) XBUFFER (Vbuffer_defaults) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1186 + ((Rawbyte *)symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1187 - (Rawbyte *)&buffer_local_flags)))); |
| 428 | 1188 |
| 1189 | |
| 1190 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 1191 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: | |
| 1192 assert (buffer); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1193 return (*((Lisp_Object *)((Rawbyte *)buffer |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1194 + ((Rawbyte *)symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1195 - (Rawbyte *)&buffer_local_flags)))); |
| 428 | 1196 |
| 1197 case SYMVAL_DEFAULT_CONSOLE_FORWARD: | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1198 return (*((Lisp_Object *)((Rawbyte *) XCONSOLE (Vconsole_defaults) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1199 + ((Rawbyte *)symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1200 - (Rawbyte *)&console_local_flags)))); |
| 428 | 1201 |
| 1202 case SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 1203 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: | |
| 1204 assert (console); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1205 return (*((Lisp_Object *)((Rawbyte *)console |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1206 + ((Rawbyte *)symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1207 - (Rawbyte *)&console_local_flags)))); |
| 428 | 1208 |
| 1209 case SYMVAL_UNBOUND_MARKER: | |
| 1210 return valcontents; | |
| 1211 | |
| 1212 default: | |
| 2500 | 1213 ABORT (); |
| 428 | 1214 } |
| 1215 return Qnil; /* suppress compiler warning */ | |
| 1216 } | |
| 1217 | |
| 1218 /* Set the value of default-buffer-local variable SYM to VALUE. */ | |
| 1219 | |
| 1220 static void | |
| 1221 set_default_buffer_slot_variable (Lisp_Object sym, | |
| 1222 Lisp_Object value) | |
| 1223 { | |
| 1224 /* Handle variables like case-fold-search that have special slots in | |
| 1225 the buffer. Make them work apparently like buffer_local variables. | |
| 1226 */ | |
| 1227 /* At this point, the value cell may not contain a symbol-value-varalias | |
| 1228 or symbol-value-buffer-local, and if there's a handler, we should | |
| 1229 have already called it. */ | |
| 1230 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt); | |
| 442 | 1231 const struct symbol_value_forward *fwd |
| 428 | 1232 = XSYMBOL_VALUE_FORWARD (valcontents); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1233 int offset = ((Rawbyte *) symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1234 - (Rawbyte *) &buffer_local_flags); |
| 428 | 1235 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); |
| 1236 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object, | |
| 1237 int flags) = symbol_value_forward_magicfun (fwd); | |
| 1238 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1239 *((Lisp_Object *) (offset + (Rawbyte *) XBUFFER (Vbuffer_defaults))) |
| 428 | 1240 = value; |
| 1241 | |
| 1242 if (mask > 0) /* Not always per-buffer */ | |
| 1243 { | |
| 1244 /* Set value in each buffer which hasn't shadowed the default */ | |
| 1245 LIST_LOOP_2 (elt, Vbuffer_alist) | |
| 1246 { | |
| 1247 struct buffer *b = XBUFFER (XCDR (elt)); | |
| 1248 if (!(b->local_var_flags & mask)) | |
| 1249 { | |
| 1250 if (magicfun) | |
| 771 | 1251 magicfun (sym, &value, wrap_buffer (b), 0); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1252 *((Lisp_Object *) (offset + (Rawbyte *) b)) = value; |
| 428 | 1253 } |
| 1254 } | |
| 1255 } | |
| 1256 } | |
| 1257 | |
| 1258 /* Set the value of default-console-local variable SYM to VALUE. */ | |
| 1259 | |
| 1260 static void | |
| 1261 set_default_console_slot_variable (Lisp_Object sym, | |
| 1262 Lisp_Object value) | |
| 1263 { | |
| 1264 /* Handle variables like case-fold-search that have special slots in | |
| 1265 the console. Make them work apparently like console_local variables. | |
| 1266 */ | |
| 1267 /* At this point, the value cell may not contain a symbol-value-varalias | |
| 1268 or symbol-value-buffer-local, and if there's a handler, we should | |
| 1269 have already called it. */ | |
| 1270 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt); | |
| 442 | 1271 const struct symbol_value_forward *fwd |
| 428 | 1272 = XSYMBOL_VALUE_FORWARD (valcontents); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1273 int offset = ((Rawbyte *) symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1274 - (Rawbyte *) &console_local_flags); |
| 428 | 1275 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); |
| 1276 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object, | |
| 1277 int flags) = symbol_value_forward_magicfun (fwd); | |
| 1278 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1279 *((Lisp_Object *) (offset + (Rawbyte *) XCONSOLE (Vconsole_defaults))) |
| 428 | 1280 = value; |
| 1281 | |
| 1282 if (mask > 0) /* Not always per-console */ | |
| 1283 { | |
| 1284 /* Set value in each console which hasn't shadowed the default */ | |
| 1285 LIST_LOOP_2 (console, Vconsole_list) | |
| 1286 { | |
| 1287 struct console *d = XCONSOLE (console); | |
| 1288 if (!(d->local_var_flags & mask)) | |
| 1289 { | |
| 1290 if (magicfun) | |
| 1291 magicfun (sym, &value, console, 0); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1292 *((Lisp_Object *) (offset + (Rawbyte *) d)) = value; |
| 428 | 1293 } |
| 1294 } | |
| 1295 } | |
| 1296 } | |
| 1297 | |
| 1298 /* Store NEWVAL into SYM. | |
| 1299 | |
| 1300 SYM's value slot may *not* be types (5) or (6) above, | |
| 1301 i.e. no symbol-value-varalias objects. (You should have | |
| 1302 forwarded past all of these.) | |
| 1303 | |
| 1304 SYM should not be an unsettable symbol or a symbol with | |
| 1305 a magic `set-value' handler (unless you want to explicitly | |
| 1306 ignore this handler). | |
| 1307 | |
| 1308 OVALUE is the current value of SYM, but forwarded past any | |
| 1309 symbol-value-buffer-local and symbol-value-lisp-magic objects. | |
| 1310 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be | |
| 1311 the contents of its current-value cell.) NEWVAL may only be | |
| 1312 a simple value or Qunbound. If SYM is a symbol-value-buffer-local, | |
| 1313 this function will only modify its current-value cell, which should | |
| 1314 already be set up to point to the current buffer. | |
| 1315 */ | |
| 1316 | |
| 1317 static void | |
| 1318 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue, | |
| 1319 Lisp_Object newval) | |
| 1320 { | |
| 1321 if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue)) | |
| 1322 { | |
| 1323 Lisp_Object *store_pointer = value_slot_past_magic (sym); | |
| 1324 | |
| 1325 if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer)) | |
| 1326 store_pointer = | |
| 1327 &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value; | |
| 1328 | |
| 1329 assert (UNBOUNDP (*store_pointer) | |
| 1330 || !SYMBOL_VALUE_MAGIC_P (*store_pointer)); | |
| 1331 *store_pointer = newval; | |
| 1332 } | |
| 1333 else | |
| 1334 { | |
| 442 | 1335 const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue); |
| 428 | 1336 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, |
| 1337 Lisp_Object in_object, int flags) | |
| 1338 = symbol_value_forward_magicfun (fwd); | |
| 1339 | |
| 1340 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue)) | |
| 1341 { | |
| 1342 case SYMVAL_FIXNUM_FORWARD: | |
| 1343 CHECK_INT (newval); | |
| 1344 if (magicfun) | |
| 1345 magicfun (sym, &newval, Qnil, 0); | |
| 458 | 1346 *((Fixnum *) symbol_value_forward_forward (fwd)) = XINT (newval); |
| 428 | 1347 return; |
| 1348 | |
| 1349 case SYMVAL_BOOLEAN_FORWARD: | |
| 1350 if (magicfun) | |
| 1351 magicfun (sym, &newval, Qnil, 0); | |
| 1352 *((int *) symbol_value_forward_forward (fwd)) | |
| 1353 = !NILP (newval); | |
| 1354 return; | |
| 1355 | |
| 1356 case SYMVAL_OBJECT_FORWARD: | |
| 1357 if (magicfun) | |
| 1358 magicfun (sym, &newval, Qnil, 0); | |
| 1359 *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval; | |
| 1360 return; | |
| 1361 | |
| 1362 case SYMVAL_DEFAULT_BUFFER_FORWARD: | |
| 1363 set_default_buffer_slot_variable (sym, newval); | |
| 1364 return; | |
| 1365 | |
| 1366 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 1367 if (magicfun) | |
| 771 | 1368 magicfun (sym, &newval, wrap_buffer (current_buffer), 0); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1369 *((Lisp_Object *) ((Rawbyte *) current_buffer |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1370 + ((Rawbyte *) symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1371 - (Rawbyte *) &buffer_local_flags))) |
| 428 | 1372 = newval; |
| 1373 return; | |
| 1374 | |
| 1375 case SYMVAL_DEFAULT_CONSOLE_FORWARD: | |
| 1376 set_default_console_slot_variable (sym, newval); | |
| 1377 return; | |
| 1378 | |
| 1379 case SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 1380 if (magicfun) | |
| 1381 magicfun (sym, &newval, Vselected_console, 0); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1382 *((Lisp_Object *) ((Rawbyte *) XCONSOLE (Vselected_console) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1383 + ((Rawbyte *) symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1384 - (Rawbyte *) &console_local_flags))) |
| 428 | 1385 = newval; |
| 1386 return; | |
| 1387 | |
| 1388 default: | |
| 2500 | 1389 ABORT (); |
| 428 | 1390 } |
| 1391 } | |
| 1392 } | |
| 1393 | |
| 1394 /* Given a per-buffer variable SYMBOL and its raw value-cell contents | |
| 1395 BFWD, locate and return a pointer to the element in BUFFER's | |
| 1396 local_var_alist for SYMBOL. The return value will be Qnil if | |
| 1397 BUFFER does not have its own value for SYMBOL (i.e. the default | |
| 1398 value is seen in that buffer). | |
| 1399 */ | |
| 1400 | |
| 1401 static Lisp_Object | |
| 1402 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol, | |
| 1403 struct symbol_value_buffer_local *bfwd) | |
| 1404 { | |
| 1405 if (!NILP (bfwd->current_buffer) && | |
| 1406 XBUFFER (bfwd->current_buffer) == buffer) | |
| 1407 /* This is just an optimization of the below. */ | |
| 1408 return bfwd->current_alist_element; | |
| 1409 else | |
| 1410 return assq_no_quit (symbol, buffer->local_var_alist); | |
| 1411 } | |
| 1412 | |
| 1413 /* [Remember that the slot that mirrors CURRENT-VALUE in the | |
| 1414 symbol-value-buffer-local of a per-buffer variable -- i.e. the | |
| 1415 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE | |
| 1416 slot -- may be out of date.] | |
| 1417 | |
| 1418 Write out any cached value in buffer-local variable SYMBOL's | |
| 1419 buffer-local structure, which is passed in as BFWD. | |
| 1420 */ | |
| 1421 | |
| 1422 static void | |
| 2286 | 1423 write_out_buffer_local_cache (Lisp_Object UNUSED (symbol), |
| 428 | 1424 struct symbol_value_buffer_local *bfwd) |
| 1425 { | |
| 1426 if (!NILP (bfwd->current_buffer)) | |
| 1427 { | |
| 1428 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD | |
| 1429 uses it, and that type cannot be inside a symbol-value-buffer-local */ | |
| 1430 Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0); | |
| 1431 if (NILP (bfwd->current_alist_element)) | |
| 1432 /* current_value may be updated more recently than default_value */ | |
| 1433 bfwd->default_value = cval; | |
| 1434 else | |
| 1435 Fsetcdr (bfwd->current_alist_element, cval); | |
| 1436 } | |
| 1437 } | |
| 1438 | |
| 1439 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure. | |
| 1440 Set up BFWD's cache for validity in buffer BUF. This assumes that | |
| 1441 the cache is currently in a consistent state (this can include | |
| 1442 not having any value cached, if BFWD->CURRENT_BUFFER is nil). | |
| 1443 | |
| 1444 If the cache is already set up for BUF, this function does nothing | |
| 1445 at all. | |
| 1446 | |
| 1447 Otherwise, if SYM forwards out to a C variable, this also forwards | |
| 1448 SYM's value in BUF out to the variable. Therefore, you generally | |
| 1449 only want to call this when BUF is, or is about to become, the | |
| 1450 current buffer. | |
| 1451 | |
| 1452 (Otherwise, you can just retrieve the value without changing the | |
| 1453 cache, at the expense of slower retrieval.) | |
| 1454 */ | |
| 1455 | |
| 1456 static void | |
| 1457 set_up_buffer_local_cache (Lisp_Object sym, | |
| 1458 struct symbol_value_buffer_local *bfwd, | |
| 1459 struct buffer *buf, | |
| 1460 Lisp_Object new_alist_el, | |
| 1461 int set_it_p) | |
| 1462 { | |
| 1463 Lisp_Object new_val; | |
| 1464 | |
| 1465 if (!NILP (bfwd->current_buffer) | |
| 1466 && buf == XBUFFER (bfwd->current_buffer)) | |
| 1467 /* Cache is already set up. */ | |
| 1468 return; | |
| 1469 | |
| 1470 /* Flush out the old cache. */ | |
| 1471 write_out_buffer_local_cache (sym, bfwd); | |
| 1472 | |
| 1473 /* Retrieve the new alist element and new value. */ | |
| 1474 if (NILP (new_alist_el) | |
| 1475 && set_it_p) | |
| 1476 new_alist_el = buffer_local_alist_element (buf, sym, bfwd); | |
| 1477 | |
| 1478 if (NILP (new_alist_el)) | |
| 1479 new_val = bfwd->default_value; | |
| 1480 else | |
| 1481 new_val = Fcdr (new_alist_el); | |
| 1482 | |
| 1483 bfwd->current_alist_element = new_alist_el; | |
| 793 | 1484 bfwd->current_buffer = wrap_buffer (buf); |
| 428 | 1485 |
| 1486 /* Now store the value into the current-value slot. | |
| 1487 We don't simply write it there, because the current-value | |
| 1488 slot might be a forwarding pointer, in which case we need | |
| 1489 to instead write the value into the C variable. | |
| 1490 | |
| 1491 We might also want to call a magic function. | |
| 1492 | |
| 1493 So instead, we call this function. */ | |
| 1494 store_symval_forwarding (sym, bfwd->current_value, new_val); | |
| 1495 } | |
| 1496 | |
| 446 | 1497 |
| 1498 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure. | |
| 1499 Flush the cache. BFWD->CURRENT_BUFFER will be nil after this operation. | |
| 1500 */ | |
| 1501 | |
| 1502 static void | |
| 1503 flush_buffer_local_cache (Lisp_Object sym, | |
| 1504 struct symbol_value_buffer_local *bfwd) | |
| 1505 { | |
| 1506 if (NILP (bfwd->current_buffer)) | |
| 1507 /* Cache is already flushed. */ | |
| 1508 return; | |
| 1509 | |
| 1510 /* Flush out the old cache. */ | |
| 1511 write_out_buffer_local_cache (sym, bfwd); | |
| 1512 | |
| 1513 bfwd->current_alist_element = Qnil; | |
| 1514 bfwd->current_buffer = Qnil; | |
| 1515 | |
| 1516 /* Now store default the value into the current-value slot. | |
| 1517 We don't simply write it there, because the current-value | |
| 1518 slot might be a forwarding pointer, in which case we need | |
| 1519 to instead write the value into the C variable. | |
| 1520 | |
| 1521 We might also want to call a magic function. | |
| 1522 | |
| 1523 So instead, we call this function. */ | |
| 1524 store_symval_forwarding (sym, bfwd->current_value, bfwd->default_value); | |
| 1525 } | |
| 1526 | |
| 1527 /* Flush all the buffer-local variable caches. Whoever has a | |
| 1528 non-interned buffer-local variable will be spanked. Whoever has a | |
| 1529 magic variable that interns or uninterns symbols... I don't even | |
| 1530 want to think about it. | |
| 1531 */ | |
| 1532 | |
| 1533 void | |
| 1534 flush_all_buffer_local_cache (void) | |
| 1535 { | |
| 1536 Lisp_Object *syms = XVECTOR_DATA (Vobarray); | |
| 1537 long count = XVECTOR_LENGTH (Vobarray); | |
| 1538 long i; | |
| 1539 | |
| 1540 for (i=0; i<count; i++) | |
| 1541 { | |
| 1542 Lisp_Object sym = syms[i]; | |
| 1543 Lisp_Object value; | |
| 1544 | |
| 1545 if (!ZEROP (sym)) | |
| 1546 for(;;) | |
| 1547 { | |
| 1548 Lisp_Symbol *next; | |
| 1549 assert (SYMBOLP (sym)); | |
| 1550 value = fetch_value_maybe_past_magic (sym, Qt); | |
| 1551 if (SYMBOL_VALUE_BUFFER_LOCAL_P (value)) | |
| 1552 flush_buffer_local_cache (sym, XSYMBOL_VALUE_BUFFER_LOCAL (value)); | |
| 1553 | |
| 1554 next = symbol_next (XSYMBOL (sym)); | |
| 1555 if (!next) | |
| 1556 break; | |
| 793 | 1557 sym = wrap_symbol (next); |
| 446 | 1558 } |
| 1559 } | |
| 1560 } | |
| 1561 | |
| 428 | 1562 |
| 1563 void | |
| 1564 kill_buffer_local_variables (struct buffer *buf) | |
| 1565 { | |
| 1566 Lisp_Object prev = Qnil; | |
| 1567 Lisp_Object alist; | |
| 1568 | |
| 1569 /* Any which are supposed to be permanent, | |
| 1570 make local again, with the same values they had. */ | |
| 1571 | |
| 1572 for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist)) | |
| 1573 { | |
| 1574 Lisp_Object sym = XCAR (XCAR (alist)); | |
| 1575 struct symbol_value_buffer_local *bfwd; | |
| 1576 /* Variables with a symbol-value-varalias should not be here | |
| 1577 (we should have forwarded past them) and there must be a | |
| 1578 symbol-value-buffer-local. If there's a symbol-value-lisp-magic, | |
| 1579 just forward past it; if the variable has a handler, it was | |
| 1580 already called. */ | |
| 1581 Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt); | |
| 1582 | |
| 1583 assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value)); | |
| 1584 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value); | |
| 1585 | |
| 1586 if (!NILP (Fget (sym, Qpermanent_local, Qnil))) | |
| 1587 /* prev points to the last alist element that is still | |
| 1588 staying around, so *only* update it now. This didn't | |
| 1589 used to be the case; this bug has been around since | |
| 1590 mly's rewrite two years ago! */ | |
| 1591 prev = alist; | |
| 1592 else | |
| 1593 { | |
| 1594 /* Really truly kill it. */ | |
| 1595 if (!NILP (prev)) | |
| 1596 XCDR (prev) = XCDR (alist); | |
| 1597 else | |
| 1598 buf->local_var_alist = XCDR (alist); | |
| 1599 | |
| 1600 /* We just effectively changed the value for this variable | |
| 1601 in BUF. So: */ | |
| 1602 | |
| 1603 /* (1) If the cache is caching BUF, invalidate the cache. */ | |
| 1604 if (!NILP (bfwd->current_buffer) && | |
| 1605 buf == XBUFFER (bfwd->current_buffer)) | |
| 1606 bfwd->current_buffer = Qnil; | |
| 1607 | |
| 1608 /* (2) If we changed the value in current_buffer and this | |
| 1609 variable forwards to a C variable, we need to change the | |
| 1610 value of the C variable. set_up_buffer_local_cache() | |
| 1611 will do this. It doesn't hurt to do it whenever | |
| 1612 BUF == current_buffer, so just go ahead and do that. */ | |
| 1613 if (buf == current_buffer) | |
| 1614 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0); | |
| 1615 } | |
| 1616 } | |
| 1617 } | |
| 1618 | |
| 1619 static Lisp_Object | |
| 1620 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf, | |
| 1621 struct console *con, int swap_it_in, | |
| 1622 Lisp_Object symcons, int set_it_p) | |
| 1623 { | |
| 1624 Lisp_Object valcontents; | |
| 1625 | |
| 1626 retry: | |
| 1627 valcontents = XSYMBOL (sym)->value; | |
| 1628 | |
| 1629 retry_2: | |
| 1630 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 1631 return valcontents; | |
| 1632 | |
| 1633 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 1634 { | |
| 1635 case SYMVAL_LISP_MAGIC: | |
| 1636 /* #### kludge */ | |
| 1637 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 1638 /* semi-change-o */ | |
| 1639 goto retry_2; | |
| 1640 | |
| 1641 case SYMVAL_VARALIAS: | |
| 1642 sym = follow_varalias_pointers (sym, Qt /* #### kludge */); | |
| 1643 symcons = Qnil; | |
| 1644 /* presto change-o! */ | |
| 1645 goto retry; | |
| 1646 | |
| 1647 case SYMVAL_BUFFER_LOCAL: | |
| 1648 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 1649 { | |
| 1650 struct symbol_value_buffer_local *bfwd | |
| 1651 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 1652 | |
| 1653 if (swap_it_in) | |
| 1654 { | |
| 1655 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p); | |
| 1656 valcontents = bfwd->current_value; | |
| 1657 } | |
| 1658 else | |
| 1659 { | |
| 1660 if (!NILP (bfwd->current_buffer) && | |
| 1661 buf == XBUFFER (bfwd->current_buffer)) | |
| 1662 valcontents = bfwd->current_value; | |
| 1663 else if (NILP (symcons)) | |
| 1664 { | |
| 1665 if (set_it_p) | |
| 1666 valcontents = assq_no_quit (sym, buf->local_var_alist); | |
| 1667 if (NILP (valcontents)) | |
| 1668 valcontents = bfwd->default_value; | |
| 1669 else | |
| 1670 valcontents = XCDR (valcontents); | |
| 1671 } | |
| 1672 else | |
| 1673 valcontents = XCDR (symcons); | |
| 1674 } | |
| 1675 break; | |
| 1676 } | |
| 1677 | |
| 1678 default: | |
| 1679 break; | |
| 1680 } | |
| 1681 return do_symval_forwarding (valcontents, buf, con); | |
| 1682 } | |
| 1683 | |
| 1684 | |
| 1685 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not | |
| 1686 bound. Note that it must not be possible to QUIT within this | |
| 1687 function. */ | |
| 1688 | |
| 1689 Lisp_Object | |
| 1690 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer) | |
| 1691 { | |
| 1692 struct buffer *buf; | |
| 1693 | |
| 1694 CHECK_SYMBOL (sym); | |
| 1695 | |
| 1696 if (NILP (buffer)) | |
| 1697 buf = current_buffer; | |
| 1698 else | |
| 1699 { | |
| 1700 CHECK_BUFFER (buffer); | |
| 1701 buf = XBUFFER (buffer); | |
| 1702 } | |
| 1703 | |
| 1704 return find_symbol_value_1 (sym, buf, | |
| 1705 /* If it bombs out at startup due to a | |
| 1706 Lisp error, this may be nil. */ | |
| 1707 CONSOLEP (Vselected_console) | |
| 1708 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1); | |
| 1709 } | |
| 1710 | |
| 1711 static Lisp_Object | |
| 1712 symbol_value_in_console (Lisp_Object sym, Lisp_Object console) | |
| 1713 { | |
| 1714 CHECK_SYMBOL (sym); | |
| 1715 | |
| 1716 if (NILP (console)) | |
| 1717 console = Vselected_console; | |
| 1718 else | |
| 1719 CHECK_CONSOLE (console); | |
| 1720 | |
| 1721 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0, | |
| 1722 Qnil, 1); | |
| 1723 } | |
| 1724 | |
| 1725 /* Return the current value of SYM. The difference between this function | |
| 1726 and calling symbol_value_in_buffer with a BUFFER of Qnil is that | |
| 1727 this updates the CURRENT_VALUE slot of buffer-local variables to | |
| 1728 point to the current buffer, while symbol_value_in_buffer doesn't. */ | |
| 1729 | |
| 1730 Lisp_Object | |
| 1731 find_symbol_value (Lisp_Object sym) | |
| 1732 { | |
| 1733 /* WARNING: This function can be called when current_buffer is 0 | |
| 1734 and Vselected_console is Qnil, early in initialization. */ | |
| 1735 struct console *con; | |
| 1736 Lisp_Object valcontents; | |
| 1737 | |
| 1738 CHECK_SYMBOL (sym); | |
| 1739 | |
| 1740 valcontents = XSYMBOL (sym)->value; | |
| 1741 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 1742 return valcontents; | |
| 1743 | |
| 1744 if (CONSOLEP (Vselected_console)) | |
| 1745 con = XCONSOLE (Vselected_console); | |
| 1746 else | |
| 1747 { | |
| 1748 /* This can also get called while we're preparing to shutdown. | |
| 1749 #### What should really happen in that case? Should we | |
| 1750 actually fix things so we can't get here in that case? */ | |
| 1751 #ifndef PDUMP | |
| 1752 assert (!initialized || preparing_for_armageddon); | |
| 1753 #endif | |
| 1754 con = 0; | |
| 1755 } | |
| 1756 | |
| 1757 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1); | |
| 1758 } | |
| 1759 | |
| 1760 /* This is an optimized function for quick lookup of buffer local symbols | |
| 1761 by avoiding O(n) search. This will work when either: | |
| 1762 a) We have already found the symbol e.g. by traversing local_var_alist. | |
| 1763 or | |
| 1764 b) We know that the symbol will not be found in the current buffer's | |
| 1765 list of local variables. | |
| 1766 In the former case, find_it_p is 1 and symbol_cons is the element from | |
| 1767 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons | |
| 1768 is the symbol. | |
| 1769 | |
| 1770 This function is called from set_buffer_internal which does both of these | |
| 1771 things. */ | |
| 1772 | |
| 1773 Lisp_Object | |
| 1774 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p) | |
| 1775 { | |
| 1776 /* WARNING: This function can be called when current_buffer is 0 | |
| 1777 and Vselected_console is Qnil, early in initialization. */ | |
| 1778 struct console *con; | |
| 1779 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons; | |
| 1780 | |
| 1781 CHECK_SYMBOL (sym); | |
| 1782 if (CONSOLEP (Vselected_console)) | |
| 1783 con = XCONSOLE (Vselected_console); | |
| 1784 else | |
| 1785 { | |
| 1786 /* This can also get called while we're preparing to shutdown. | |
| 1787 #### What should really happen in that case? Should we | |
| 1788 actually fix things so we can't get here in that case? */ | |
| 1789 #ifndef PDUMP | |
| 1790 assert (!initialized || preparing_for_armageddon); | |
| 1791 #endif | |
| 1792 con = 0; | |
| 1793 } | |
| 1794 | |
| 1795 return find_symbol_value_1 (sym, current_buffer, con, 1, | |
| 1796 find_it_p ? symbol_cons : Qnil, | |
| 1797 find_it_p); | |
| 1798 } | |
| 1799 | |
| 1800 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /* | |
| 1801 Return SYMBOL's value. Error if that is void. | |
| 1802 */ | |
| 1803 (symbol)) | |
| 1804 { | |
| 1805 Lisp_Object val = find_symbol_value (symbol); | |
| 1806 | |
| 1807 if (UNBOUNDP (val)) | |
| 1808 return Fsignal (Qvoid_variable, list1 (symbol)); | |
| 1809 else | |
| 1810 return val; | |
| 1811 } | |
| 1812 | |
| 1813 DEFUN ("set", Fset, 2, 2, 0, /* | |
| 1814 Set SYMBOL's value to NEWVAL, and return NEWVAL. | |
| 1815 */ | |
| 1816 (symbol, newval)) | |
| 1817 { | |
| 1818 REGISTER Lisp_Object valcontents; | |
| 440 | 1819 Lisp_Symbol *sym; |
| 428 | 1820 /* remember, we're called by Fmakunbound() as well */ |
| 1821 | |
| 1822 CHECK_SYMBOL (symbol); | |
| 1823 | |
| 1824 retry: | |
| 1825 sym = XSYMBOL (symbol); | |
| 1826 valcontents = sym->value; | |
| 1827 | |
| 1828 if (EQ (symbol, Qnil) || | |
| 1829 EQ (symbol, Qt) || | |
| 1830 SYMBOL_IS_KEYWORD (symbol)) | |
| 1831 reject_constant_symbols (symbol, newval, 0, | |
| 1832 UNBOUNDP (newval) ? Qmakunbound : Qset); | |
| 1833 | |
| 1834 if (!SYMBOL_VALUE_MAGIC_P (valcontents) || UNBOUNDP (valcontents)) | |
| 1835 { | |
| 1836 sym->value = newval; | |
| 1837 return newval; | |
| 1838 } | |
| 1839 | |
| 1840 reject_constant_symbols (symbol, newval, 0, | |
| 1841 UNBOUNDP (newval) ? Qmakunbound : Qset); | |
| 1842 | |
| 1843 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 1844 { | |
| 1845 case SYMVAL_LISP_MAGIC: | |
| 1846 { | |
| 1847 if (UNBOUNDP (newval)) | |
| 440 | 1848 { |
| 1849 maybe_call_magic_handler (symbol, Qmakunbound, 0); | |
| 1850 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = Qunbound; | |
| 1851 } | |
| 428 | 1852 else |
| 440 | 1853 { |
| 1854 maybe_call_magic_handler (symbol, Qset, 1, newval); | |
| 1855 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = newval; | |
| 1856 } | |
| 428 | 1857 } |
| 1858 | |
| 1859 case SYMVAL_VARALIAS: | |
| 1860 symbol = follow_varalias_pointers (symbol, | |
| 1861 UNBOUNDP (newval) | |
| 1862 ? Qmakunbound : Qset); | |
| 1863 /* presto change-o! */ | |
| 1864 goto retry; | |
| 1865 | |
| 1866 case SYMVAL_FIXNUM_FORWARD: | |
| 996 | 1867 case SYMVAL_CONST_FIXNUM_FORWARD: |
| 428 | 1868 case SYMVAL_BOOLEAN_FORWARD: |
| 996 | 1869 case SYMVAL_CONST_BOOLEAN_FORWARD: |
| 428 | 1870 case SYMVAL_DEFAULT_BUFFER_FORWARD: |
| 1871 case SYMVAL_DEFAULT_CONSOLE_FORWARD: | |
| 1872 if (UNBOUNDP (newval)) | |
| 996 | 1873 { |
| 1874 #ifdef HAVE_SHLIB | |
| 1875 if (unloading_module) | |
| 1876 { | |
| 1877 sym->value = newval; | |
| 1878 return newval; | |
| 1879 } | |
| 1880 else | |
| 1881 #endif | |
| 1882 invalid_change ("Cannot makunbound", symbol); | |
| 1883 } | |
| 1884 break; | |
| 1885 | |
| 1886 case SYMVAL_OBJECT_FORWARD: | |
| 1887 case SYMVAL_CONST_OBJECT_FORWARD: | |
| 1888 if (UNBOUNDP (newval)) | |
| 1889 { | |
| 1890 #ifdef HAVE_SHLIB | |
| 1891 if (unloading_module) | |
| 1892 { | |
| 1111 | 1893 unstaticpro_nodump ((Lisp_Object *) |
| 1894 symbol_value_forward_forward | |
| 996 | 1895 (XSYMBOL_VALUE_FORWARD (valcontents))); |
| 1896 sym->value = newval; | |
| 1897 return newval; | |
| 1898 } | |
| 1899 else | |
| 1900 #endif | |
| 1901 invalid_change ("Cannot makunbound", symbol); | |
| 1902 } | |
| 428 | 1903 break; |
| 1904 | |
| 1905 /* case SYMVAL_UNBOUND_MARKER: break; */ | |
| 1906 | |
| 1907 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 1908 { | |
| 442 | 1909 const struct symbol_value_forward *fwd |
| 428 | 1910 = XSYMBOL_VALUE_FORWARD (valcontents); |
| 1911 int mask = XINT (*((Lisp_Object *) | |
| 1912 symbol_value_forward_forward (fwd))); | |
| 1913 if (mask > 0) | |
| 1914 /* Setting this variable makes it buffer-local */ | |
| 1915 current_buffer->local_var_flags |= mask; | |
| 1916 break; | |
| 1917 } | |
| 1918 | |
| 1919 case SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 1920 { | |
| 442 | 1921 const struct symbol_value_forward *fwd |
| 428 | 1922 = XSYMBOL_VALUE_FORWARD (valcontents); |
| 1923 int mask = XINT (*((Lisp_Object *) | |
| 1924 symbol_value_forward_forward (fwd))); | |
| 1925 if (mask > 0) | |
| 1926 /* Setting this variable makes it console-local */ | |
| 1927 XCONSOLE (Vselected_console)->local_var_flags |= mask; | |
| 1928 break; | |
| 1929 } | |
| 1930 | |
| 1931 case SYMVAL_BUFFER_LOCAL: | |
| 1932 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 1933 { | |
| 1934 /* If we want to examine or set the value and | |
| 1935 CURRENT-BUFFER is current, we just examine or set | |
| 1936 CURRENT-VALUE. If CURRENT-BUFFER is not current, we | |
| 1937 store the current CURRENT-VALUE value into | |
| 1938 CURRENT-ALIST- ELEMENT, then find the appropriate alist | |
| 1939 element for the buffer now current and set up | |
| 1940 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out | |
| 1941 of that element, and store into CURRENT-BUFFER. | |
| 1942 | |
| 1943 If we are setting the variable and the current buffer does | |
| 1944 not have an alist entry for this variable, an alist entry is | |
| 1945 created. | |
| 1946 | |
| 1947 Note that CURRENT-VALUE can be a forwarding pointer. | |
| 1948 Each time it is examined or set, forwarding must be | |
| 1949 done. */ | |
| 1950 struct symbol_value_buffer_local *bfwd | |
| 1951 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 1952 int some_buffer_local_p = | |
| 1953 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL); | |
| 1954 /* What value are we caching right now? */ | |
| 1955 Lisp_Object aelt = bfwd->current_alist_element; | |
| 1956 | |
| 1957 if (!NILP (bfwd->current_buffer) && | |
| 1958 current_buffer == XBUFFER (bfwd->current_buffer) | |
| 1959 && ((some_buffer_local_p) | |
| 1960 ? 1 /* doesn't automatically become local */ | |
| 1961 : !NILP (aelt) /* already local */ | |
| 1962 )) | |
| 1963 { | |
| 1964 /* Cache is valid */ | |
| 1965 valcontents = bfwd->current_value; | |
| 1966 } | |
| 1967 else | |
| 1968 { | |
| 1969 /* If the current buffer is not the buffer whose binding is | |
| 1970 currently cached, or if it's a SYMVAL_BUFFER_LOCAL and | |
| 1971 we're looking at the default value, the cache is invalid; we | |
| 1972 need to write it out, and find the new CURRENT-ALIST-ELEMENT | |
| 1973 */ | |
| 1974 | |
| 1975 /* Write out the cached value for the old buffer; copy it | |
| 1976 back to its alist element. This works if the current | |
| 1977 buffer only sees the default value, too. */ | |
| 1978 write_out_buffer_local_cache (symbol, bfwd); | |
| 1979 | |
| 1980 /* Find the new value for CURRENT-ALIST-ELEMENT. */ | |
| 1981 aelt = buffer_local_alist_element (current_buffer, symbol, bfwd); | |
| 1982 if (NILP (aelt)) | |
| 1983 { | |
| 1984 /* This buffer is still seeing the default value. */ | |
| 1985 if (!some_buffer_local_p) | |
| 1986 { | |
| 1987 /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a | |
| 1988 new assoc for a local value and set | |
| 1989 CURRENT-ALIST-ELEMENT to point to that. */ | |
| 1990 aelt = | |
| 1991 do_symval_forwarding (bfwd->current_value, | |
| 1992 current_buffer, | |
| 1993 XCONSOLE (Vselected_console)); | |
| 1994 aelt = Fcons (symbol, aelt); | |
| 1995 current_buffer->local_var_alist | |
| 1996 = Fcons (aelt, current_buffer->local_var_alist); | |
| 1997 } | |
| 1998 else | |
| 1999 { | |
| 2000 /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL, | |
| 2001 we're currently seeing the default value. */ | |
| 2002 ; | |
| 2003 } | |
| 2004 } | |
| 2005 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */ | |
| 2006 bfwd->current_alist_element = aelt; | |
| 2007 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */ | |
| 793 | 2008 bfwd->current_buffer = wrap_buffer (current_buffer); |
| 428 | 2009 valcontents = bfwd->current_value; |
| 2010 } | |
| 2011 break; | |
| 2012 } | |
| 2013 default: | |
| 2500 | 2014 ABORT (); |
| 428 | 2015 } |
| 2016 store_symval_forwarding (symbol, valcontents, newval); | |
| 2017 | |
| 2018 return newval; | |
| 2019 } | |
| 2020 | |
| 2021 | |
| 2022 /* Access or set a buffer-local symbol's default value. */ | |
| 2023 | |
| 2024 /* Return the default value of SYM, but don't check for voidness. | |
| 2025 Return Qunbound if it is void. */ | |
| 2026 | |
| 2027 static Lisp_Object | |
| 2028 default_value (Lisp_Object sym) | |
| 2029 { | |
| 2030 Lisp_Object valcontents; | |
| 2031 | |
| 2032 CHECK_SYMBOL (sym); | |
| 2033 | |
| 2034 retry: | |
| 2035 valcontents = XSYMBOL (sym)->value; | |
| 2036 | |
| 2037 retry_2: | |
| 2038 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2039 return valcontents; | |
| 2040 | |
| 2041 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2042 { | |
| 2043 case SYMVAL_LISP_MAGIC: | |
| 2044 /* #### kludge */ | |
| 2045 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2046 /* semi-change-o */ | |
| 2047 goto retry_2; | |
| 2048 | |
| 2049 case SYMVAL_VARALIAS: | |
| 2050 sym = follow_varalias_pointers (sym, Qt /* #### kludge */); | |
| 2051 /* presto change-o! */ | |
| 2052 goto retry; | |
| 2053 | |
| 2054 case SYMVAL_UNBOUND_MARKER: | |
| 2055 return valcontents; | |
| 2056 | |
| 2057 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 2058 { | |
| 442 | 2059 const struct symbol_value_forward *fwd |
| 428 | 2060 = XSYMBOL_VALUE_FORWARD (valcontents); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2061 return (*((Lisp_Object *)((Rawbyte *) XBUFFER (Vbuffer_defaults) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2062 + ((Rawbyte *)symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2063 - (Rawbyte *)&buffer_local_flags)))); |
| 428 | 2064 } |
| 2065 | |
| 2066 case SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 2067 { | |
| 442 | 2068 const struct symbol_value_forward *fwd |
| 428 | 2069 = XSYMBOL_VALUE_FORWARD (valcontents); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2070 return (*((Lisp_Object *)((Rawbyte *) XCONSOLE (Vconsole_defaults) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2071 + ((Rawbyte *)symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2072 - (Rawbyte *)&console_local_flags)))); |
| 428 | 2073 } |
| 2074 | |
| 2075 case SYMVAL_BUFFER_LOCAL: | |
| 2076 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 2077 { | |
| 2078 struct symbol_value_buffer_local *bfwd = | |
| 2079 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 2080 | |
| 2081 /* Handle user-created local variables. */ | |
| 2082 /* If var is set up for a buffer that lacks a local value for it, | |
| 2083 the current value is nominally the default value. | |
| 2084 But the current value slot may be more up to date, since | |
| 2085 ordinary setq stores just that slot. So use that. */ | |
| 2086 if (NILP (bfwd->current_alist_element)) | |
| 2087 return do_symval_forwarding (bfwd->current_value, current_buffer, | |
| 2088 XCONSOLE (Vselected_console)); | |
| 2089 else | |
| 2090 return bfwd->default_value; | |
| 2091 } | |
| 2092 default: | |
| 2093 /* For other variables, get the current value. */ | |
| 2094 return do_symval_forwarding (valcontents, current_buffer, | |
| 2095 XCONSOLE (Vselected_console)); | |
| 2096 } | |
| 2097 | |
| 1204 | 2098 RETURN_NOT_REACHED (Qnil); /* suppress compiler warning */ |
| 428 | 2099 } |
| 2100 | |
| 2101 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /* | |
| 2102 Return t if SYMBOL has a non-void default value. | |
| 2103 This is the value that is seen in buffers that do not have their own values | |
| 2104 for this variable. | |
| 2105 */ | |
| 2106 (symbol)) | |
| 2107 { | |
| 2108 return UNBOUNDP (default_value (symbol)) ? Qnil : Qt; | |
| 2109 } | |
| 2110 | |
| 2111 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /* | |
| 2112 Return SYMBOL's default value. | |
| 2113 This is the value that is seen in buffers that do not have their own values | |
| 2114 for this variable. The default value is meaningful for variables with | |
| 2115 local bindings in certain buffers. | |
| 2116 */ | |
| 2117 (symbol)) | |
| 2118 { | |
| 2119 Lisp_Object value = default_value (symbol); | |
| 2120 | |
| 2121 return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (symbol)) : value; | |
| 2122 } | |
| 2123 | |
| 2124 DEFUN ("set-default", Fset_default, 2, 2, 0, /* | |
| 444 | 2125 Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated. |
| 428 | 2126 The default value is seen in buffers that do not have their own values |
| 2127 for this variable. | |
| 2128 */ | |
| 2129 (symbol, value)) | |
| 2130 { | |
| 2131 Lisp_Object valcontents; | |
| 2132 | |
| 2133 CHECK_SYMBOL (symbol); | |
| 2134 | |
| 2135 retry: | |
| 2136 valcontents = XSYMBOL (symbol)->value; | |
| 2137 | |
| 2138 retry_2: | |
| 2139 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2140 return Fset (symbol, value); | |
| 2141 | |
| 2142 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2143 { | |
| 2144 case SYMVAL_LISP_MAGIC: | |
| 2145 RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (symbol, Qset_default, 1, | |
| 2146 value)); | |
| 2147 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2148 /* semi-change-o */ | |
| 2149 goto retry_2; | |
| 2150 | |
| 2151 case SYMVAL_VARALIAS: | |
| 2152 symbol = follow_varalias_pointers (symbol, Qset_default); | |
| 2153 /* presto change-o! */ | |
| 2154 goto retry; | |
| 2155 | |
| 2156 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 2157 set_default_buffer_slot_variable (symbol, value); | |
| 2158 return value; | |
| 2159 | |
| 2160 case SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 2161 set_default_console_slot_variable (symbol, value); | |
| 2162 return value; | |
| 2163 | |
| 2164 case SYMVAL_BUFFER_LOCAL: | |
| 2165 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 2166 { | |
| 2167 /* Store new value into the DEFAULT-VALUE slot */ | |
| 2168 struct symbol_value_buffer_local *bfwd | |
| 2169 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 2170 | |
| 2171 bfwd->default_value = value; | |
| 2172 /* If current-buffer doesn't shadow default_value, | |
| 2173 * we must set the CURRENT-VALUE slot too */ | |
| 2174 if (NILP (bfwd->current_alist_element)) | |
| 2175 store_symval_forwarding (symbol, bfwd->current_value, value); | |
| 2176 return value; | |
| 2177 } | |
| 2178 | |
| 2179 default: | |
| 2180 return Fset (symbol, value); | |
| 2181 } | |
| 2182 } | |
| 2183 | |
| 2184 DEFUN ("setq-default", Fsetq_default, 0, UNEVALLED, 0, /* | |
| 2185 Set the default value of variable SYMBOL to VALUE. | |
| 2186 SYMBOL, the variable name, is literal (not evaluated); | |
| 2187 VALUE is an expression and it is evaluated. | |
| 2188 The default value of a variable is seen in buffers | |
| 2189 that do not have their own values for the variable. | |
| 2190 | |
| 2191 More generally, you can use multiple variables and values, as in | |
| 2192 (setq-default SYMBOL VALUE SYMBOL VALUE...) | |
| 2193 This sets each SYMBOL's default value to the corresponding VALUE. | |
| 2194 The VALUE for the Nth SYMBOL can refer to the new default values | |
| 2195 of previous SYMBOLs. | |
| 2196 */ | |
| 2197 (args)) | |
| 2198 { | |
| 2199 /* This function can GC */ | |
| 2200 int nargs; | |
| 2421 | 2201 Lisp_Object retval = Qnil; |
| 428 | 2202 |
| 2203 GET_LIST_LENGTH (args, nargs); | |
| 2204 | |
| 2205 if (nargs & 1) /* Odd number of arguments? */ | |
| 2206 Fsignal (Qwrong_number_of_arguments, | |
| 2207 list2 (Qsetq_default, make_int (nargs))); | |
| 2208 | |
| 2421 | 2209 GC_PROPERTY_LIST_LOOP_3 (symbol, val, args) |
| 428 | 2210 { |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4642
diff
changeset
|
2211 val = IGNORE_MULTIPLE_VALUES (Feval (val)); |
| 428 | 2212 Fset_default (symbol, val); |
| 2421 | 2213 retval = val; |
| 428 | 2214 } |
| 2215 | |
| 2421 | 2216 END_GC_PROPERTY_LIST_LOOP (symbol); |
| 2217 return retval; | |
| 428 | 2218 } |
| 2219 | |
| 2220 /* Lisp functions for creating and removing buffer-local variables. */ | |
| 2221 | |
| 2222 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1, | |
| 2223 "vMake Variable Buffer Local: ", /* | |
| 2224 Make VARIABLE have a separate value for each buffer. | |
| 2225 At any time, the value for the current buffer is in effect. | |
| 2226 There is also a default value which is seen in any buffer which has not yet | |
| 2227 set its own value. | |
| 2228 Using `set' or `setq' to set the variable causes it to have a separate value | |
| 2229 for the current buffer if it was previously using the default value. | |
| 2230 The function `default-value' gets the default value and `set-default' | |
| 2231 sets it. | |
| 2232 */ | |
| 2233 (variable)) | |
| 2234 { | |
| 2235 Lisp_Object valcontents; | |
| 2236 | |
| 2237 CHECK_SYMBOL (variable); | |
| 2238 | |
| 2239 retry: | |
| 2240 verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local); | |
| 2241 | |
| 2242 valcontents = XSYMBOL (variable)->value; | |
| 2243 | |
| 2244 retry_2: | |
| 2245 if (SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2246 { | |
| 2247 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2248 { | |
| 2249 case SYMVAL_LISP_MAGIC: | |
| 2250 if (!UNBOUNDP (maybe_call_magic_handler | |
| 2251 (variable, Qmake_variable_buffer_local, 0))) | |
| 2252 return variable; | |
| 2253 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2254 /* semi-change-o */ | |
| 2255 goto retry_2; | |
| 2256 | |
| 2257 case SYMVAL_VARALIAS: | |
| 2258 variable = follow_varalias_pointers (variable, | |
| 2259 Qmake_variable_buffer_local); | |
| 2260 /* presto change-o! */ | |
| 2261 goto retry; | |
| 2262 | |
| 2263 case SYMVAL_FIXNUM_FORWARD: | |
| 2264 case SYMVAL_BOOLEAN_FORWARD: | |
| 2265 case SYMVAL_OBJECT_FORWARD: | |
| 2266 case SYMVAL_UNBOUND_MARKER: | |
| 2267 break; | |
| 2268 | |
| 2269 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 2270 case SYMVAL_BUFFER_LOCAL: | |
| 2271 /* Already per-each-buffer */ | |
| 2272 return variable; | |
| 2273 | |
| 2274 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 2275 /* Transmogrify */ | |
| 2276 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type = | |
| 2277 SYMVAL_BUFFER_LOCAL; | |
| 2278 return variable; | |
| 2279 | |
| 2280 default: | |
| 2500 | 2281 ABORT (); |
| 428 | 2282 } |
| 2283 } | |
| 2284 | |
| 2285 { | |
| 2286 struct symbol_value_buffer_local *bfwd | |
| 3017 | 2287 = ALLOC_LCRECORD_TYPE (struct symbol_value_buffer_local, |
| 428 | 2288 &lrecord_symbol_value_buffer_local); |
| 2289 Lisp_Object foo; | |
| 2290 bfwd->magic.type = SYMVAL_BUFFER_LOCAL; | |
| 2291 | |
| 2292 bfwd->default_value = find_symbol_value (variable); | |
| 2293 bfwd->current_value = valcontents; | |
| 2294 bfwd->current_alist_element = Qnil; | |
| 2295 bfwd->current_buffer = Fcurrent_buffer (); | |
| 793 | 2296 foo = wrap_symbol_value_magic (bfwd); |
| 428 | 2297 *value_slot_past_magic (variable) = foo; |
| 2298 #if 1 /* #### Yuck! FSFmacs bug-compatibility*/ | |
| 2299 /* This sets the default-value of any make-variable-buffer-local to nil. | |
| 2300 That just sucks. User can just use setq-default to effect that, | |
| 2301 but there's no way to do makunbound-default to undo this lossage. */ | |
| 2302 if (UNBOUNDP (valcontents)) | |
| 2303 bfwd->default_value = Qnil; | |
| 2304 #endif | |
| 2305 #if 0 /* #### Yuck! */ | |
| 2306 /* This sets the value to nil in this buffer. | |
| 2307 User could use (setq variable nil) to do this. | |
| 2308 It isn't as egregious to do this automatically | |
| 2309 as it is to do so to the default-value, but it's | |
| 2310 still really dubious. */ | |
| 2311 if (UNBOUNDP (valcontents)) | |
| 2312 Fset (variable, Qnil); | |
| 2313 #endif | |
| 2314 return variable; | |
| 2315 } | |
| 2316 } | |
| 2317 | |
| 2318 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1, | |
| 2319 "vMake Local Variable: ", /* | |
| 2320 Make VARIABLE have a separate value in the current buffer. | |
| 2321 Other buffers will continue to share a common default value. | |
| 2322 \(The buffer-local value of VARIABLE starts out as the same value | |
| 2323 VARIABLE previously had. If VARIABLE was void, it remains void.) | |
| 2324 See also `make-variable-buffer-local'. | |
| 2325 | |
| 2326 If the variable is already arranged to become local when set, | |
| 2327 this function causes a local value to exist for this buffer, | |
| 2328 just as setting the variable would do. | |
| 2329 | |
| 2330 Do not use `make-local-variable' to make a hook variable buffer-local. | |
| 2331 Use `make-local-hook' instead. | |
| 2332 */ | |
| 2333 (variable)) | |
| 2334 { | |
| 2335 Lisp_Object valcontents; | |
| 2336 struct symbol_value_buffer_local *bfwd; | |
| 2337 | |
| 2338 CHECK_SYMBOL (variable); | |
| 2339 | |
| 2340 retry: | |
| 2341 verify_ok_for_buffer_local (variable, Qmake_local_variable); | |
| 2342 | |
| 2343 valcontents = XSYMBOL (variable)->value; | |
| 2344 | |
| 2345 retry_2: | |
| 2346 if (SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2347 { | |
| 2348 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2349 { | |
| 2350 case SYMVAL_LISP_MAGIC: | |
| 2351 if (!UNBOUNDP (maybe_call_magic_handler | |
| 2352 (variable, Qmake_local_variable, 0))) | |
| 2353 return variable; | |
| 2354 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2355 /* semi-change-o */ | |
| 2356 goto retry_2; | |
| 2357 | |
| 2358 case SYMVAL_VARALIAS: | |
| 2359 variable = follow_varalias_pointers (variable, Qmake_local_variable); | |
| 2360 /* presto change-o! */ | |
| 2361 goto retry; | |
| 2362 | |
| 2363 case SYMVAL_FIXNUM_FORWARD: | |
| 2364 case SYMVAL_BOOLEAN_FORWARD: | |
| 2365 case SYMVAL_OBJECT_FORWARD: | |
| 2366 case SYMVAL_UNBOUND_MARKER: | |
| 2367 break; | |
| 2368 | |
| 2369 case SYMVAL_BUFFER_LOCAL: | |
| 2370 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 2371 { | |
| 2372 /* Make sure the symbol has a local value in this particular | |
| 2373 buffer, by setting it to the same value it already has. */ | |
| 2374 Fset (variable, find_symbol_value (variable)); | |
| 2375 return variable; | |
| 2376 } | |
| 2377 | |
| 2378 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 2379 { | |
| 2380 if (!NILP (buffer_local_alist_element (current_buffer, | |
| 2381 variable, | |
| 2382 (XSYMBOL_VALUE_BUFFER_LOCAL | |
| 2383 (valcontents))))) | |
| 2384 goto already_local_to_current_buffer; | |
| 2385 else | |
| 2386 goto already_local_to_some_other_buffer; | |
| 2387 } | |
| 2388 | |
| 2389 default: | |
| 2500 | 2390 ABORT (); |
| 428 | 2391 } |
| 2392 } | |
| 2393 | |
| 2394 /* Make sure variable is set up to hold per-buffer values */ | |
| 3017 | 2395 bfwd = ALLOC_LCRECORD_TYPE (struct symbol_value_buffer_local, |
| 428 | 2396 &lrecord_symbol_value_buffer_local); |
| 2397 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL; | |
| 2398 | |
| 2399 bfwd->current_buffer = Qnil; | |
| 2400 bfwd->current_alist_element = Qnil; | |
| 2401 bfwd->current_value = valcontents; | |
| 2402 /* passing 0 is OK because this should never be a | |
| 2403 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD | |
| 2404 variable. */ | |
| 2405 bfwd->default_value = do_symval_forwarding (valcontents, 0, 0); | |
| 2406 | |
| 2407 #if 0 | |
| 2408 if (UNBOUNDP (bfwd->default_value)) | |
| 2409 bfwd->default_value = Qnil; /* Yuck! */ | |
| 2410 #endif | |
| 2411 | |
| 793 | 2412 valcontents = wrap_symbol_value_magic (bfwd); |
| 428 | 2413 *value_slot_past_magic (variable) = valcontents; |
| 2414 | |
| 2415 already_local_to_some_other_buffer: | |
| 2416 | |
| 2417 /* Make sure this buffer has its own value of variable */ | |
| 2418 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 2419 | |
| 2420 if (UNBOUNDP (bfwd->default_value)) | |
| 2421 { | |
| 2422 /* If default value is unbound, set local value to nil. */ | |
| 793 | 2423 bfwd->current_buffer = wrap_buffer (current_buffer); |
| 428 | 2424 bfwd->current_alist_element = Fcons (variable, Qnil); |
| 2425 current_buffer->local_var_alist = | |
| 2426 Fcons (bfwd->current_alist_element, current_buffer->local_var_alist); | |
| 2427 store_symval_forwarding (variable, bfwd->current_value, Qnil); | |
| 2428 return variable; | |
| 2429 } | |
| 2430 | |
| 2431 current_buffer->local_var_alist | |
| 2432 = Fcons (Fcons (variable, bfwd->default_value), | |
| 2433 current_buffer->local_var_alist); | |
| 2434 | |
| 2435 /* Make sure symbol does not think it is set up for this buffer; | |
| 2436 force it to look once again for this buffer's value */ | |
| 2437 if (!NILP (bfwd->current_buffer) && | |
| 2438 current_buffer == XBUFFER (bfwd->current_buffer)) | |
| 2439 bfwd->current_buffer = Qnil; | |
| 2440 | |
| 2441 already_local_to_current_buffer: | |
| 2442 | |
| 2443 /* If the symbol forwards into a C variable, then swap in the | |
| 2444 variable for this buffer immediately. If C code modifies the | |
| 2445 variable before we swap in, then that new value will clobber the | |
| 2446 default value the next time we swap. */ | |
| 2447 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 2448 if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value)) | |
| 2449 { | |
| 2450 switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value)) | |
| 2451 { | |
| 2452 case SYMVAL_FIXNUM_FORWARD: | |
| 2453 case SYMVAL_BOOLEAN_FORWARD: | |
| 2454 case SYMVAL_OBJECT_FORWARD: | |
| 2455 case SYMVAL_DEFAULT_BUFFER_FORWARD: | |
| 2456 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1); | |
| 2457 break; | |
| 2458 | |
| 2459 case SYMVAL_UNBOUND_MARKER: | |
| 2460 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 2461 break; | |
| 2462 | |
| 2463 default: | |
| 2500 | 2464 ABORT (); |
| 428 | 2465 } |
| 2466 } | |
| 2467 | |
| 2468 return variable; | |
| 2469 } | |
| 2470 | |
| 2471 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1, | |
| 2472 "vKill Local Variable: ", /* | |
| 2473 Make VARIABLE no longer have a separate value in the current buffer. | |
| 2474 From now on the default value will apply in this buffer. | |
| 2475 */ | |
| 2476 (variable)) | |
| 2477 { | |
| 2478 Lisp_Object valcontents; | |
| 2479 | |
| 2480 CHECK_SYMBOL (variable); | |
| 2481 | |
| 2482 retry: | |
| 2483 valcontents = XSYMBOL (variable)->value; | |
| 2484 | |
| 2485 retry_2: | |
| 2486 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2487 return variable; | |
| 2488 | |
| 2489 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2490 { | |
| 2491 case SYMVAL_LISP_MAGIC: | |
| 2492 if (!UNBOUNDP (maybe_call_magic_handler | |
| 2493 (variable, Qkill_local_variable, 0))) | |
| 2494 return variable; | |
| 2495 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2496 /* semi-change-o */ | |
| 2497 goto retry_2; | |
| 2498 | |
| 2499 case SYMVAL_VARALIAS: | |
| 2500 variable = follow_varalias_pointers (variable, Qkill_local_variable); | |
| 2501 /* presto change-o! */ | |
| 2502 goto retry; | |
| 2503 | |
| 2504 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 2505 { | |
| 442 | 2506 const struct symbol_value_forward *fwd |
| 428 | 2507 = XSYMBOL_VALUE_FORWARD (valcontents); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2508 int offset = ((Rawbyte *) symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2509 - (Rawbyte *) &buffer_local_flags); |
| 428 | 2510 int mask = |
| 2511 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); | |
| 2512 | |
| 2513 if (mask > 0) | |
| 2514 { | |
| 2515 int (*magicfun) (Lisp_Object sym, Lisp_Object *val, | |
| 2516 Lisp_Object in_object, int flags) = | |
| 2517 symbol_value_forward_magicfun (fwd); | |
| 2518 Lisp_Object oldval = * (Lisp_Object *) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2519 (offset + (Rawbyte *) XBUFFER (Vbuffer_defaults)); |
| 428 | 2520 if (magicfun) |
| 771 | 2521 (magicfun) (variable, &oldval, wrap_buffer (current_buffer), 0); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2522 *(Lisp_Object *) (offset + (Rawbyte *) current_buffer) |
| 428 | 2523 = oldval; |
| 2524 current_buffer->local_var_flags &= ~mask; | |
| 2525 } | |
| 2526 return variable; | |
| 2527 } | |
| 2528 | |
| 2529 case SYMVAL_BUFFER_LOCAL: | |
| 2530 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 2531 { | |
| 2532 /* Get rid of this buffer's alist element, if any */ | |
| 2533 struct symbol_value_buffer_local *bfwd | |
| 2534 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 2535 Lisp_Object alist = current_buffer->local_var_alist; | |
| 2536 Lisp_Object alist_element | |
| 2537 = buffer_local_alist_element (current_buffer, variable, bfwd); | |
| 2538 | |
| 2539 if (!NILP (alist_element)) | |
| 2540 current_buffer->local_var_alist = Fdelq (alist_element, alist); | |
| 2541 | |
| 2542 /* Make sure symbol does not think it is set up for this buffer; | |
| 2543 force it to look once again for this buffer's value */ | |
| 2544 if (!NILP (bfwd->current_buffer) && | |
| 2545 current_buffer == XBUFFER (bfwd->current_buffer)) | |
| 2546 bfwd->current_buffer = Qnil; | |
| 2547 | |
| 2548 /* We just changed the value in the current_buffer. If this | |
| 2549 variable forwards to a C variable, we need to change the | |
| 2550 value of the C variable. set_up_buffer_local_cache() | |
| 2551 will do this. It doesn't hurt to do it always, | |
| 2552 so just go ahead and do that. */ | |
| 2553 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1); | |
| 2554 } | |
| 2555 return variable; | |
| 2556 | |
| 2557 default: | |
| 2558 return variable; | |
| 2559 } | |
| 1204 | 2560 RETURN_NOT_REACHED(Qnil); /* suppress compiler warning */ |
| 428 | 2561 } |
| 2562 | |
| 2563 | |
| 2564 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1, | |
| 2565 "vKill Console Local Variable: ", /* | |
| 2566 Make VARIABLE no longer have a separate value in the selected console. | |
| 2567 From now on the default value will apply in this console. | |
| 2568 */ | |
| 2569 (variable)) | |
| 2570 { | |
| 2571 Lisp_Object valcontents; | |
| 2572 | |
| 2573 CHECK_SYMBOL (variable); | |
| 2574 | |
| 2575 retry: | |
| 2576 valcontents = XSYMBOL (variable)->value; | |
| 2577 | |
| 2578 retry_2: | |
| 2579 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2580 return variable; | |
| 2581 | |
| 2582 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2583 { | |
| 2584 case SYMVAL_LISP_MAGIC: | |
| 2585 if (!UNBOUNDP (maybe_call_magic_handler | |
| 2586 (variable, Qkill_console_local_variable, 0))) | |
| 2587 return variable; | |
| 2588 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2589 /* semi-change-o */ | |
| 2590 goto retry_2; | |
| 2591 | |
| 2592 case SYMVAL_VARALIAS: | |
| 2593 variable = follow_varalias_pointers (variable, | |
| 2594 Qkill_console_local_variable); | |
| 2595 /* presto change-o! */ | |
| 2596 goto retry; | |
| 2597 | |
| 2598 case SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 2599 { | |
| 442 | 2600 const struct symbol_value_forward *fwd |
| 428 | 2601 = XSYMBOL_VALUE_FORWARD (valcontents); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2602 int offset = ((Rawbyte *) symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2603 - (Rawbyte *) &console_local_flags); |
| 428 | 2604 int mask = |
| 2605 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); | |
| 2606 | |
| 2607 if (mask > 0) | |
| 2608 { | |
| 2609 int (*magicfun) (Lisp_Object sym, Lisp_Object *val, | |
| 2610 Lisp_Object in_object, int flags) = | |
| 2611 symbol_value_forward_magicfun (fwd); | |
| 2612 Lisp_Object oldval = * (Lisp_Object *) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2613 (offset + (Rawbyte *) XCONSOLE (Vconsole_defaults)); |
| 428 | 2614 if (magicfun) |
| 2615 magicfun (variable, &oldval, Vselected_console, 0); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2616 *(Lisp_Object *) (offset + (Rawbyte *) XCONSOLE (Vselected_console)) |
| 428 | 2617 = oldval; |
| 2618 XCONSOLE (Vselected_console)->local_var_flags &= ~mask; | |
| 2619 } | |
| 2620 return variable; | |
| 2621 } | |
| 2622 | |
| 2623 default: | |
| 2624 return variable; | |
| 2625 } | |
| 2626 } | |
| 2627 | |
| 2628 /* Used by specbind to determine what effects it might have. Returns: | |
| 2629 * 0 if symbol isn't buffer-local, and wouldn't be after it is set | |
| 2630 * <0 if symbol isn't presently buffer-local, but set would make it so | |
| 2631 * >0 if symbol is presently buffer-local | |
| 2632 */ | |
| 2633 int | |
| 2634 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer) | |
| 2635 { | |
| 2636 Lisp_Object valcontents; | |
| 2637 | |
| 2638 retry: | |
| 2639 valcontents = XSYMBOL (symbol)->value; | |
| 2640 | |
| 2641 retry_2: | |
| 2642 if (SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2643 { | |
| 2644 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2645 { | |
| 2646 case SYMVAL_LISP_MAGIC: | |
| 2647 /* #### kludge */ | |
| 2648 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2649 /* semi-change-o */ | |
| 2650 goto retry_2; | |
| 2651 | |
| 2652 case SYMVAL_VARALIAS: | |
| 2653 symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */); | |
| 2654 /* presto change-o! */ | |
| 2655 goto retry; | |
| 2656 | |
| 2657 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 2658 { | |
| 442 | 2659 const struct symbol_value_forward *fwd |
| 428 | 2660 = XSYMBOL_VALUE_FORWARD (valcontents); |
| 2661 int mask = XINT (*((Lisp_Object *) | |
| 2662 symbol_value_forward_forward (fwd))); | |
| 2663 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask))) | |
| 2664 /* Already buffer-local */ | |
| 2665 return 1; | |
| 2666 else | |
| 2667 /* Would be buffer-local after set */ | |
| 2668 return -1; | |
| 2669 } | |
| 2670 case SYMVAL_BUFFER_LOCAL: | |
| 2671 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 2672 { | |
| 2673 struct symbol_value_buffer_local *bfwd | |
| 2674 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 2675 if (buffer | |
| 2676 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd))) | |
| 2677 return 1; | |
| 2678 else | |
| 2679 /* Automatically becomes local when set */ | |
| 2680 return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0; | |
| 2681 } | |
| 2682 default: | |
| 2683 return 0; | |
| 2684 } | |
| 2685 } | |
| 2686 return 0; | |
| 2687 } | |
| 2688 | |
| 2689 | |
| 2690 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /* | |
| 2691 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound. | |
| 2692 */ | |
| 2693 (symbol, buffer, unbound_value)) | |
| 2694 { | |
| 2695 Lisp_Object value; | |
| 2696 CHECK_SYMBOL (symbol); | |
| 2697 CHECK_BUFFER (buffer); | |
| 2698 value = symbol_value_in_buffer (symbol, buffer); | |
| 2699 return UNBOUNDP (value) ? unbound_value : value; | |
| 2700 } | |
| 2701 | |
| 2702 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /* | |
| 2703 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound. | |
| 2704 */ | |
| 2705 (symbol, console, unbound_value)) | |
| 2706 { | |
| 2707 Lisp_Object value; | |
| 2708 CHECK_SYMBOL (symbol); | |
| 2709 CHECK_CONSOLE (console); | |
| 2710 value = symbol_value_in_console (symbol, console); | |
| 2711 return UNBOUNDP (value) ? unbound_value : value; | |
| 2712 } | |
| 2713 | |
| 2714 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /* | |
| 2715 If SYMBOL is a built-in variable, return info about this; else return nil. | |
| 2716 The returned info will be a symbol, one of | |
| 2717 | |
| 2718 `object' A simple built-in variable. | |
| 2719 `const-object' Same, but cannot be set. | |
| 2720 `integer' A built-in integer variable. | |
| 2721 `const-integer' Same, but cannot be set. | |
| 2722 `boolean' A built-in boolean variable. | |
| 2723 `const-boolean' Same, but cannot be set. | |
| 2724 `const-specifier' Always contains a specifier; e.g. `has-modeline-p'. | |
| 2725 `current-buffer' A built-in buffer-local variable. | |
| 2726 `const-current-buffer' Same, but cannot be set. | |
| 2727 `default-buffer' Forwards to the default value of a built-in | |
| 2728 buffer-local variable. | |
| 2729 `selected-console' A built-in console-local variable. | |
| 2730 `const-selected-console' Same, but cannot be set. | |
| 2731 `default-console' Forwards to the default value of a built-in | |
| 2732 console-local variable. | |
| 2733 */ | |
| 2734 (symbol)) | |
| 2735 { | |
| 2736 REGISTER Lisp_Object valcontents; | |
| 2737 | |
| 2738 CHECK_SYMBOL (symbol); | |
| 2739 | |
| 2740 retry: | |
| 2741 valcontents = XSYMBOL (symbol)->value; | |
| 2742 | |
| 2743 retry_2: | |
| 2744 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2745 return Qnil; | |
| 2746 | |
| 2747 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2748 { | |
| 2749 case SYMVAL_LISP_MAGIC: | |
| 2750 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2751 /* semi-change-o */ | |
| 2752 goto retry_2; | |
| 2753 | |
| 2754 case SYMVAL_VARALIAS: | |
| 2755 symbol = follow_varalias_pointers (symbol, Qt); | |
| 2756 /* presto change-o! */ | |
| 2757 goto retry; | |
| 2758 | |
| 2759 case SYMVAL_BUFFER_LOCAL: | |
| 2760 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 2761 valcontents = | |
| 2762 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value; | |
| 2763 /* semi-change-o */ | |
| 2764 goto retry_2; | |
| 2765 | |
| 2766 case SYMVAL_FIXNUM_FORWARD: return Qinteger; | |
| 2767 case SYMVAL_CONST_FIXNUM_FORWARD: return Qconst_integer; | |
| 2768 case SYMVAL_BOOLEAN_FORWARD: return Qboolean; | |
| 2769 case SYMVAL_CONST_BOOLEAN_FORWARD: return Qconst_boolean; | |
| 2770 case SYMVAL_OBJECT_FORWARD: return Qobject; | |
| 2771 case SYMVAL_CONST_OBJECT_FORWARD: return Qconst_object; | |
| 2772 case SYMVAL_CONST_SPECIFIER_FORWARD: return Qconst_specifier; | |
| 2773 case SYMVAL_DEFAULT_BUFFER_FORWARD: return Qdefault_buffer; | |
| 2774 case SYMVAL_CURRENT_BUFFER_FORWARD: return Qcurrent_buffer; | |
| 2775 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: return Qconst_current_buffer; | |
| 2776 case SYMVAL_DEFAULT_CONSOLE_FORWARD: return Qdefault_console; | |
| 2777 case SYMVAL_SELECTED_CONSOLE_FORWARD: return Qselected_console; | |
| 2778 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: return Qconst_selected_console; | |
| 2779 case SYMVAL_UNBOUND_MARKER: return Qnil; | |
| 2780 | |
| 2781 default: | |
| 2500 | 2782 ABORT (); return Qnil; |
| 428 | 2783 } |
| 2784 } | |
| 2785 | |
| 2786 | |
| 2787 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /* | |
| 2788 Return t if SYMBOL's value is local to BUFFER. | |
| 444 | 2789 If optional third arg AFTER-SET is non-nil, return t if SYMBOL would be |
| 428 | 2790 buffer-local after it is set, regardless of whether it is so presently. |
| 2791 A nil value for BUFFER is *not* the same as (current-buffer), but means | |
| 2792 "no buffer". Specifically: | |
| 2793 | |
| 2794 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that | |
| 2795 the variable is one of the special built-in variables that is always | |
| 2796 buffer-local. (This includes `buffer-file-name', `buffer-read-only', | |
| 2797 `buffer-undo-list', and others.) | |
| 2798 | |
| 2799 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that | |
| 2800 the variable has had `make-variable-buffer-local' applied to it. | |
| 2801 */ | |
| 2802 (symbol, buffer, after_set)) | |
| 2803 { | |
| 2804 int local_info; | |
| 2805 | |
| 2806 CHECK_SYMBOL (symbol); | |
| 2807 if (!NILP (buffer)) | |
| 2808 { | |
| 2809 buffer = get_buffer (buffer, 1); | |
| 2810 local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer)); | |
| 2811 } | |
| 2812 else | |
| 2813 { | |
| 2814 local_info = symbol_value_buffer_local_info (symbol, 0); | |
| 2815 } | |
| 2816 | |
| 2817 if (NILP (after_set)) | |
| 2818 return local_info > 0 ? Qt : Qnil; | |
| 2819 else | |
| 2820 return local_info != 0 ? Qt : Qnil; | |
| 2821 } | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2822 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2823 DEFUN ("custom-variable-p", Fcustom_variable_p, 1, 1, 0, /* |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2824 Return non-nil if SYMBOL names a custom variable. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2825 Does not follow the variable alias chain. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2826 */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2827 (symbol)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2828 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2829 return (!(NILP (Fget(symbol, intern ("standard-value"), Qnil))) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2830 || !(NILP (Fget(symbol, intern ("custom-autoload"), Qnil)))) ? |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2831 Qt: Qnil; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2832 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2833 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2834 static Lisp_Object |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2835 user_variable_alias_check_fun (Lisp_Object symbol) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2836 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2837 Lisp_Object documentation = Fget (symbol, Qvariable_documentation, Qnil); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2838 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2839 if ((INTP (documentation) && XINT (documentation) < 0) || |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2840 (STRINGP (documentation) && |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2841 (string_byte (documentation, 0) == '*')) || |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2842 /* If (STRING . INTEGER), a negative integer means a user variable. */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2843 (CONSP (documentation) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2844 && STRINGP (XCAR (documentation)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2845 && INTP (XCDR (documentation)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2846 && XINT (XCDR (documentation)) < 0) || |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2847 !NILP (Fcustom_variable_p (symbol))) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2848 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2849 return make_int(1); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2850 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2851 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2852 return Qzero; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2853 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2854 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2855 DEFUN ("user-variable-p", Fuser_variable_p, 1, 1, 0, /* |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2856 Return t if SYMBOL names a variable intended to be set and modified by users. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2857 \(The alternative is a variable used internally in a Lisp program.) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2858 A symbol names a user variable if |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2859 \(1) the first character of its documentation is `*', or |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2860 \(2) it is customizable (`custom-variable-p' gives t), or |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2861 \(3) it names a variable alias that eventually resolves to another user variable. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2862 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2863 The GNU Emacs implementation of `user-variable-p' returns nil if there is a |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2864 loop in the chain of symbols. Since this is indistinguishable from the case |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2865 where a symbol names a non-user variable, XEmacs signals a |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2866 `cyclic-variable-indirection' error instead; use `condition-case' to catch |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2867 this error if you really want to avoid this. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2868 */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2869 (symbol)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2870 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2871 Lisp_Object mapped; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2872 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2873 if (!SYMBOLP (symbol)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2874 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2875 return Qnil; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2876 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2877 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2878 /* Called for its side-effects, we want it to signal if there's a loop. */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2879 follow_varalias_pointers (symbol, Qt); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2880 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2881 /* Look through the various aliases. */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2882 mapped = map_varalias_chain (symbol, Qt, user_variable_alias_check_fun); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2883 if (EQ (Qzero, mapped)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2884 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2885 return Qnil; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2886 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2887 |
|
4503
af95657e0bfd
Use EQ() and !EQ() in symbols.c, thank you Robert Delius Royar.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4502
diff
changeset
|
2888 assert (EQ (make_int (1), mapped)); |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2889 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2890 return Qt; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2891 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2892 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2893 |
| 428 | 2894 |
| 2895 | |
| 2896 /* | |
| 2897 I've gone ahead and partially implemented this because it's | |
| 2898 super-useful for dealing with the compatibility problems in supporting | |
| 2899 the old pointer-shape variables, and preventing people from `setq'ing | |
| 2900 the new variables. Any other way of handling this problem is way | |
| 2901 ugly, likely to be slow, and generally not something I want to waste | |
| 2902 my time worrying about. | |
| 2903 | |
| 2904 The interface and/or function name is sure to change before this | |
| 2905 gets into its final form. I currently like the way everything is | |
| 2906 set up and it has all the features I want it to have, except for | |
| 2907 one: I really want to be able to have multiple nested handlers, | |
| 2908 to implement an `advice'-like capability. This would allow, | |
| 2909 for example, a clean way of implementing `debug-if-set' or | |
| 2910 `debug-if-referenced' and such. | |
| 2911 | |
| 2912 NOTE NOTE NOTE NOTE NOTE NOTE NOTE: | |
| 2913 ************************************************************ | |
| 2914 **Only** the `set-value', `make-unbound', and `make-local' | |
| 2915 handler types are currently implemented. Implementing the | |
| 2916 get-value and bound-predicate handlers is somewhat tricky | |
| 2917 because there are lots of subfunctions (e.g. find_symbol_value()). | |
| 2918 find_symbol_value(), in fact, is called from outside of | |
| 2919 this module. You'd have to have it do this: | |
| 2920 | |
| 2921 -- check for a `bound-predicate' handler, call that if so; | |
| 2922 if it returns nil, return Qunbound | |
| 2923 -- check for a `get-value' handler and call it and return | |
| 2924 that value | |
| 2925 | |
| 2926 It gets even trickier when you have to deal with | |
| 2927 sub-subfunctions like find_symbol_value_1(), and esp. | |
| 2928 when you have to properly handle variable aliases, which | |
| 2929 can lead to lots of tricky situations. So I've just | |
| 2930 punted on this, since the interface isn't officially | |
| 2931 exported and we can get by with just a `set-value' | |
| 2932 handler. | |
| 2933 | |
| 2934 Actions in unimplemented handler types will correctly | |
| 2935 ignore any handlers, and will not fuck anything up or | |
| 2936 go awry. | |
| 2937 | |
| 2938 WARNING WARNING: If you do go and implement another | |
| 2939 type of handler, make *sure* to change | |
| 2940 would_be_magic_handled() so it knows about this, | |
| 2941 or dire things could result. | |
| 2942 ************************************************************ | |
| 2943 NOTE NOTE NOTE NOTE NOTE NOTE NOTE | |
| 2944 | |
| 2945 Real documentation is as follows. | |
| 2946 | |
| 2947 Set a magic handler for VARIABLE. | |
| 2948 This allows you to specify arbitrary behavior that results from | |
| 2949 accessing or setting a variable. For example, retrieving the | |
| 2950 variable's value might actually retrieve the first element off of | |
| 2951 a list stored in another variable, and setting the variable's value | |
| 2952 might add an element to the front of that list. (This is how the | |
| 2953 obsolete variable `unread-command-event' is implemented.) | |
| 2954 | |
| 2955 In general it is NOT good programming practice to use magic variables | |
| 2956 in a new package that you are designing. If you feel the need to | |
| 2957 do this, it's almost certainly a sign that you should be using a | |
| 2958 function instead of a variable. This facility is provided to allow | |
| 2959 a package to support obsolete variables and provide compatibility | |
| 2960 with similar packages with different variable names and semantics. | |
| 2961 By using magic handlers, you can cleanly provide obsoleteness and | |
| 2962 compatibility support and separate this support from the core | |
| 2963 routines in a package. | |
| 2964 | |
| 2965 VARIABLE should be a symbol naming the variable for which the | |
| 2966 magic behavior is provided. HANDLER-TYPE is a symbol specifying | |
| 2967 which behavior is being controlled, and HANDLER is the function | |
| 2968 that will be called to control this behavior. HARG is a | |
| 2969 value that will be passed to HANDLER but is otherwise | |
| 2970 uninterpreted. KEEP-EXISTING specifies what to do with existing | |
| 2971 handlers of the same type; nil means "erase them all", t means | |
| 2972 "keep them but insert at the beginning", the list (t) means | |
| 2973 "keep them but insert at the end", a function means "keep | |
| 2974 them but insert before the specified function", a list containing | |
| 2975 a function means "keep them but insert after the specified | |
| 2976 function". | |
| 2977 | |
| 2978 You can specify magic behavior for any type of variable at all, | |
| 2979 and for any handler types that are unspecified, the standard | |
| 2980 behavior applies. This allows you, for example, to use | |
| 2981 `defvaralias' in conjunction with this function. (For that | |
| 2982 matter, `defvaralias' could be implemented using this function.) | |
| 2983 | |
| 2984 The behaviors that can be specified in HANDLER-TYPE are | |
| 2985 | |
| 2986 get-value (SYM ARGS FUN HARG HANDLERS) | |
| 2987 This means that one of the functions `symbol-value', | |
| 2988 `default-value', `symbol-value-in-buffer', or | |
| 2989 `symbol-value-in-console' was called on SYM. | |
| 2990 | |
| 2991 set-value (SYM ARGS FUN HARG HANDLERS) | |
| 2992 This means that one of the functions `set' or `set-default' | |
| 2993 was called on SYM. | |
| 2994 | |
| 2995 bound-predicate (SYM ARGS FUN HARG HANDLERS) | |
| 2996 This means that one of the functions `boundp', `globally-boundp', | |
| 2997 or `default-boundp' was called on SYM. | |
| 2998 | |
| 2999 make-unbound (SYM ARGS FUN HARG HANDLERS) | |
| 3000 This means that the function `makunbound' was called on SYM. | |
| 3001 | |
| 3002 local-predicate (SYM ARGS FUN HARG HANDLERS) | |
| 3003 This means that the function `local-variable-p' was called | |
| 3004 on SYM. | |
| 3005 | |
| 3006 make-local (SYM ARGS FUN HARG HANDLERS) | |
| 3007 This means that one of the functions `make-local-variable', | |
| 3008 `make-variable-buffer-local', `kill-local-variable', | |
| 3009 or `kill-console-local-variable' was called on SYM. | |
| 3010 | |
| 3011 The meanings of the arguments are as follows: | |
| 3012 | |
| 3013 SYM is the symbol on which the function was called, and is always | |
| 3014 the first argument to the function. | |
| 3015 | |
| 3016 ARGS are the remaining arguments in the original call (i.e. all | |
| 3017 but the first). In the case of `set-value' in particular, | |
| 3018 the first element of ARGS is the value to which the variable | |
| 3019 is being set. In some cases, ARGS is sanitized from what was | |
| 3020 actually given. For example, whenever `nil' is passed to an | |
| 3021 argument and it means `current-buffer', the current buffer is | |
| 3022 substituted instead. | |
| 3023 | |
| 3024 FUN is a symbol indicating which function is being called. | |
| 3025 For many of the functions, you can determine the corresponding | |
| 3026 function of a different class using | |
| 3027 `symbol-function-corresponding-function'. | |
| 3028 | |
| 3029 HARG is the argument that was given in the call | |
| 3030 to `set-symbol-value-handler' for SYM and HANDLER-TYPE. | |
| 3031 | |
| 3032 HANDLERS is a structure containing the remaining handlers | |
| 3033 for the variable; to call one of them, use | |
| 3034 `chain-to-symbol-value-handler'. | |
| 3035 | |
| 3036 NOTE: You may *not* modify the list in ARGS, and if you want to | |
| 3037 keep it around after the handler function exits, you must make | |
| 3038 a copy using `copy-sequence'. (Same caveats for HANDLERS also.) | |
| 3039 */ | |
| 3040 | |
| 3041 static enum lisp_magic_handler | |
| 3042 decode_magic_handler_type (Lisp_Object symbol) | |
| 3043 { | |
| 3044 if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE; | |
| 3045 if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE; | |
| 3046 if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE; | |
| 3047 if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND; | |
| 3048 if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE; | |
| 3049 if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL; | |
| 3050 | |
| 563 | 3051 invalid_constant ("Unrecognized symbol value handler type", symbol); |
| 1204 | 3052 RETURN_NOT_REACHED (MAGIC_HANDLER_MAX); |
| 428 | 3053 } |
| 3054 | |
| 3055 static enum lisp_magic_handler | |
| 3056 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found) | |
| 3057 { | |
| 3058 if (EQ (funsym, Qsymbol_value) | |
| 3059 || EQ (funsym, Qdefault_value) | |
| 3060 || EQ (funsym, Qsymbol_value_in_buffer) | |
| 3061 || EQ (funsym, Qsymbol_value_in_console)) | |
| 3062 return MAGIC_HANDLER_GET_VALUE; | |
| 3063 | |
| 3064 if (EQ (funsym, Qset) | |
| 3065 || EQ (funsym, Qset_default)) | |
| 3066 return MAGIC_HANDLER_SET_VALUE; | |
| 3067 | |
| 3068 if (EQ (funsym, Qboundp) | |
| 3069 || EQ (funsym, Qglobally_boundp) | |
| 3070 || EQ (funsym, Qdefault_boundp)) | |
| 3071 return MAGIC_HANDLER_BOUND_PREDICATE; | |
| 3072 | |
| 3073 if (EQ (funsym, Qmakunbound)) | |
| 3074 return MAGIC_HANDLER_MAKE_UNBOUND; | |
| 3075 | |
| 3076 if (EQ (funsym, Qlocal_variable_p)) | |
| 3077 return MAGIC_HANDLER_LOCAL_PREDICATE; | |
| 3078 | |
| 3079 if (EQ (funsym, Qmake_variable_buffer_local) | |
| 3080 || EQ (funsym, Qmake_local_variable)) | |
| 3081 return MAGIC_HANDLER_MAKE_LOCAL; | |
| 3082 | |
| 3083 if (abort_if_not_found) | |
| 2500 | 3084 ABORT (); |
| 563 | 3085 invalid_argument ("Unrecognized symbol-value function", funsym); |
| 1204 | 3086 RETURN_NOT_REACHED (MAGIC_HANDLER_MAX); |
| 428 | 3087 } |
| 3088 | |
| 3089 static int | |
| 3090 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym) | |
| 3091 { | |
| 3092 /* does not take into account variable aliasing. */ | |
| 3093 Lisp_Object valcontents = XSYMBOL (sym)->value; | |
| 3094 enum lisp_magic_handler slot; | |
| 3095 | |
| 3096 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents)) | |
| 3097 return 0; | |
| 3098 slot = handler_type_from_function_symbol (funsym, 1); | |
| 3099 if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND | |
| 3100 && slot != MAGIC_HANDLER_MAKE_LOCAL) | |
| 3101 /* #### temporary kludge because we haven't implemented | |
| 3102 lisp-magic variables completely */ | |
| 3103 return 0; | |
| 3104 return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]); | |
| 3105 } | |
| 3106 | |
| 3107 static Lisp_Object | |
| 3108 fetch_value_maybe_past_magic (Lisp_Object sym, | |
| 3109 Lisp_Object follow_past_lisp_magic) | |
| 3110 { | |
| 3111 Lisp_Object value = XSYMBOL (sym)->value; | |
| 3112 if (SYMBOL_VALUE_LISP_MAGIC_P (value) | |
| 3113 && (EQ (follow_past_lisp_magic, Qt) | |
| 3114 || (!NILP (follow_past_lisp_magic) | |
| 3115 && !would_be_magic_handled (sym, follow_past_lisp_magic)))) | |
| 3116 value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed; | |
| 3117 return value; | |
| 3118 } | |
| 3119 | |
| 3120 static Lisp_Object * | |
| 3121 value_slot_past_magic (Lisp_Object sym) | |
| 3122 { | |
| 3123 Lisp_Object *store_pointer = &XSYMBOL (sym)->value; | |
| 3124 | |
| 3125 if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer)) | |
| 3126 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed; | |
| 3127 return store_pointer; | |
| 3128 } | |
| 3129 | |
| 3130 static Lisp_Object | |
| 3131 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...) | |
| 3132 { | |
| 3133 va_list vargs; | |
| 3134 Lisp_Object args[20]; /* should be enough ... */ | |
| 3135 int i; | |
| 3136 enum lisp_magic_handler htype; | |
| 3137 Lisp_Object legerdemain; | |
| 3138 struct symbol_value_lisp_magic *bfwd; | |
| 3139 | |
| 440 | 3140 assert (nargs >= 0 && nargs < countof (args)); |
| 428 | 3141 legerdemain = XSYMBOL (sym)->value; |
| 3142 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain)); | |
| 3143 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain); | |
| 3144 | |
| 3145 va_start (vargs, nargs); | |
| 3146 for (i = 0; i < nargs; i++) | |
| 3147 args[i] = va_arg (vargs, Lisp_Object); | |
| 3148 va_end (vargs); | |
| 3149 | |
| 3150 htype = handler_type_from_function_symbol (funsym, 1); | |
| 3151 if (NILP (bfwd->handler[htype])) | |
| 3152 return Qunbound; | |
| 3153 /* #### should be reusing the arglist, not always consing anew. | |
| 3154 Repeated handler invocations should not cause repeated consing. | |
| 3155 Doesn't matter for now, because this is just a quick implementation | |
| 3156 for obsolescence support. */ | |
| 3157 return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym, | |
| 3158 bfwd->harg[htype], Qnil); | |
| 3159 } | |
| 3160 | |
| 3161 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler, | |
| 3162 3, 5, 0, /* | |
| 3163 Don't you dare use this. | |
| 3164 If you do, suffer the wrath of Ben, who is likely to rename | |
| 3165 this function (or change the semantics of its arguments) without | |
| 3166 pity, thereby invalidating your code. | |
| 3167 */ | |
| 2286 | 3168 (variable, handler_type, handler, harg, |
|
4642
48b45a606961
Support #'function-arglist with built-in special forms.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4535
diff
changeset
|
3169 UNUSED (keep_existing ))) |
| 428 | 3170 { |
| 3171 Lisp_Object valcontents; | |
| 3172 struct symbol_value_lisp_magic *bfwd; | |
| 3173 enum lisp_magic_handler htype; | |
| 3174 int i; | |
| 3175 | |
| 3176 /* #### WARNING, only some handler types are implemented. See above. | |
| 3177 Actions of other types will ignore a handler if it's there. | |
| 3178 | |
| 3179 #### Also, `chain-to-symbol-value-handler' and | |
| 3180 `symbol-function-corresponding-function' are not implemented. */ | |
| 3181 CHECK_SYMBOL (variable); | |
| 3182 CHECK_SYMBOL (handler_type); | |
| 3183 htype = decode_magic_handler_type (handler_type); | |
| 3184 valcontents = XSYMBOL (variable)->value; | |
| 3185 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents)) | |
| 3186 { | |
| 3017 | 3187 bfwd = ALLOC_LCRECORD_TYPE (struct symbol_value_lisp_magic, |
| 428 | 3188 &lrecord_symbol_value_lisp_magic); |
| 3189 bfwd->magic.type = SYMVAL_LISP_MAGIC; | |
| 3190 for (i = 0; i < MAGIC_HANDLER_MAX; i++) | |
| 3191 { | |
| 3192 bfwd->handler[i] = Qnil; | |
| 3193 bfwd->harg[i] = Qnil; | |
| 3194 } | |
| 3195 bfwd->shadowed = valcontents; | |
| 793 | 3196 XSYMBOL (variable)->value = wrap_symbol_value_magic (bfwd); |
| 428 | 3197 } |
| 3198 else | |
| 3199 bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents); | |
| 3200 bfwd->handler[htype] = handler; | |
| 3201 bfwd->harg[htype] = harg; | |
| 3202 | |
| 3203 for (i = 0; i < MAGIC_HANDLER_MAX; i++) | |
| 3204 if (!NILP (bfwd->handler[i])) | |
| 3205 break; | |
| 3206 | |
| 3207 if (i == MAGIC_HANDLER_MAX) | |
| 3208 /* there are no remaining handlers, so remove the structure. */ | |
| 3209 XSYMBOL (variable)->value = bfwd->shadowed; | |
| 3210 | |
| 3211 return Qnil; | |
| 3212 } | |
| 3213 | |
| 3214 | |
| 3215 /* functions for working with variable aliases. */ | |
| 3216 | |
| 3217 /* Follow the chain of variable aliases for SYMBOL. Return the | |
| 3218 resulting symbol, whose value cell is guaranteed not to be a | |
| 3219 symbol-value-varalias. | |
| 3220 | |
| 3221 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias. | |
| 3222 If FUNSYM is t, always follow in such a case. If FUNSYM is nil, | |
| 3223 never follow; stop right there. Otherwise FUNSYM should be a | |
| 3224 recognized symbol-value function symbol; this means, follow | |
| 3225 unless there is a special handler for the named function. | |
| 3226 | |
| 3227 OK, there is at least one reason why it's necessary for | |
| 3228 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we | |
| 3229 can always be sure to catch cyclic variable aliasing. If we never | |
| 3230 follow past Lisp magic, then if the following is done: | |
| 3231 | |
| 3232 (defvaralias 'a 'b) | |
| 3233 add some magic behavior to a, but not a "get-value" handler | |
| 3234 (defvaralias 'b 'a) | |
| 3235 | |
| 3236 then an attempt to retrieve a's or b's value would cause infinite | |
| 3237 looping in `symbol-value'. | |
| 3238 | |
| 3239 We (of course) can't always follow past Lisp magic, because then | |
| 3240 we make any variable that is lisp-magic -> varalias behave as if | |
| 3241 the lisp-magic is not present at all. | |
| 3242 */ | |
| 3243 | |
| 3244 static Lisp_Object | |
| 3245 follow_varalias_pointers (Lisp_Object symbol, | |
| 3246 Lisp_Object follow_past_lisp_magic) | |
| 3247 { | |
| 3248 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16 | |
| 3249 Lisp_Object tortoise, hare, val; | |
| 3250 int count; | |
| 3251 | |
| 3252 /* quick out just in case */ | |
| 3253 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value)) | |
| 3254 return symbol; | |
| 3255 | |
| 3256 /* Compare implementation of indirect_function(). */ | |
| 3257 for (hare = tortoise = symbol, count = 0; | |
| 3258 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic), | |
| 3259 SYMBOL_VALUE_VARALIAS_P (val); | |
| 3260 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)), | |
| 3261 count++) | |
| 3262 { | |
| 3263 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue; | |
| 3264 | |
| 3265 if (count & 1) | |
| 3266 tortoise = symbol_value_varalias_aliasee | |
| 3267 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic | |
| 3268 (tortoise, follow_past_lisp_magic))); | |
| 3269 if (EQ (hare, tortoise)) | |
| 3270 return Fsignal (Qcyclic_variable_indirection, list1 (symbol)); | |
| 3271 } | |
| 3272 | |
| 3273 return hare; | |
| 3274 } | |
| 3275 | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3276 /* Map FN over the chain of variable aliases for SYMBOL. If FN returns |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3277 something other than Qzero for some link in the chain, return that |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3278 immediately. Otherwise return Qzero (which is not a symbol). |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3279 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3280 FN may be called twice on the same symbol if the varalias chain is |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3281 cyclic. Prevent this by calling follow_varalias_pointers first for its |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3282 side-effects. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3283 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3284 Signals a cyclic-variable-indirection error if a cyclic structure is |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3285 detected. */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3286 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3287 static Lisp_Object |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3288 map_varalias_chain (Lisp_Object symbol, |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3289 Lisp_Object follow_past_lisp_magic, |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3290 Lisp_Object (*fn) (Lisp_Object arg)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3291 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3292 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3293 Lisp_Object tortoise, hare, val, res; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3294 int count; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3295 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3296 assert (fn); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3297 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3298 /* quick out just in case */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3299 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3300 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3301 return (fn)(symbol); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3302 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3303 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3304 /* Compare implementation of indirect_function(). */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3305 for (hare = tortoise = symbol, count = 0; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3306 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic), |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3307 SYMBOL_VALUE_VARALIAS_P (val); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3308 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)), |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3309 count++) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3310 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3311 res = (fn) (hare); |
|
4503
af95657e0bfd
Use EQ() and !EQ() in symbols.c, thank you Robert Delius Royar.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4502
diff
changeset
|
3312 if (!EQ (Qzero, res)) |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3313 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3314 return res; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3315 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3316 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3317 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3318 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3319 if (count & 1) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3320 tortoise = symbol_value_varalias_aliasee |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3321 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3322 (tortoise, follow_past_lisp_magic))); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3323 if (EQ (hare, tortoise)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3324 return Fsignal (Qcyclic_variable_indirection, list1 (symbol)); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3325 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3326 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3327 return (fn) (hare); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3328 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3329 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3330 /* |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3331 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3332 OED entry, 2nd edition, IPA transliterated using Kirshenbaum: |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3333 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3334 alias ('eIlI@s, '&lI@s), adv. and n. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3335 [...] |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3336 B. n. (with pl. aliases.) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3337 1. Another name, an assumed name. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3338 1605 Camden Rem. (1614) 147 An Alias or double name cannot preiudice the honest. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3339 1831 Edin. Rev. LIII. 364 He has been assuming various aliases. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3340 1861 Macaulay Hist. Eng. V. 92 The monk who was sometimes called Harrison |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3341 and sometimes went by the alias of Johnson. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3342 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3343 The alias is the fake name. Let's try to follow that usage in our |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3344 documentation. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3345 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3346 */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3347 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3348 DEFUN ("defvaralias", Fdefvaralias, 2, 3, 0, /* |
| 428 | 3349 Define a variable as an alias for another variable. |
| 3350 Thenceforth, any operations performed on VARIABLE will actually be | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3351 performed on ALIASED. Both VARIABLE and ALIASED should be symbols. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3352 If ALIASED is nil and VARIABLE is an existing alias, remove that alias. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3353 ALIASED can itself be an alias, and the chain of variable aliases |
| 428 | 3354 will be followed appropriately. |
| 3355 If VARIABLE already has a value, this value will be shadowed | |
| 3356 until the alias is removed, at which point it will be restored. | |
| 3357 Currently VARIABLE cannot be a built-in variable, a variable that | |
| 3358 has a buffer-local value in any buffer, or the symbols nil or t. | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3359 \(ALIASED, however, can be any type of variable.) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3360 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3361 Optional argument DOCSTRING is documentation for VARIABLE in its use as an |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3362 alias for ALIASED. The XEmacs help code ignores this documentation, using |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3363 the documentation of ALIASED instead, and the docstring, if specified, is |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3364 not shadowed in the same way that the value is. Only use it if you know |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3365 what you're doing. |
| 428 | 3366 */ |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3367 (variable, aliased, docstring)) |
| 428 | 3368 { |
| 3369 struct symbol_value_varalias *bfwd; | |
| 3370 Lisp_Object valcontents; | |
| 3371 | |
| 3372 CHECK_SYMBOL (variable); | |
| 3373 reject_constant_symbols (variable, Qunbound, 0, Qt); | |
| 3374 | |
| 3375 valcontents = XSYMBOL (variable)->value; | |
| 3376 | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3377 if (NILP (aliased)) |
| 428 | 3378 { |
| 3379 if (SYMBOL_VALUE_VARALIAS_P (valcontents)) | |
| 3380 { | |
| 3381 XSYMBOL (variable)->value = | |
| 3382 symbol_value_varalias_shadowed | |
| 3383 (XSYMBOL_VALUE_VARALIAS (valcontents)); | |
| 3384 } | |
| 3385 return Qnil; | |
| 3386 } | |
| 3387 | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3388 CHECK_SYMBOL (aliased); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3389 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3390 if (!NILP (docstring)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3391 Fput (variable, Qvariable_documentation, docstring); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3392 |
| 428 | 3393 if (SYMBOL_VALUE_VARALIAS_P (valcontents)) |
| 3394 { | |
| 3395 /* transmogrify */ | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3396 XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = aliased; |
| 428 | 3397 return Qnil; |
| 3398 } | |
| 3399 | |
| 3400 if (SYMBOL_VALUE_MAGIC_P (valcontents) | |
| 3401 && !UNBOUNDP (valcontents)) | |
| 563 | 3402 invalid_change ("Variable is magic and cannot be aliased", variable); |
| 428 | 3403 reject_constant_symbols (variable, Qunbound, 0, Qt); |
| 3404 | |
| 3017 | 3405 bfwd = ALLOC_LCRECORD_TYPE (struct symbol_value_varalias, |
| 428 | 3406 &lrecord_symbol_value_varalias); |
| 3407 bfwd->magic.type = SYMVAL_VARALIAS; | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3408 bfwd->aliasee = aliased; |
| 428 | 3409 bfwd->shadowed = valcontents; |
| 3410 | |
| 793 | 3411 valcontents = wrap_symbol_value_magic (bfwd); |
| 428 | 3412 XSYMBOL (variable)->value = valcontents; |
| 3413 return Qnil; | |
| 3414 } | |
| 3415 | |
| 3416 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /* | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3417 If VARIABLE is an alias of another variable, return that variable. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3418 VARIABLE should be a symbol. If VARIABLE is not an alias, return nil. |
| 428 | 3419 Variable aliases are created with `defvaralias'. See also |
| 3420 `indirect-variable'. | |
| 3421 */ | |
| 3422 (variable, follow_past_lisp_magic)) | |
| 3423 { | |
| 3424 Lisp_Object valcontents; | |
| 3425 | |
| 3426 CHECK_SYMBOL (variable); | |
| 3427 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt)) | |
| 3428 { | |
| 3429 CHECK_SYMBOL (follow_past_lisp_magic); | |
| 3430 handler_type_from_function_symbol (follow_past_lisp_magic, 0); | |
| 3431 } | |
| 3432 | |
| 3433 valcontents = fetch_value_maybe_past_magic (variable, | |
| 3434 follow_past_lisp_magic); | |
| 3435 | |
| 3436 if (SYMBOL_VALUE_VARALIAS_P (valcontents)) | |
| 3437 return symbol_value_varalias_aliasee | |
| 3438 (XSYMBOL_VALUE_VARALIAS (valcontents)); | |
| 3439 else | |
| 3440 return Qnil; | |
| 3441 } | |
| 3442 | |
| 3443 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /* | |
| 3444 Return the variable at the end of OBJECT's variable-alias chain. | |
| 3445 If OBJECT is a symbol, follow all variable aliases and return | |
| 3446 the final (non-aliased) symbol. Variable aliases are created with | |
| 3447 the function `defvaralias'. | |
| 3448 If OBJECT is not a symbol, just return it. | |
| 3449 Signal a cyclic-variable-indirection error if there is a loop in the | |
| 3450 variable chain of symbols. | |
| 3451 */ | |
| 3452 (object, follow_past_lisp_magic)) | |
| 3453 { | |
| 3454 if (!SYMBOLP (object)) | |
| 3455 return object; | |
| 3456 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt)) | |
| 3457 { | |
| 3458 CHECK_SYMBOL (follow_past_lisp_magic); | |
| 3459 handler_type_from_function_symbol (follow_past_lisp_magic, 0); | |
| 3460 } | |
| 3461 return follow_varalias_pointers (object, follow_past_lisp_magic); | |
| 3462 } | |
| 3463 | |
| 1674 | 3464 DEFUN ("variable-binding-locus", Fvariable_binding_locus, 1, 1, 0, /* |
| 3465 Return a value indicating where VARIABLE's current binding comes from. | |
| 3466 If the current binding is buffer-local, the value is the current buffer. | |
| 3467 If the current binding is global (the default), the value is nil. | |
| 3468 */ | |
| 3469 (variable)) | |
| 3470 { | |
| 3471 Lisp_Object valcontents; | |
| 3472 | |
| 3473 CHECK_SYMBOL (variable); | |
| 3474 variable = Findirect_variable (variable, Qnil); | |
| 3475 | |
| 3476 /* Make sure the current binding is actually swapped in. */ | |
| 3477 find_symbol_value (variable); | |
| 3478 | |
| 3479 valcontents = XSYMBOL (variable)->value; | |
| 3480 | |
| 3481 if (SYMBOL_VALUE_MAGIC_P (valcontents) | |
| 3482 && ((XSYMBOL_VALUE_MAGIC_TYPE (valcontents) == SYMVAL_BUFFER_LOCAL) | |
| 3483 || (XSYMBOL_VALUE_MAGIC_TYPE (valcontents) == SYMVAL_SOME_BUFFER_LOCAL)) | |
| 3484 && (!NILP (Flocal_variable_p (variable, Fcurrent_buffer (), Qnil)))) | |
| 3485 return Fcurrent_buffer (); | |
| 3486 else | |
| 3487 return Qnil; | |
| 3488 } | |
| 428 | 3489 |
| 3490 /************************************************************************/ | |
| 3491 /* initialization */ | |
| 3492 /************************************************************************/ | |
| 3493 | |
| 3494 /* A dumped XEmacs image has a lot more than 1511 symbols. Last | |
| 3495 estimate was that there were actually around 6300. So let's try | |
| 3496 making this bigger and see if we get better hashing behavior. */ | |
| 3497 #define OBARRAY_SIZE 16411 | |
| 3498 | |
| 3499 #ifndef Qzero | |
| 3500 Lisp_Object Qzero; | |
| 3501 #endif | |
| 3502 #ifndef Qnull_pointer | |
| 3503 Lisp_Object Qnull_pointer; | |
| 3504 #endif | |
| 3505 | |
| 3263 | 3506 #ifndef NEW_GC |
| 428 | 3507 /* some losing systems can't have static vars at function scope... */ |
| 442 | 3508 static const struct symbol_value_magic guts_of_unbound_marker = |
| 3509 { /* struct symbol_value_magic */ | |
| 3024 | 3510 { /* struct old_lcrecord_header */ |
| 442 | 3511 { /* struct lrecord_header */ |
| 3512 lrecord_type_symbol_value_forward, /* lrecord_type_index */ | |
| 3513 1, /* mark bit */ | |
| 3514 1, /* c_readonly bit */ | |
| 3515 1, /* lisp_readonly bit */ | |
| 3516 }, | |
| 3517 0, /* next */ | |
| 3518 0, /* uid */ | |
| 3519 0, /* free */ | |
| 3520 }, | |
| 3521 0, /* value */ | |
| 3522 SYMVAL_UNBOUND_MARKER | |
| 3523 }; | |
| 3263 | 3524 #endif /* not NEW_GC */ |
| 428 | 3525 |
| 3526 void | |
| 3527 init_symbols_once_early (void) | |
| 3528 { | |
| 442 | 3529 INIT_LRECORD_IMPLEMENTATION (symbol); |
| 3530 INIT_LRECORD_IMPLEMENTATION (symbol_value_forward); | |
| 3531 INIT_LRECORD_IMPLEMENTATION (symbol_value_buffer_local); | |
| 3532 INIT_LRECORD_IMPLEMENTATION (symbol_value_lisp_magic); | |
| 3533 INIT_LRECORD_IMPLEMENTATION (symbol_value_varalias); | |
| 3534 | |
| 1204 | 3535 reinit_symbols_early (); |
| 428 | 3536 |
| 3537 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is | |
| 3538 called the first time. */ | |
| 867 | 3539 Qnil = Fmake_symbol (make_string_nocopy ((const Ibyte *) "nil", 3)); |
| 793 | 3540 XSTRING_PLIST (XSYMBOL (Qnil)->name) = Qnil; |
| 428 | 3541 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */ |
| 3542 XSYMBOL (Qnil)->plist = Qnil; | |
| 3543 | |
| 3544 Vobarray = make_vector (OBARRAY_SIZE, Qzero); | |
| 3545 initial_obarray = Vobarray; | |
| 3546 staticpro (&initial_obarray); | |
| 3547 /* Intern nil in the obarray */ | |
| 3548 { | |
| 793 | 3549 unsigned int hash = hash_string (XSTRING_DATA (XSYMBOL (Qnil)->name), 3); |
| 428 | 3550 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil; |
| 3551 } | |
| 3552 | |
| 3553 { | |
| 3554 /* Required to get around a GCC syntax error on certain | |
| 3555 architectures */ | |
| 3263 | 3556 #ifdef NEW_GC |
| 2720 | 3557 struct symbol_value_magic *tem = (struct symbol_value_magic *) |
| 3558 mc_alloc (sizeof (struct symbol_value_magic)); | |
| 3559 MARK_LRECORD_AS_LISP_READONLY (tem); | |
| 3560 MARK_LRECORD_AS_NOT_FREE (tem); | |
| 3561 tem->header.type = lrecord_type_symbol_value_forward; | |
| 3562 mcpro (wrap_pointer_1 (tem)); | |
| 3563 tem->value = 0; | |
| 3564 tem->type = SYMVAL_UNBOUND_MARKER; | |
| 2994 | 3565 #ifdef ALLOC_TYPE_STATS |
| 2775 | 3566 inc_lrecord_stats (sizeof (struct symbol_value_magic), |
| 3567 (const struct lrecord_header *) tem); | |
| 2994 | 3568 #endif /* ALLOC_TYPE_STATS */ |
| 3263 | 3569 #else /* not NEW_GC */ |
| 442 | 3570 const struct symbol_value_magic *tem = &guts_of_unbound_marker; |
| 3263 | 3571 #endif /* not NEW_GC */ |
| 428 | 3572 |
| 793 | 3573 Qunbound = wrap_symbol_value_magic (tem); |
| 428 | 3574 } |
| 3575 | |
| 3576 XSYMBOL (Qnil)->function = Qunbound; | |
| 3577 | |
| 563 | 3578 DEFSYMBOL (Qt); |
| 444 | 3579 XSYMBOL (Qt)->value = Qt; /* Veritas aeterna */ |
| 428 | 3580 Vquit_flag = Qnil; |
| 3581 | |
| 1204 | 3582 dump_add_root_lisp_object (&Qnil); |
| 3583 dump_add_root_lisp_object (&Qunbound); | |
| 3584 dump_add_root_lisp_object (&Vquit_flag); | |
| 428 | 3585 } |
| 3586 | |
| 3587 void | |
| 1204 | 3588 reinit_symbols_early (void) |
| 440 | 3589 { |
| 3590 } | |
| 3591 | |
| 442 | 3592 static void |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3593 defsymbol_massage_name_1 (Lisp_Object *location, const Ascbyte *name, int dump_p, |
| 442 | 3594 int multiword_predicate_p) |
| 3595 { | |
| 3596 char temp[500]; | |
| 3597 int len = strlen (name) - 1; | |
| 3598 int i; | |
| 3599 | |
| 3600 if (multiword_predicate_p) | |
| 647 | 3601 assert (len + 1 < (int) sizeof (temp)); |
| 442 | 3602 else |
| 647 | 3603 assert (len < (int) sizeof (temp)); |
| 442 | 3604 strcpy (temp, name + 1); /* Remove initial Q */ |
| 3605 if (multiword_predicate_p) | |
| 3606 { | |
| 3607 strcpy (temp + len - 1, "_p"); | |
| 3608 len++; | |
| 3609 } | |
| 3610 for (i = 0; i < len; i++) | |
| 3611 if (temp[i] == '_') | |
| 3612 temp[i] = '-'; | |
| 867 | 3613 *location = Fintern (make_string ((const Ibyte *) temp, len), Qnil); |
| 442 | 3614 if (dump_p) |
| 3615 staticpro (location); | |
| 3616 else | |
| 3617 staticpro_nodump (location); | |
| 3618 } | |
| 3619 | |
| 440 | 3620 void |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3621 defsymbol_massage_name_nodump (Lisp_Object *location, const Ascbyte *name) |
| 442 | 3622 { |
| 3623 defsymbol_massage_name_1 (location, name, 0, 0); | |
| 3624 } | |
| 3625 | |
| 3626 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3627 defsymbol_massage_name (Lisp_Object *location, const Ascbyte *name) |
| 428 | 3628 { |
| 442 | 3629 defsymbol_massage_name_1 (location, name, 1, 0); |
| 3630 } | |
| 3631 | |
| 3632 void | |
| 3633 defsymbol_massage_multiword_predicate_nodump (Lisp_Object *location, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3634 const Ascbyte *name) |
| 442 | 3635 { |
| 3636 defsymbol_massage_name_1 (location, name, 0, 1); | |
| 3637 } | |
| 3638 | |
| 3639 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3640 defsymbol_massage_multiword_predicate (Lisp_Object *location, const Ascbyte *name) |
| 442 | 3641 { |
| 3642 defsymbol_massage_name_1 (location, name, 1, 1); | |
| 3643 } | |
| 3644 | |
| 3645 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3646 defsymbol_nodump (Lisp_Object *location, const Ascbyte *name) |
| 442 | 3647 { |
| 867 | 3648 *location = Fintern (make_string_nocopy ((const Ibyte *) name, |
| 428 | 3649 strlen (name)), |
| 3650 Qnil); | |
| 3651 staticpro_nodump (location); | |
| 3652 } | |
| 3653 | |
| 3654 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3655 defsymbol (Lisp_Object *location, const Ascbyte *name) |
| 428 | 3656 { |
| 867 | 3657 *location = Fintern (make_string_nocopy ((const Ibyte *) name, |
| 428 | 3658 strlen (name)), |
| 3659 Qnil); | |
| 3660 staticpro (location); | |
| 3661 } | |
| 3662 | |
| 3663 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3664 defkeyword (Lisp_Object *location, const Ascbyte *name) |
| 428 | 3665 { |
| 3666 defsymbol (location, name); | |
| 3667 Fset (*location, *location); | |
| 3668 } | |
| 3669 | |
| 442 | 3670 void |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3671 defkeyword_massage_name (Lisp_Object *location, const Ascbyte *name) |
| 442 | 3672 { |
| 3673 char temp[500]; | |
| 3674 int len = strlen (name); | |
| 3675 | |
| 647 | 3676 assert (len < (int) sizeof (temp)); |
| 442 | 3677 strcpy (temp, name); |
| 3678 temp[1] = ':'; /* it's an underscore in the C variable */ | |
| 3679 | |
| 3680 defsymbol_massage_name (location, temp); | |
| 3681 Fset (*location, *location); | |
| 3682 } | |
| 3683 | |
| 428 | 3684 #ifdef DEBUG_XEMACS |
| 930 | 3685 /* Check that nobody spazzed writing a builtin (non-module) DEFUN. */ |
| 428 | 3686 static void |
| 3687 check_sane_subr (Lisp_Subr *subr, Lisp_Object sym) | |
| 3688 { | |
| 930 | 3689 if (!initialized) { |
| 3690 assert (subr->min_args >= 0); | |
| 3691 assert (subr->min_args <= SUBR_MAX_ARGS); | |
| 3692 | |
| 3693 if (subr->max_args != MANY && | |
| 3694 subr->max_args != UNEVALLED) | |
| 3695 { | |
| 3696 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */ | |
| 3697 assert (subr->max_args <= SUBR_MAX_ARGS); | |
| 3698 assert (subr->min_args <= subr->max_args); | |
| 3699 } | |
| 3700 assert (UNBOUNDP (XSYMBOL (sym)->function)); | |
| 3701 } | |
| 428 | 3702 } |
| 3703 #else | |
| 3704 #define check_sane_subr(subr, sym) /* nothing */ | |
| 3705 #endif | |
| 3706 | |
| 3707 #ifdef HAVE_SHLIB | |
| 3263 | 3708 #ifndef NEW_GC |
| 428 | 3709 /* |
| 3710 * If we are not in a pure undumped Emacs, we need to make a duplicate of | |
| 3711 * the subr. This is because the only time this function will be called | |
| 3712 * in a running Emacs is when a dynamically loaded module is adding a | |
| 3713 * subr, and we need to make sure that the subr is in allocated, Lisp- | |
| 3714 * accessible memory. The address assigned to the static subr struct | |
| 3715 * in the shared object will be a trampoline address, so we need to create | |
| 3716 * a copy here to ensure that a real address is used. | |
| 3717 * | |
| 3718 * Once we have copied everything across, we re-use the original static | |
| 3719 * structure to store a pointer to the newly allocated one. This will be | |
| 3720 * used in emodules.c by emodules_doc_subr() to find a pointer to the | |
| 442 | 3721 * allocated object so that we can set its doc string properly. |
| 428 | 3722 * |
| 442 | 3723 * NOTE: We don't actually use the DOC pointer here any more, but we did |
| 428 | 3724 * in an earlier implementation of module support. There is no harm in |
| 3725 * setting it here in case we ever need it in future implementations. | |
| 3726 * subr->doc will point to the new subr structure that was allocated. | |
| 442 | 3727 * Code can then get this value from the static subr structure and use |
| 428 | 3728 * it if required. |
| 3729 * | |
| 442 | 3730 * FIXME: Should newsubr be staticpro()'ed? I don't think so but I need |
| 428 | 3731 * a guru to check. |
| 3732 */ | |
| 930 | 3733 #define check_module_subr(subr) \ |
| 3734 do { \ | |
| 3735 if (initialized) { \ | |
| 3736 Lisp_Subr *newsubr; \ | |
| 3737 Lisp_Object f; \ | |
| 3738 \ | |
| 3739 if (subr->min_args < 0) \ | |
| 3740 signal_ferror (Qdll_error, "%s min_args (%hd) too small", \ | |
| 3741 subr_name (subr), subr->min_args); \ | |
| 3742 if (subr->min_args > SUBR_MAX_ARGS) \ | |
| 3743 signal_ferror (Qdll_error, "%s min_args (%hd) too big (max = %d)", \ | |
| 3744 subr_name (subr), subr->min_args, SUBR_MAX_ARGS); \ | |
| 3745 \ | |
| 3746 if (subr->max_args != MANY && \ | |
| 3747 subr->max_args != UNEVALLED) \ | |
| 3748 { \ | |
| 3749 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */ \ | |
| 3750 if (subr->max_args > SUBR_MAX_ARGS) \ | |
| 3751 signal_ferror (Qdll_error, "%s max_args (%hd) too big (max = %d)", \ | |
| 3752 subr_name (subr), subr->max_args, SUBR_MAX_ARGS); \ | |
| 3753 if (subr->min_args > subr->max_args) \ | |
| 3754 signal_ferror (Qdll_error, "%s min_args (%hd) > max_args (%hd)", \ | |
| 3755 subr_name (subr), subr->min_args, subr->max_args); \ | |
| 3756 } \ | |
| 3757 \ | |
| 3758 f = XSYMBOL (sym)->function; \ | |
| 3759 if (!UNBOUNDP (f) && (!CONSP (f) || !EQ (XCAR (f), Qautoload))) \ | |
| 3760 signal_ferror (Qdll_error, "Attempt to redefine %s", subr_name (subr)); \ | |
| 3761 \ | |
| 2367 | 3762 newsubr = xnew (Lisp_Subr); \ |
| 930 | 3763 memcpy (newsubr, subr, sizeof (Lisp_Subr)); \ |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3764 subr->doc = (const CIbyte *)newsubr; \ |
| 930 | 3765 subr = newsubr; \ |
| 3766 } \ | |
| 428 | 3767 } while (0) |
| 3263 | 3768 #else /* NEW_GC */ |
| 2963 | 3769 /* |
| 3770 * If we have the new allocator enabled, we do not need to make a | |
| 3771 * duplicate of the subr. The new allocator already does allocate all | |
| 3772 * subrs in Lisp-accessible memory rather than have it in the static | |
| 3773 * subr struct. | |
| 3774 * | |
| 3775 * NOTE: The DOC pointer is not set here as described above. | |
| 3776 */ | |
| 3777 #define check_module_subr(subr) \ | |
| 3778 do { \ | |
| 3779 if (initialized) { \ | |
| 3780 Lisp_Object f; \ | |
| 3781 \ | |
| 3782 if (subr->min_args < 0) \ | |
| 3783 signal_ferror (Qdll_error, "%s min_args (%hd) too small", \ | |
| 3784 subr_name (subr), subr->min_args); \ | |
| 3785 if (subr->min_args > SUBR_MAX_ARGS) \ | |
| 3786 signal_ferror (Qdll_error, "%s min_args (%hd) too big (max = %d)", \ | |
| 3787 subr_name (subr), subr->min_args, SUBR_MAX_ARGS); \ | |
| 3788 \ | |
| 3789 if (subr->max_args != MANY && \ | |
| 3790 subr->max_args != UNEVALLED) \ | |
| 3791 { \ | |
| 3792 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */ \ | |
| 3793 if (subr->max_args > SUBR_MAX_ARGS) \ | |
| 3794 signal_ferror (Qdll_error, "%s max_args (%hd) too big (max = %d)", \ | |
| 3795 subr_name (subr), subr->max_args, SUBR_MAX_ARGS); \ | |
| 3796 if (subr->min_args > subr->max_args) \ | |
| 3797 signal_ferror (Qdll_error, "%s min_args (%hd) > max_args (%hd)", \ | |
| 3798 subr_name (subr), subr->min_args, subr->max_args); \ | |
| 3799 } \ | |
| 3800 \ | |
| 3801 f = XSYMBOL (sym)->function; \ | |
| 3802 if (!UNBOUNDP (f) && (!CONSP (f) || !EQ (XCAR (f), Qautoload))) \ | |
| 3803 signal_ferror (Qdll_error, "Attempt to redefine %s", subr_name (subr)); \ | |
| 3804 } \ | |
| 3805 } while (0) | |
| 3263 | 3806 #endif /* NEW_GC */ |
| 428 | 3807 #else /* ! HAVE_SHLIB */ |
| 930 | 3808 #define check_module_subr(subr) |
| 428 | 3809 #endif |
| 3810 | |
| 3811 void | |
| 3812 defsubr (Lisp_Subr *subr) | |
| 3813 { | |
| 3814 Lisp_Object sym = intern (subr_name (subr)); | |
| 3815 Lisp_Object fun; | |
| 3816 | |
| 3817 check_sane_subr (subr, sym); | |
| 930 | 3818 check_module_subr (subr); |
| 428 | 3819 |
| 793 | 3820 fun = wrap_subr (subr); |
| 428 | 3821 XSYMBOL (sym)->function = fun; |
| 996 | 3822 |
| 3823 #ifdef HAVE_SHLIB | |
| 3824 /* If it is declared in a module, update the load history */ | |
| 3825 if (initialized) | |
| 3826 LOADHIST_ATTACH (sym); | |
| 3827 #endif | |
| 428 | 3828 } |
| 3829 | |
| 3830 /* Define a lisp macro using a Lisp_Subr. */ | |
| 3831 void | |
| 3832 defsubr_macro (Lisp_Subr *subr) | |
| 3833 { | |
| 3834 Lisp_Object sym = intern (subr_name (subr)); | |
| 3835 Lisp_Object fun; | |
| 3836 | |
| 3837 check_sane_subr (subr, sym); | |
| 930 | 3838 check_module_subr (subr); |
| 428 | 3839 |
| 793 | 3840 fun = wrap_subr (subr); |
| 428 | 3841 XSYMBOL (sym)->function = Fcons (Qmacro, fun); |
| 996 | 3842 |
| 3843 #ifdef HAVE_SHLIB | |
| 3844 /* If it is declared in a module, update the load history */ | |
| 3845 if (initialized) | |
| 3846 LOADHIST_ATTACH (sym); | |
| 3847 #endif | |
| 428 | 3848 } |
| 3849 | |
| 442 | 3850 static void |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3851 deferror_1 (Lisp_Object *symbol, const Ascbyte *name, const Ascbyte *messuhhj, |
| 442 | 3852 Lisp_Object inherits_from, int massage_p) |
| 428 | 3853 { |
| 3854 Lisp_Object conds; | |
| 442 | 3855 if (massage_p) |
| 3856 defsymbol_massage_name (symbol, name); | |
| 3857 else | |
| 3858 defsymbol (symbol, name); | |
| 428 | 3859 |
| 3860 assert (SYMBOLP (inherits_from)); | |
| 3861 conds = Fget (inherits_from, Qerror_conditions, Qnil); | |
| 3862 Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds)); | |
| 771 | 3863 /* NOT build_msg_string (). This function is called at load time |
| 428 | 3864 and the string needs to get translated at run time. (This happens |
| 3865 in the function (display-error) in cmdloop.el.) */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3866 Fput (*symbol, Qerror_message, build_defer_string (messuhhj)); |
| 428 | 3867 } |
| 3868 | |
| 3869 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3870 deferror (Lisp_Object *symbol, const Ascbyte *name, const Ascbyte *messuhhj, |
| 442 | 3871 Lisp_Object inherits_from) |
| 3872 { | |
| 3873 deferror_1 (symbol, name, messuhhj, inherits_from, 0); | |
| 3874 } | |
| 3875 | |
| 3876 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3877 deferror_massage_name (Lisp_Object *symbol, const Ascbyte *name, |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3878 const Ascbyte *messuhhj, Lisp_Object inherits_from) |
| 442 | 3879 { |
| 3880 deferror_1 (symbol, name, messuhhj, inherits_from, 1); | |
| 3881 } | |
| 3882 | |
| 3883 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3884 deferror_massage_name_and_message (Lisp_Object *symbol, const Ascbyte *name, |
| 442 | 3885 Lisp_Object inherits_from) |
| 3886 { | |
| 3887 char temp[500]; | |
| 3888 int i; | |
| 3889 int len = strlen (name) - 1; | |
| 3890 | |
| 647 | 3891 assert (len < (int) sizeof (temp)); |
| 442 | 3892 strcpy (temp, name + 1); /* Remove initial Q */ |
| 3893 temp[0] = toupper (temp[0]); | |
| 3894 for (i = 0; i < len; i++) | |
| 3895 if (temp[i] == '_') | |
| 3896 temp[i] = ' '; | |
| 3897 | |
| 3898 deferror_1 (symbol, name, temp, inherits_from, 1); | |
| 3899 } | |
| 3900 | |
| 3901 void | |
| 428 | 3902 syms_of_symbols (void) |
| 3903 { | |
| 442 | 3904 DEFSYMBOL (Qvariable_documentation); |
| 3905 DEFSYMBOL (Qvariable_domain); /* I18N3 */ | |
| 3906 DEFSYMBOL (Qad_advice_info); | |
| 3907 DEFSYMBOL (Qad_activate); | |
| 3908 | |
| 3909 DEFSYMBOL (Qget_value); | |
| 3910 DEFSYMBOL (Qset_value); | |
| 3911 DEFSYMBOL (Qbound_predicate); | |
| 3912 DEFSYMBOL (Qmake_unbound); | |
| 3913 DEFSYMBOL (Qlocal_predicate); | |
| 3914 DEFSYMBOL (Qmake_local); | |
| 3915 | |
| 3916 DEFSYMBOL (Qboundp); | |
| 3917 DEFSYMBOL (Qglobally_boundp); | |
| 3918 DEFSYMBOL (Qmakunbound); | |
| 3919 DEFSYMBOL (Qsymbol_value); | |
| 3920 DEFSYMBOL (Qset); | |
| 3921 DEFSYMBOL (Qsetq_default); | |
| 3922 DEFSYMBOL (Qdefault_boundp); | |
| 3923 DEFSYMBOL (Qdefault_value); | |
| 3924 DEFSYMBOL (Qset_default); | |
| 3925 DEFSYMBOL (Qmake_variable_buffer_local); | |
| 3926 DEFSYMBOL (Qmake_local_variable); | |
| 3927 DEFSYMBOL (Qkill_local_variable); | |
| 3928 DEFSYMBOL (Qkill_console_local_variable); | |
| 3929 DEFSYMBOL (Qsymbol_value_in_buffer); | |
| 3930 DEFSYMBOL (Qsymbol_value_in_console); | |
| 3931 DEFSYMBOL (Qlocal_variable_p); | |
| 3932 DEFSYMBOL (Qconst_integer); | |
| 3933 DEFSYMBOL (Qconst_boolean); | |
| 3934 DEFSYMBOL (Qconst_object); | |
| 3935 DEFSYMBOL (Qconst_specifier); | |
| 3936 DEFSYMBOL (Qdefault_buffer); | |
| 3937 DEFSYMBOL (Qcurrent_buffer); | |
| 3938 DEFSYMBOL (Qconst_current_buffer); | |
| 3939 DEFSYMBOL (Qdefault_console); | |
| 3940 DEFSYMBOL (Qselected_console); | |
| 3941 DEFSYMBOL (Qconst_selected_console); | |
| 428 | 3942 |
| 3943 DEFSUBR (Fintern); | |
| 3944 DEFSUBR (Fintern_soft); | |
| 3945 DEFSUBR (Funintern); | |
| 3946 DEFSUBR (Fmapatoms); | |
| 3947 DEFSUBR (Fapropos_internal); | |
| 3948 | |
| 3949 DEFSUBR (Fsymbol_function); | |
| 3950 DEFSUBR (Fsymbol_plist); | |
| 3951 DEFSUBR (Fsymbol_name); | |
| 3952 DEFSUBR (Fmakunbound); | |
| 3953 DEFSUBR (Ffmakunbound); | |
| 3954 DEFSUBR (Fboundp); | |
| 3955 DEFSUBR (Fglobally_boundp); | |
| 3956 DEFSUBR (Ffboundp); | |
| 3957 DEFSUBR (Ffset); | |
| 3958 DEFSUBR (Fdefine_function); | |
| 3959 Ffset (intern ("defalias"), intern ("define-function")); | |
| 3368 | 3960 DEFSUBR (Fsubr_name); |
|
4336
cdc2f70d4319
Provide #'special-form-p, for the use of advice.el, perhaps other files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3497
diff
changeset
|
3961 DEFSUBR (Fspecial_form_p); |
| 428 | 3962 DEFSUBR (Fsetplist); |
| 3963 DEFSUBR (Fsymbol_value_in_buffer); | |
| 3964 DEFSUBR (Fsymbol_value_in_console); | |
| 3965 DEFSUBR (Fbuilt_in_variable_type); | |
| 3966 DEFSUBR (Fsymbol_value); | |
| 3967 DEFSUBR (Fset); | |
| 3968 DEFSUBR (Fdefault_boundp); | |
| 3969 DEFSUBR (Fdefault_value); | |
| 3970 DEFSUBR (Fset_default); | |
| 3971 DEFSUBR (Fsetq_default); | |
| 3972 DEFSUBR (Fmake_variable_buffer_local); | |
| 3973 DEFSUBR (Fmake_local_variable); | |
| 3974 DEFSUBR (Fkill_local_variable); | |
| 3975 DEFSUBR (Fkill_console_local_variable); | |
| 3976 DEFSUBR (Flocal_variable_p); | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3977 DEFSUBR (Fcustom_variable_p); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3978 DEFSUBR (Fuser_variable_p); |
| 428 | 3979 DEFSUBR (Fdefvaralias); |
| 3980 DEFSUBR (Fvariable_alias); | |
| 3981 DEFSUBR (Findirect_variable); | |
| 1674 | 3982 DEFSUBR (Fvariable_binding_locus); |
| 428 | 3983 DEFSUBR (Fdontusethis_set_symbol_value_handler); |
| 3984 } | |
| 3985 | |
| 3986 /* Create and initialize a Lisp variable whose value is forwarded to C data */ | |
| 3987 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3988 defvar_magic (const Ascbyte *symbol_name, |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3989 const struct symbol_value_forward *magic) |
| 428 | 3990 { |
| 442 | 3991 Lisp_Object sym; |
| 428 | 3992 |
| 996 | 3993 #ifdef HAVE_SHLIB |
| 428 | 3994 /* |
| 3995 * As with defsubr(), this will only be called in a dumped Emacs when | |
| 3996 * we are adding variables from a dynamically loaded module. That means | |
| 3997 * we can't use purespace. Take that into account. | |
| 3998 */ | |
| 3999 if (initialized) | |
| 996 | 4000 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
4001 sym = Fintern (build_ascstring (symbol_name), Qnil); |
| 996 | 4002 LOADHIST_ATTACH (sym); |
| 4003 } | |
| 428 | 4004 else |
| 4005 #endif | |
| 867 | 4006 sym = Fintern (make_string_nocopy ((const Ibyte *) symbol_name, |
| 428 | 4007 strlen (symbol_name)), Qnil); |
| 4008 | |
| 793 | 4009 XSYMBOL (sym)->value = wrap_pointer_1 (magic); |
| 428 | 4010 } |
| 4011 | |
| 4012 void | |
| 4013 vars_of_symbols (void) | |
| 4014 { | |
| 4015 DEFVAR_LISP ("obarray", &Vobarray /* | |
| 4016 Symbol table for use by `intern' and `read'. | |
| 4017 It is a vector whose length ought to be prime for best results. | |
| 4018 The vector's contents don't make sense if examined from Lisp programs; | |
| 4019 to find all the symbols in an obarray, use `mapatoms'. | |
| 4020 */ ); | |
| 4021 /* obarray has been initialized long before */ | |
| 4022 } |