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