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