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