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