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