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