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, 2000 Ben Wing.
4 Copyright (C) 2004 Steve Youngs.
6 This file is part of SXEmacs
8 SXEmacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 SXEmacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program. If not, see <http://www.gnu.org/licenses/>. */
22 /* Synched up with: FSF 19.30. */
24 /* This file has been Mule-ized. */
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:
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
41 The "chain" of a symbol-value-buffer-local is its current_value slot.
43 The "chain" of a symbol-value-lisp-magic is its shadowed slot, which
44 applies for handler types without associated handlers.
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.
51 /* #### Ugh, though, this file does awful things with symbol-value-magic
52 objects. This ought to be cleaned up. */
57 #include "buffer.h" /* for Vbuffer_defaults */
58 #include "ui/console.h"
61 Lisp_Object Qad_advice_info, Qad_activate;
63 Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound;
64 Lisp_Object Qlocal_predicate, Qmake_local;
66 Lisp_Object Qboundp, Qglobally_boundp, Qmakunbound;
67 Lisp_Object Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value;
68 Lisp_Object Qset_default, Qsetq_default;
69 Lisp_Object Qmake_variable_buffer_local, Qmake_local_variable;
70 Lisp_Object Qkill_local_variable, Qkill_console_local_variable;
71 Lisp_Object Qsymbol_value_in_buffer, Qsymbol_value_in_console;
72 Lisp_Object Qlocal_variable_p;
74 Lisp_Object Qconst_integer, Qconst_boolean, Qconst_object;
75 Lisp_Object Qconst_specifier;
76 Lisp_Object Qdefault_buffer, Qcurrent_buffer, Qconst_current_buffer;
77 Lisp_Object Qdefault_console, Qselected_console, Qconst_selected_console;
78 Lisp_Object Qsymbol_macro, Qsetf;
80 static Lisp_Object maybe_call_magic_handler(Lisp_Object sym,
81 Lisp_Object funsym, int nargs, ...);
82 static Lisp_Object fetch_value_maybe_past_magic(Lisp_Object sym,
84 follow_past_lisp_magic);
85 static Lisp_Object *value_slot_past_magic(Lisp_Object sym);
86 static Lisp_Object follow_varalias_pointers(Lisp_Object symbol,
87 Lisp_Object follow_past_lisp_magic);
89 #define USE_BURTLEBURTLE_HASH 0
90 #define USE_HSIEH_HASH 1
91 #define USE_FORMER_HASH 0
93 static Lisp_Object mark_symbol(Lisp_Object obj)
95 Lisp_Symbol *sym = XSYMBOL(obj);
98 mark_object(sym->value);
99 mark_object(sym->function);
100 XSETSTRING(pname, sym->name);
102 if (!symbol_next(sym))
105 mark_object(sym->plist);
106 /* Mark the rest of the symbols in the obarray hash-chain */
107 sym = symbol_next(sym);
108 XSETSYMBOL(obj, sym);
113 static const struct lrecord_description symbol_description[] = {
114 {XD_LISP_OBJECT, offsetof(Lisp_Symbol, next)},
115 {XD_LISP_OBJECT, offsetof(Lisp_Symbol, name)},
116 {XD_LISP_OBJECT, offsetof(Lisp_Symbol, value)},
117 {XD_LISP_OBJECT, offsetof(Lisp_Symbol, function)},
118 {XD_LISP_OBJECT, offsetof(Lisp_Symbol, plist)},
122 /* Symbol plists are directly accessible, so we need to protect against
123 invalid property list structure */
125 static Lisp_Object symbol_getprop(Lisp_Object symbol, Lisp_Object property)
127 return external_plist_get(&XSYMBOL(symbol)->plist, property, 0,
132 symbol_putprop(Lisp_Object symbol, Lisp_Object property, Lisp_Object value)
134 external_plist_put(&XSYMBOL(symbol)->plist, property, value, 0,
139 static int symbol_remprop(Lisp_Object symbol, Lisp_Object property)
141 return external_remprop(&XSYMBOL(symbol)->plist, property, 0, ERROR_ME);
144 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS("symbol", symbol,
145 mark_symbol, print_symbol,
146 0, 0, 0, symbol_description,
150 Fsymbol_plist, Lisp_Symbol);
152 /**********************************************************************/
154 /**********************************************************************/
156 /* #### using a vector here is way bogus. Use a hash table instead. */
158 Lisp_Object Vobarray;
159 Lisp_Object check_obarray(Lisp_Object obarray);
161 static Lisp_Object initial_obarray;
163 /* oblookup stores the bucket number here, for the sake of Funintern. */
165 static int oblookup_last_bucket_number;
168 check_obarray(Lisp_Object obarray)
170 while (!VECTORP(obarray) || XVECTOR_LENGTH(obarray) == 0) {
171 /* If Vobarray is now invalid, force it to be valid. */
172 if (EQ(Vobarray, obarray))
173 Vobarray = initial_obarray;
175 obarray = wrong_type_argument(Qvectorp, obarray);
180 Lisp_Object intern(const char *str)
182 Bytecount len = strlen(str);
183 const Bufbyte *buf = (const Bufbyte *)str;
184 Lisp_Object obarray = Vobarray;
186 if (!VECTORP(obarray) || XVECTOR_LENGTH(obarray) == 0)
187 obarray = check_obarray(obarray);
190 Lisp_Object tem = oblookup(obarray, buf, len);
195 return Fintern(make_string(buf, len), obarray);
198 DEFUN("intern", Fintern, 1, 2, 0, /*
199 Return the canonical symbol whose name is STRING.
200 If there is none, one is created by this function and returned.
201 Optional second argument OBARRAY specifies the obarray to use;
202 it defaults to the value of the variable `obarray'.
206 Lisp_Object object, *ptr;
212 obarray = check_obarray(obarray);
214 CHECK_STRING(string);
216 len = XSTRING_LENGTH(string);
217 object = oblookup(obarray, XSTRING_DATA(string), len);
222 ptr = &XVECTOR_DATA(obarray)[XINT(object)];
224 object = Fmake_symbol(string);
225 symbol = XSYMBOL(object);
228 symbol_next(symbol) = XSYMBOL(*ptr);
230 symbol_next(symbol) = 0;
233 if (string_byte(symbol_name(symbol), 0) == ':' && EQ(obarray, Vobarray)) {
234 /* The LISP way is to put keywords in their own package, but we
235 don't have packages, so we do something simpler. Someday,
236 maybe we'll have packages and then this will be reworked.
238 symbol_value(symbol) = object;
244 DEFUN("intern-soft", Fintern_soft, 1, 2, 0, /*
245 Return the canonical symbol named NAME, or nil if none exists.
246 NAME may be a string or a symbol. If it is a symbol, that exact
247 symbol is searched for.
248 Optional second argument OBARRAY specifies the obarray to use;
249 it defaults to the value of the variable `obarray'.
253 /* #### Bug! (intern-soft "nil") returns nil. Perhaps we should
254 add a DEFAULT-IF-NOT-FOUND arg, like in get. */
260 obarray = check_obarray(obarray);
262 if (!SYMBOLP(name)) {
264 string = XSTRING(name);
266 string = symbol_name(XSYMBOL(name));
268 tem = oblookup(obarray, string_data(string), string_length(string));
269 if (INTP(tem) || (SYMBOLP(name) && !EQ(name, tem)))
275 DEFUN("unintern", Funintern, 1, 2, 0, /*
276 Delete the symbol named NAME, if any, from OBARRAY.
277 The value is t if a symbol was found and deleted, nil otherwise.
278 NAME may be a string or a symbol. If it is a symbol, that symbol
279 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
280 OBARRAY defaults to the value of the variable `obarray'.
290 obarray = check_obarray(obarray);
293 string = symbol_name(XSYMBOL(name));
296 string = XSTRING(name);
299 tem = oblookup(obarray, string_data(string), string_length(string));
302 /* If arg was a symbol, don't delete anything but that symbol itself. */
303 if (SYMBOLP(name) && !EQ(name, tem))
306 hash = oblookup_last_bucket_number;
308 if (EQ(XVECTOR_DATA(obarray)[hash], tem)) {
309 if (XSYMBOL(tem)->next)
310 XSETSYMBOL(XVECTOR_DATA(obarray)[hash],
313 XVECTOR_DATA(obarray)[hash] = Qzero;
315 Lisp_Object tail, following;
317 for (tail = XVECTOR_DATA(obarray)[hash];
318 XSYMBOL(tail)->next; tail = following) {
319 XSETSYMBOL(following, XSYMBOL(tail)->next);
320 if (EQ(following, tem)) {
321 XSYMBOL(tail)->next = XSYMBOL(following)->next;
329 /* Return the symbol in OBARRAY whose names matches the string
330 of SIZE characters at PTR. If there is no such symbol in OBARRAY,
331 return the index into OBARRAY that the string hashes to.
333 Also store the bucket number in oblookup_last_bucket_number. */
335 Lisp_Object oblookup(Lisp_Object obarray, const Bufbyte * ptr, Bytecount size)
342 if (!VECTORP(obarray) || (obsize = XVECTOR_LENGTH(obarray)) == 0) {
343 obarray = check_obarray(obarray);
344 obsize = XVECTOR_LENGTH(obarray);
346 hash = hash_string(ptr, size) % obsize;
347 oblookup_last_bucket_number = hash;
348 bucket = XVECTOR_DATA(obarray)[hash];
351 } else if (!SYMBOLP(bucket)) {
352 /* Like CADR error message */
353 error("Bad data in guts of obarray");
355 for (tail = XSYMBOL(bucket);;) {
356 if (string_length(tail->name) == size &&
357 !memcmp(string_data(tail->name), ptr, size)) {
358 XSETSYMBOL(bucket, tail);
361 tail = symbol_next(tail);
366 return make_int(hash);
369 #if 0 /* Emacs 19.34 */
370 int hash_string(const Bufbyte * ptr, Bytecount len)
372 const Bufbyte *p = ptr;
373 const Bufbyte *end = p + len;
381 hash = ((hash << 3) + (hash >> 28) + c);
383 return hash & 07777777777;
387 #if USE_BURTLEBURTLE_HASH
389 typedef unsigned long int ub4; /* unsigned 4-byte quantities */
390 typedef unsigned char ub1; /* unsigned 1-byte quantities */
392 #define hashsize(n) ((ub4)1<<(n))
393 #define hashmask(n) (hashsize(n)-1)
396 --------------------------------------------------------------------
397 mix -- mix 3 32-bit values reversibly.
398 For every delta with one or two bits set, and the deltas of all three
399 high bits or all three low bits, whether the original value of a,b,c
400 is almost all zero or is uniformly distributed,
401 * If mix() is run forward or backward, at least 32 bits in a,b,c
402 have at least 1/4 probability of changing.
403 * If mix() is run forward, every bit of c will change between 1/3 and
404 2/3 of the time. (Well, 22/100 and 78/100 for some 2-bit deltas.)
405 mix() was built out of 36 single-cycle latency instructions in a
406 structure that could supported 2x parallelism, like so:
414 Unfortunately, superscalar Pentiums and Sparcs can't take advantage
415 of that parallelism. They've also turned some of those single-cycle
416 latency instructions into multi-cycle latency instructions. Still,
417 this is the fastest good hash I could find. There were about 2^^68
418 to choose from. I only looked at a billion or so.
419 --------------------------------------------------------------------
423 a -= b; a -= c; a ^= (c>>13); \
424 b -= c; b -= a; b ^= (a<<8); \
425 c -= a; c -= b; c ^= (b>>13); \
426 a -= b; a -= c; a ^= (c>>12); \
427 b -= c; b -= a; b ^= (a<<16); \
428 c -= a; c -= b; c ^= (b>>5); \
429 a -= b; a -= c; a ^= (c>>3); \
430 b -= c; b -= a; b ^= (a<<10); \
431 c -= a; c -= b; c ^= (b>>15); \
435 --------------------------------------------------------------------
436 hash() -- hash a variable-length key into a 32-bit value
437 k : the key (the unaligned variable-length array of bytes)
438 len : the length of the key, counting by bytes
439 initval : can be any 4-byte value
440 Returns a 32-bit value. Every bit of the key affects every bit of
441 the return value. Every 1-bit and 2-bit delta achieves avalanche.
442 About 6*len+35 instructions.
444 The best hash table sizes are powers of 2. There is no need to do
445 mod a prime (mod is sooo slow!). If you need less than 32 bits,
446 use a bitmask. For example, if you need only 10 bits, do
447 h = (h & hashmask(10));
448 In which case, the hash table should have hashsize(10) elements.
450 If you are hashing n strings (ub1 **)k, do it like this:
451 for (i=0, h=0; i<n; ++i) h = hash( k[i], len[i], h);
453 By Bob Jenkins, 1996. bob_jenkins@burtleburtle.net. You may use this
454 code any way you wish, private, educational, or commercial. It's free.
456 See http://burtleburtle.net/bob/hash/evahash.html
457 Use for hash table lookup, or anything where one collision in 2^^32 is
458 acceptable. Do NOT use for cryptographic purposes.
459 --------------------------------------------------------------------
463 hash_string(const Bufbyte *ptr, Bytecount length)
464 /* this originally had support for an initval, which could have been the
465 * previous hash or an arbitray value ... this way, Jenkins supports hashing
466 * an array of strings or does multi-key hashes ... however this is a bit
467 * beyond the scope of how we use hashes, that's why the signature is as it is
470 register long int a, b, c, len;
472 /* Set up the internal state */
474 a = b = 0x9e3779b9; /* the golden ratio; an arbitrary value */
475 c = 0xDEADBEEF; /* the previous hash value */
477 /*---------------------------------------- handle most of the key */
480 a += (ptr[0] +((int)ptr[1]<<8)
481 +((int)ptr[2]<<16) +((int)ptr[3]<<24));
482 b += (ptr[4] +((int)ptr[5]<<8)
483 +((int)ptr[6]<<16) +((int)ptr[7]<<24));
484 c += (ptr[8] +((int)ptr[9]<<8)
485 +((int)ptr[10]<<16)+((int)ptr[11]<<24));
487 ptr += 12; len -= 12;
490 /*------------------------------------- handle the last 11 bytes */
492 switch(len) { /* all the case statements fall through */
493 case 11: c+=((int)ptr[10]<<24);
494 case 10: c+=((int)ptr[9]<<16);
495 case 9 : c+=((int)ptr[8]<<8);
496 /* the first byte of c is reserved for the length */
497 case 8 : b+=((int)ptr[7]<<24);
498 case 7 : b+=((int)ptr[6]<<16);
499 case 6 : b+=((int)ptr[5]<<8);
501 case 4 : a+=((int)ptr[3]<<24);
502 case 3 : a+=((int)ptr[2]<<16);
503 case 2 : a+=((int)ptr[1]<<8);
505 /* case 0: nothing left to add */
508 /*-------------------------------------------- report the result */
509 /* load a long -1 and shift it to the right once
510 * normally this isn't needed, but obviously there's lisp code
511 * out there which converts this to an EMACS_INT, in which case
512 * we must not use the most significant bit as otherwise this
513 * would be handled as bignum */
514 return c & (const hcode_t)(-1UL >> 1);
520 #if (defined(__GNUC__) && defined(__i386__))
521 #define get16bits(d) (*((const uint16_t *) (d)))
523 #if !defined (get16bits)
524 #define get16bits(d) ((((const uint8_t *)(d))[1] << UINT32_C(8))\
525 +((const uint8_t *)(d))[0])
529 hash_string(const Bufbyte *data, Bytecount len)
531 hcode_t hash = len, tmp, rem;
533 if (len <= 0 || data == NULL)
540 for (; len > 0; len--) {
541 hash += get16bits (data);
542 tmp = (get16bits (data+2) << 11) ^ hash;
543 hash = (hash << 16) ^ tmp;
544 data += 2*sizeof (uint16_t);
548 /* Handle end cases */
550 case 3: hash += get16bits (data);
552 hash ^= data[sizeof (uint16_t)] << 18;
555 case 2: hash += get16bits (data);
559 case 1: hash += *data;
566 /* Force "avalanching" of final 127 bits */
574 /* load a long -1 and shift it to the right once
575 * normally this isn't needed, but obviously there's lisp code
576 * out there which converts this to an EMACS_INT, in which case
577 * we must not use the most significant bit as otherwise this
578 * would be handled as bignum */
579 return hash & (const hcode_t)(-1UL >> 1);
586 /* derived from hashpjw, Dragon Book P436. */
588 hash_string(const Bufbyte * ptr, Bytecount len)
594 hash = (hash << 4) + *ptr++;
595 g = hash & 0xf0000000;
597 hash = (hash ^ (g >> 24)) ^ g;
599 /* load a long -1 and shift it to the right once
600 * normally this isn't needed, but obviously there's lisp code
601 * out there which converts this to an EMACS_INT, in which case
602 * we must not use the most significant bit as otherwise this
603 * would be handled as bignum */
604 return c & (const hcode_t)(-1UL >> 1);
609 DEFUN ("subr-name", Fsubr_name, 1, 1, 0, /*
610 Return name of function SUBR.
611 SUBR must be a built-in function.
617 wrong_type_argument (Qsubrp, subr);
618 name = XSUBR (subr)->name;
619 return make_string ((const Bufbyte *)name, strlen (name));
623 /* Map FN over OBARRAY. The mapping is stopped when FN returns a
626 map_obarray(Lisp_Object obarray, int (*fn) (Lisp_Object, void *), void *arg)
630 CHECK_VECTOR(obarray);
631 for (i = XVECTOR_LENGTH(obarray) - 1; i >= 0; i--) {
632 Lisp_Object tail = XVECTOR_DATA(obarray)[i];
636 if ((*fn) (tail, arg))
638 next = symbol_next(XSYMBOL(tail));
641 XSETSYMBOL(tail, next);
646 static int mapatoms_1(Lisp_Object sym, void *arg)
648 call1(*(Lisp_Object *) arg, sym);
652 DEFUN("mapatoms", Fmapatoms, 1, 2, 0, /*
653 Call FUNCTION on every symbol in OBARRAY.
654 OBARRAY defaults to the value of `obarray'.
662 obarray = check_obarray(obarray);
665 map_obarray(obarray, mapatoms_1, &function);
670 /**********************************************************************/
672 /**********************************************************************/
674 struct appropos_mapper_closure {
676 Lisp_Object predicate;
677 Lisp_Object accumulation;
680 static int apropos_mapper(Lisp_Object symbol, void *arg)
682 struct appropos_mapper_closure *closure =
683 (struct appropos_mapper_closure *)arg;
684 Bytecount match = fast_lisp_string_match(closure->regexp,
685 Fsymbol_name(symbol));
688 (NILP(closure->predicate) ||
689 !NILP(call1(closure->predicate, symbol))))
690 closure->accumulation = Fcons(symbol, closure->accumulation);
695 DEFUN("apropos-internal", Fapropos_internal, 1, 2, 0, /*
696 Return a list of all symbols whose names contain match for REGEXP.
697 If optional 2nd arg PREDICATE is non-nil, only symbols for which
698 \(funcall PREDICATE SYMBOL) returns non-nil are returned.
702 struct appropos_mapper_closure closure;
705 CHECK_STRING(regexp);
707 closure.regexp = regexp;
708 closure.predicate = predicate;
709 closure.accumulation = Qnil;
710 GCPRO1(closure.accumulation);
711 map_obarray(Vobarray, apropos_mapper, &closure);
712 closure.accumulation = Fsort(closure.accumulation, Qstring_lessp);
714 return closure.accumulation;
717 /* Extract and set components of symbols */
719 static void set_up_buffer_local_cache(Lisp_Object sym,
720 struct symbol_value_buffer_local *bfwd,
722 Lisp_Object new_alist_el, int set_it_p);
724 DEFUN("boundp", Fboundp, 1, 1, 0, /*
725 Return t if SYMBOL's value is not void.
729 CHECK_SYMBOL(symbol);
730 return UNBOUNDP(find_symbol_value(symbol)) ? Qnil : Qt;
733 DEFUN("globally-boundp", Fglobally_boundp, 1, 1, 0, /*
734 Return t if SYMBOL has a global (non-bound) value.
735 This is for the byte-compiler; you really shouldn't be using this.
739 CHECK_SYMBOL(symbol);
740 return UNBOUNDP(top_level_value(symbol)) ? Qnil : Qt;
743 DEFUN("fboundp", Ffboundp, 1, 1, 0, /*
744 Return t if SYMBOL's function definition is not void.
748 CHECK_SYMBOL(symbol);
749 return UNBOUNDP(XSYMBOL(symbol)->function) ? Qnil : Qt;
752 /* Return non-zero if SYM's value or function (the current contents of
753 which should be passed in as VAL) is constant, i.e. unsettable. */
755 static int symbol_is_constant(Lisp_Object sym, Lisp_Object val)
757 /* #### - I wonder if it would be better to just have a new magic value
758 type and make nil, t, and all keywords have that same magic
759 constant_symbol value. This test is awfully specific about what is
760 constant and what isn't. --Stig */
761 if (EQ(sym, Qnil) || EQ(sym, Qt))
764 if (SYMBOL_VALUE_MAGIC_P(val))
765 switch (XSYMBOL_VALUE_MAGIC_TYPE(val)) {
766 case SYMVAL_CONST_OBJECT_FORWARD:
767 case SYMVAL_CONST_SPECIFIER_FORWARD:
768 case SYMVAL_CONST_FIXNUM_FORWARD:
769 case SYMVAL_CONST_BOOLEAN_FORWARD:
770 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
771 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
774 /* list all cases here */
775 case SYMVAL_FIXNUM_FORWARD:
776 case SYMVAL_BOOLEAN_FORWARD:
777 case SYMVAL_OBJECT_FORWARD:
778 case SYMVAL_DEFAULT_BUFFER_FORWARD:
779 case SYMVAL_CURRENT_BUFFER_FORWARD:
780 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
781 case SYMVAL_SELECTED_CONSOLE_FORWARD:
782 case SYMVAL_UNBOUND_MARKER:
783 case SYMVAL_BUFFER_LOCAL:
784 case SYMVAL_SOME_BUFFER_LOCAL:
785 case SYMVAL_LISP_MAGIC:
786 case SYMVAL_VARALIAS:
789 break; /* Warning suppression */
792 /* We don't return true for keywords here because they are handled
793 specially by reject_constant_symbols(). */
797 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
798 non-zero) to NEWVAL. Make sure this is allowed.
799 FOLLOW_PAST_LISP_MAGIC specifies whether we delve past
800 symbol-value-lisp-magic objects. */
803 reject_constant_symbols(Lisp_Object sym, Lisp_Object newval, int function_p,
804 Lisp_Object follow_past_lisp_magic)
807 (function_p ? XSYMBOL(sym)->function
808 : fetch_value_maybe_past_magic(sym, follow_past_lisp_magic));
810 if (SYMBOL_VALUE_MAGIC_P(val) &&
811 XSYMBOL_VALUE_MAGIC_TYPE(val) == SYMVAL_CONST_SPECIFIER_FORWARD)
813 ("Use `set-specifier' to change a specifier's value", sym);
815 if (symbol_is_constant(sym, val)
816 || (SYMBOL_IS_KEYWORD(sym) && !EQ(newval, sym)))
817 signal_error(Qsetting_constant,
818 UNBOUNDP(newval) ? list1(sym) : list2(sym,
822 /* Verify that it's ok to make SYM buffer-local. This rejects
823 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC
824 specifies whether we delve into symbol-value-lisp-magic objects.
825 (Should be a symbol indicating what action is being taken; that way,
826 we don't delve if there's a handler for that action, but do otherwise.) */
829 verify_ok_for_buffer_local(Lisp_Object sym, Lisp_Object follow_past_lisp_magic)
832 fetch_value_maybe_past_magic(sym, follow_past_lisp_magic);
834 if (symbol_is_constant(sym, val))
836 if (SYMBOL_VALUE_MAGIC_P(val))
837 switch (XSYMBOL_VALUE_MAGIC_TYPE(val)) {
838 case SYMVAL_DEFAULT_BUFFER_FORWARD:
839 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
840 /* #### It's theoretically possible for it to be reasonable
841 to have both console-local and buffer-local variables,
842 but I don't want to consider that right now. */
843 case SYMVAL_SELECTED_CONSOLE_FORWARD:
846 /* list all cases here */
847 case SYMVAL_FIXNUM_FORWARD:
848 case SYMVAL_CONST_FIXNUM_FORWARD:
849 case SYMVAL_BOOLEAN_FORWARD:
850 case SYMVAL_CONST_BOOLEAN_FORWARD:
851 case SYMVAL_OBJECT_FORWARD:
852 case SYMVAL_CONST_OBJECT_FORWARD:
853 case SYMVAL_CONST_SPECIFIER_FORWARD:
854 case SYMVAL_CURRENT_BUFFER_FORWARD:
855 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
856 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
857 case SYMVAL_UNBOUND_MARKER:
858 case SYMVAL_BUFFER_LOCAL:
859 case SYMVAL_SOME_BUFFER_LOCAL:
860 case SYMVAL_LISP_MAGIC:
861 case SYMVAL_VARALIAS:
863 break; /* Warning suppression */
870 list2(build_string("Symbol may not be buffer-local"),
874 DEFUN("makunbound", Fmakunbound, 1, 1, 0, /*
875 Make SYMBOL's value be void.
879 Fset(symbol, Qunbound);
883 DEFUN("fmakunbound", Ffmakunbound, 1, 1, 0, /*
884 Make SYMBOL's function definition be void.
888 CHECK_SYMBOL(symbol);
889 reject_constant_symbols(symbol, Qunbound, 1, Qt);
890 XSYMBOL(symbol)->function = Qunbound;
894 DEFUN("symbol-function", Fsymbol_function, 1, 1, 0, /*
895 Return SYMBOL's function definition. Error if that is void.
899 CHECK_SYMBOL(symbol);
900 if (UNBOUNDP(XSYMBOL(symbol)->function))
901 signal_void_function_error(symbol);
902 return XSYMBOL(symbol)->function;
905 DEFUN("symbol-plist", Fsymbol_plist, 1, 1, 0, /*
906 Return SYMBOL's property list.
910 CHECK_SYMBOL(symbol);
911 return XSYMBOL(symbol)->plist;
914 DEFUN("symbol-name", Fsymbol_name, 1, 1, 0, /*
915 Return SYMBOL's name, a string.
921 CHECK_SYMBOL(symbol);
922 XSETSTRING(name, XSYMBOL(symbol)->name);
924 /* This is a CRUTCH, we need some better mechanism to
925 * initialize data like morphisms */
926 XSTRING(name)->lheader.morphisms = 0;
931 DEFUN("fset", Ffset, 2, 2, 0, /*
932 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
936 /* This function can GC */
937 CHECK_SYMBOL(symbol);
938 reject_constant_symbols(symbol, newdef, 1, Qt);
939 if (!NILP(Vautoload_queue) && !UNBOUNDP(XSYMBOL(symbol)->function))
941 Fcons(Fcons(symbol, XSYMBOL(symbol)->function),
943 XSYMBOL(symbol)->function = newdef;
944 /* Handle automatic advice activation */
945 if (CONSP(XSYMBOL(symbol)->plist) &&
946 !NILP(Fget(symbol, Qad_advice_info, Qnil))) {
947 call2(Qad_activate, symbol, Qnil);
948 newdef = XSYMBOL(symbol)->function;
954 DEFUN("define-function", Fdefine_function, 2, 2, 0, /*
955 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
956 Associates the function with the current load file, if any.
960 /* This function can GC */
961 Ffset(symbol, newdef);
962 LOADHIST_ATTACH (Fcons (Qdefun, symbol));
966 DEFUN ("special-form-p", Fspecial_form_p, 1, 1, 0, /*
967 Return whether SUBR is a special form.
969 A special form is a built-in function (a subr, that is a function
970 implemented in C, not Lisp) which does not necessarily evaluate all its
971 arguments. Much of the basic XEmacs Lisp syntax is implemented by means of
972 special forms; examples are `let', `condition-case', `defun', `setq' and so
975 If you intend to write a Lisp function that does not necessarily evaluate
976 all its arguments, the portable (across emacs variants, and across Lisp
977 implementations) way to go about it is to write a macro instead. See
978 `defmacro' and `backquote'.
982 subr = indirect_function (subr, 0);
983 return (SUBRP (subr) && XSUBR (subr)->max_args == UNEVALLED) ? Qt : Qnil;
986 DEFUN("setplist", Fsetplist, 2, 2, 0, /*
987 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
991 CHECK_SYMBOL(symbol);
992 #if 0 /* Inserted for debugging 6/28/1997 -slb */
993 /* Somebody is setting a property list of integer 0, who? */
994 /* Not this way apparently. */
995 if (EQ(newplist, Qzero))
999 XSYMBOL(symbol)->plist = newplist;
1003 /**********************************************************************/
1005 /**********************************************************************/
1007 /* If the contents of the value cell of a symbol is one of the following
1008 three types of objects, then the symbol is "magic" in that setting
1009 and retrieving its value doesn't just set or retrieve the raw
1010 contents of the value cell. None of these objects can escape to
1011 the user level, so there is no loss of generality.
1013 If a symbol is "unbound", then the contents of its value cell is
1014 Qunbound. Despite appearances, this is *not* a symbol, but is a
1015 symbol-value-forward object. This is so that printing it results
1016 in "INTERNAL OBJECT (SXEmacs bug?)", in case it leaks to Lisp, somehow.
1018 Logically all of the following objects are "symbol-value-magic"
1019 objects, and there are some games played w.r.t. this (#### this
1020 should be cleaned up). SYMBOL_VALUE_MAGIC_P is true for all of
1021 the object types. XSYMBOL_VALUE_MAGIC_TYPE returns the type of
1022 symbol-value-magic object. There are more than three types
1023 returned by this macro: in particular, symbol-value-forward
1024 has eight subtypes, and symbol-value-buffer-local has two. See
1027 1. symbol-value-forward
1029 symbol-value-forward is used for variables whose actual contents
1030 are stored in a C variable of some sort, and for Qunbound. The
1031 lcheader.next field (which is only used to chain together free
1032 lcrecords) holds a pointer to the actual C variable. Included
1033 in this type are "buffer-local" variables that are actually
1034 stored in the buffer object itself; in this case, the "pointer"
1035 is an offset into the struct buffer structure.
1037 The subtypes are as follows:
1039 SYMVAL_OBJECT_FORWARD:
1040 (declare with DEFVAR_LISP)
1041 The value of this variable is stored in a C variable of type
1042 "Lisp_Object". Setting this variable sets the C variable.
1043 Accessing this variable retrieves a value from the C variable.
1044 These variables can be buffer-local -- in this case, the
1045 raw symbol-value field gets converted into a
1046 symbol-value-buffer-local, whose "current_value" slot contains
1047 the symbol-value-forward. (See below.)
1049 SYMVAL_FIXNUM_FORWARD:
1050 (declare with DEFVAR_INT)
1051 Similar to SYMVAL_OBJECT_FORWARD except that the C variable
1052 is of type "Fixnum", a typedef for "EMACS_INT", and the corresponding
1053 lisp variable is always the corresponding integer.
1055 SYMVAL_BOOLEAN_FORWARD:
1056 (declare with DEFVAR_BOOL)
1057 Similar to SYMVAL_OBJECT_FORWARD except that the C variable
1058 is of type "int" and is a boolean.
1060 SYMVAL_CONST_OBJECT_FORWARD:
1061 SYMVAL_CONST_FIXNUM_FORWARD:
1062 SYMVAL_CONST_BOOLEAN_FORWARD:
1063 (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
1065 Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
1066 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
1069 SYMVAL_CONST_SPECIFIER_FORWARD:
1070 (declare with DEFVAR_SPECIFIER)
1071 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that the error
1072 message you get when attempting to set the value says to use
1073 `set-specifier' instead.
1075 SYMVAL_CURRENT_BUFFER_FORWARD:
1076 (declare with DEFVAR_BUFFER_LOCAL)
1077 This is used for built-in buffer-local variables -- i.e.
1078 Lisp variables whose value is stored in the "struct buffer".
1079 Variables of this sort always forward into C "Lisp_Object"
1080 fields (although there's no reason in principle that other
1081 types for ints and booleans couldn't be added). Note that
1082 some of these variables are automatically local in each
1083 buffer, while some are only local when they become set
1084 (similar to `make-variable-buffer-local'). In these latter
1085 cases, of course, the default value shows through in all
1086 buffers in which the variable doesn't have a local value.
1087 This is implemented by making sure the "struct buffer" field
1088 always contains the correct value (whether it's local or
1089 a default) and maintaining a mask in the "struct buffer"
1090 indicating which fields are local. When `set-default' is
1091 called on a variable that's not always local to all buffers,
1092 it loops through each buffer and sets the corresponding
1093 field in each buffer without a local value for the field,
1094 according to the mask.
1096 Calling `make-local-variable' on a variable of this sort
1097 only has the effect of maybe changing the current buffer's mask.
1098 Calling `make-variable-buffer-local' on a variable of this
1099 sort has no effect at all.
1101 SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1102 (declare with DEFVAR_CONST_BUFFER_LOCAL)
1103 Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
1104 value cannot be set.
1106 SYMVAL_DEFAULT_BUFFER_FORWARD:
1107 (declare with DEFVAR_BUFFER_DEFAULTS)
1108 This is used for the Lisp variables that contain the
1109 default values of built-in buffer-local variables. Setting
1110 or referencing one of these variables forwards into a slot
1111 in the special struct buffer Vbuffer_defaults.
1113 SYMVAL_UNBOUND_MARKER:
1114 This is used for only one object, Qunbound.
1116 SYMVAL_SELECTED_CONSOLE_FORWARD:
1117 (declare with DEFVAR_CONSOLE_LOCAL)
1118 This is used for built-in console-local variables -- i.e.
1119 Lisp variables whose value is stored in the "struct console".
1120 These work just like built-in buffer-local variables.
1121 However, calling `make-local-variable' or
1122 `make-variable-buffer-local' on one of these variables
1123 is currently disallowed because that would entail having
1124 both console-local and buffer-local variables, which is
1125 trickier to implement.
1127 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1128 (declare with DEFVAR_CONST_CONSOLE_LOCAL)
1129 Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
1130 value cannot be set.
1132 SYMVAL_DEFAULT_CONSOLE_FORWARD:
1133 (declare with DEFVAR_CONSOLE_DEFAULTS)
1134 This is used for the Lisp variables that contain the
1135 default values of built-in console-local variables. Setting
1136 or referencing one of these variables forwards into a slot
1137 in the special struct console Vconsole_defaults.
1139 2. symbol-value-buffer-local
1141 symbol-value-buffer-local is used for variables that have had
1142 `make-local-variable' or `make-variable-buffer-local' applied
1143 to them. This object contains an alist mapping buffers to
1144 values. In addition, the object contains a "current value",
1145 which is the value in some buffer. Whenever you access the
1146 variable with `symbol-value' or set it with `set' or `setq',
1147 things are switched around so that the "current value"
1148 refers to the current buffer, if it wasn't already. This
1149 way, repeated references to a variable in the same buffer
1150 are almost as efficient as if the variable weren't buffer
1151 local. Note that the alist may not be up-to-date w.r.t.
1152 the buffer whose value is current, as the "current value"
1153 cache is normally only flushed into the alist when the
1154 buffer it refers to changes.
1156 Note also that it is possible for `make-local-variable'
1157 or `make-variable-buffer-local' to be called on a variable
1158 that forwards into a C variable (i.e. a variable whose
1159 value cell is a symbol-value-forward). In this case,
1160 the value cell becomes a symbol-value-buffer-local (as
1161 always), and the symbol-value-forward moves into
1162 the "current value" cell in this object. Also, in
1163 this case the "current value" *always* refers to the
1164 current buffer, so that the values of the C variable
1165 always is the correct value for the current buffer.
1166 set_buffer_internal() automatically updates the current-value
1167 cells of all buffer-local variables that forward into C
1168 variables. (There is a list of all buffer-local variables
1169 that is maintained for this and other purposes.)
1171 Note that only certain types of `symbol-value-forward' objects
1172 can find their way into the "current value" cell of a
1173 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
1174 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
1175 SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot
1176 be buffer-local because they are unsettable;
1177 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
1178 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
1179 does not have much of an effect (it's already buffer-local); and
1180 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
1181 that's not currently implemented.
1183 3. symbol-value-varalias
1185 A symbol-value-varalias object is used for variables that
1186 are aliases for other variables. This object contains
1187 the symbol that this variable is aliased to.
1188 symbol-value-varalias objects cannot occur anywhere within
1189 a symbol-value-buffer-local object, and most of the
1190 low-level functions below do not accept them; you need
1191 to call follow_varalias_pointers to get the actual
1192 symbol to operate on. */
1194 static Lisp_Object mark_symbol_value_buffer_local(Lisp_Object obj)
1196 struct symbol_value_buffer_local *bfwd;
1198 #ifdef ERROR_CHECK_TYPECHECK
1199 assert(XSYMBOL_VALUE_MAGIC_TYPE(obj) == SYMVAL_BUFFER_LOCAL ||
1200 XSYMBOL_VALUE_MAGIC_TYPE(obj) == SYMVAL_SOME_BUFFER_LOCAL);
1203 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL(obj);
1204 mark_object(bfwd->default_value);
1205 mark_object(bfwd->current_value);
1206 mark_object(bfwd->current_buffer);
1207 return bfwd->current_alist_element;
1210 static Lisp_Object mark_symbol_value_lisp_magic(Lisp_Object obj)
1212 struct symbol_value_lisp_magic *bfwd;
1215 assert(XSYMBOL_VALUE_MAGIC_TYPE(obj) == SYMVAL_LISP_MAGIC);
1217 bfwd = XSYMBOL_VALUE_LISP_MAGIC(obj);
1218 for (i = 0; i < MAGIC_HANDLER_MAX; i++) {
1219 mark_object(bfwd->handler[i]);
1220 mark_object(bfwd->harg[i]);
1222 return bfwd->shadowed;
1225 static Lisp_Object mark_symbol_value_varalias(Lisp_Object obj)
1227 struct symbol_value_varalias *bfwd;
1229 assert(XSYMBOL_VALUE_MAGIC_TYPE(obj) == SYMVAL_VARALIAS);
1231 bfwd = XSYMBOL_VALUE_VARALIAS(obj);
1232 mark_object(bfwd->shadowed);
1233 return bfwd->aliasee;
1236 /* Should never, ever be called. (except by an external debugger) */
1238 print_symbol_value_magic(Lisp_Object obj,
1239 Lisp_Object printcharfun, int escapeflag)
1241 write_fmt_str( printcharfun, "#<INTERNAL OBJECT (SXEmacs bug?) (%s type %d) 0x%lx>",
1242 XRECORD_LHEADER_IMPLEMENTATION(obj)->name,
1243 XSYMBOL_VALUE_MAGIC_TYPE(obj), (long)XPNTR(obj));
1246 static const struct lrecord_description symbol_value_forward_description[] = {
1250 static const struct lrecord_description symbol_value_buffer_local_description[]
1253 offsetof(struct symbol_value_buffer_local, default_value)},
1255 offsetof(struct symbol_value_buffer_local, current_value)},
1257 offsetof(struct symbol_value_buffer_local, current_buffer)},
1259 offsetof(struct symbol_value_buffer_local, current_alist_element)},
1263 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
1264 {XD_LISP_OBJECT_ARRAY,
1265 offsetof(struct symbol_value_lisp_magic, handler),
1266 2 * MAGIC_HANDLER_MAX + 1},
1270 static const struct lrecord_description symbol_value_varalias_description[] = {
1271 {XD_LISP_OBJECT, offsetof(struct symbol_value_varalias, aliasee)},
1272 {XD_LISP_OBJECT, offsetof(struct symbol_value_varalias, shadowed)},
1276 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-forward",
1277 symbol_value_forward,
1279 print_symbol_value_magic, 0, 0, 0,
1280 symbol_value_forward_description,
1281 struct symbol_value_forward);
1283 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-buffer-local",
1284 symbol_value_buffer_local,
1285 mark_symbol_value_buffer_local,
1286 print_symbol_value_magic, 0, 0, 0,
1287 symbol_value_buffer_local_description,
1288 struct symbol_value_buffer_local);
1290 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-lisp-magic",
1291 symbol_value_lisp_magic,
1292 mark_symbol_value_lisp_magic,
1293 print_symbol_value_magic, 0, 0, 0,
1294 symbol_value_lisp_magic_description,
1295 struct symbol_value_lisp_magic);
1297 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-varalias",
1298 symbol_value_varalias,
1299 mark_symbol_value_varalias,
1300 print_symbol_value_magic, 0, 0, 0,
1301 symbol_value_varalias_description,
1302 struct symbol_value_varalias);
1304 /* Getting and setting values of symbols */
1306 /* Given the raw contents of a symbol value cell, return the Lisp value of
1307 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
1308 symbol-value-lisp-magic, or symbol-value-varalias.
1310 BUFFER specifies a buffer, and is used for built-in buffer-local
1311 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
1312 Note that such variables are never encapsulated in a
1313 symbol-value-buffer-local structure.
1315 CONSOLE specifies a console, and is used for built-in console-local
1316 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
1317 Note that such variables are (currently) never encapsulated in a
1318 symbol-value-buffer-local structure.
1322 do_symval_forwarding(Lisp_Object valcontents, struct buffer *buffer,
1323 struct console *console)
1325 const struct symbol_value_forward *fwd;
1327 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
1330 fwd = XSYMBOL_VALUE_FORWARD(valcontents);
1331 switch (fwd->magic.type) {
1332 case SYMVAL_FIXNUM_FORWARD:
1333 case SYMVAL_CONST_FIXNUM_FORWARD:
1335 make_int(*((Fixnum *) symbol_value_forward_forward(fwd)));
1337 case SYMVAL_BOOLEAN_FORWARD:
1338 case SYMVAL_CONST_BOOLEAN_FORWARD:
1339 return *((int *)symbol_value_forward_forward(fwd)) ? Qt : Qnil;
1341 case SYMVAL_OBJECT_FORWARD:
1342 case SYMVAL_CONST_OBJECT_FORWARD:
1343 case SYMVAL_CONST_SPECIFIER_FORWARD:
1344 return *((Lisp_Object *) symbol_value_forward_forward(fwd));
1346 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1347 return (*((Lisp_Object *) ((char *)XBUFFER(Vbuffer_defaults)
1350 symbol_value_forward_forward(fwd)
1351 - (char *)&buffer_local_flags))));
1353 case SYMVAL_CURRENT_BUFFER_FORWARD:
1354 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1356 return (*((Lisp_Object *) ((char *)buffer
1359 symbol_value_forward_forward(fwd)
1360 - (char *)&buffer_local_flags))));
1362 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1363 return (*((Lisp_Object *) ((char *)XCONSOLE(Vconsole_defaults)
1366 symbol_value_forward_forward(fwd)
1367 - (char *)&console_local_flags))));
1369 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1370 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1372 return (*((Lisp_Object *) ((char *)console
1375 symbol_value_forward_forward(fwd)
1376 - (char *)&console_local_flags))));
1378 case SYMVAL_UNBOUND_MARKER:
1381 case SYMVAL_BUFFER_LOCAL:
1382 case SYMVAL_SOME_BUFFER_LOCAL:
1383 case SYMVAL_LISP_MAGIC:
1384 case SYMVAL_VARALIAS:
1388 return Qnil; /* suppress compiler warning */
1391 /* Set the value of default-buffer-local variable SYM to VALUE. */
1393 static void set_default_buffer_slot_variable(Lisp_Object sym, Lisp_Object value)
1395 /* Handle variables like case-fold-search that have special slots in
1396 the buffer. Make them work apparently like buffer_local variables.
1398 /* At this point, the value cell may not contain a symbol-value-varalias
1399 or symbol-value-buffer-local, and if there's a handler, we should
1400 have already called it. */
1401 Lisp_Object valcontents = fetch_value_maybe_past_magic(sym, Qt);
1402 const struct symbol_value_forward *fwd
1403 = XSYMBOL_VALUE_FORWARD(valcontents);
1404 int offset = ((char *)symbol_value_forward_forward(fwd)
1405 - (char *)&buffer_local_flags);
1406 int mask = XINT(*((Lisp_Object *) symbol_value_forward_forward(fwd)));
1407 int (*magicfun) (Lisp_Object simm, Lisp_Object * val,
1408 Lisp_Object in_object, int flags) =
1409 symbol_value_forward_magicfun(fwd);
1411 *((Lisp_Object *) (offset + (char *)XBUFFER(Vbuffer_defaults)))
1414 if (mask > 0) { /* Not always per-buffer */
1415 /* Set value in each buffer which hasn't shadowed the default */
1416 LIST_LOOP_2(elt, Vbuffer_alist) {
1417 struct buffer *b = XBUFFER(XCDR(elt));
1418 if (!(b->local_var_flags & mask)) {
1420 magicfun(sym, &value, make_buffer(b),
1422 *((Lisp_Object *) (offset + (char *)b)) = value;
1428 /* Set the value of default-console-local variable SYM to VALUE. */
1431 set_default_console_slot_variable(Lisp_Object sym, Lisp_Object value)
1433 /* Handle variables like case-fold-search that have special slots in
1434 the console. Make them work apparently like console_local variables.
1436 /* At this point, the value cell may not contain a symbol-value-varalias
1437 or symbol-value-buffer-local, and if there's a handler, we should
1438 have already called it. */
1439 Lisp_Object valcontents = fetch_value_maybe_past_magic(sym, Qt);
1440 const struct symbol_value_forward *fwd
1441 = XSYMBOL_VALUE_FORWARD(valcontents);
1442 int offset = ((char *)symbol_value_forward_forward(fwd)
1443 - (char *)&console_local_flags);
1444 int mask = XINT(*((Lisp_Object *) symbol_value_forward_forward(fwd)));
1445 int (*magicfun) (Lisp_Object simm, Lisp_Object * val,
1446 Lisp_Object in_object, int flags) =
1447 symbol_value_forward_magicfun(fwd);
1449 *((Lisp_Object *) (offset + (char *)XCONSOLE(Vconsole_defaults)))
1452 if (mask > 0) { /* Not always per-console */
1453 /* Set value in each console which hasn't shadowed the default */
1454 LIST_LOOP_2(console, Vconsole_list) {
1455 struct console *d = XCONSOLE(console);
1456 if (!(d->local_var_flags & mask)) {
1458 magicfun(sym, &value, console, 0);
1459 *((Lisp_Object *) (offset + (char *)d)) = value;
1465 /* Store NEWVAL into SYM.
1467 SYM's value slot may *not* be types (5) or (6) above,
1468 i.e. no symbol-value-varalias objects. (You should have
1469 forwarded past all of these.)
1471 SYM should not be an unsettable symbol or a symbol with
1472 a magic `set-value' handler (unless you want to explicitly
1473 ignore this handler).
1475 OVALUE is the current value of SYM, but forwarded past any
1476 symbol-value-buffer-local and symbol-value-lisp-magic objects.
1477 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1478 the contents of its current-value cell.) NEWVAL may only be
1479 a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
1480 this function will only modify its current-value cell, which should
1481 already be set up to point to the current buffer.
1485 store_symval_forwarding(Lisp_Object sym, Lisp_Object ovalue, Lisp_Object newval)
1487 if (!SYMBOL_VALUE_MAGIC_P(ovalue) || UNBOUNDP(ovalue)) {
1488 Lisp_Object *store_pointer = value_slot_past_magic(sym);
1490 if (SYMBOL_VALUE_BUFFER_LOCAL_P(*store_pointer))
1492 &XSYMBOL_VALUE_BUFFER_LOCAL(*store_pointer)->
1495 assert(UNBOUNDP(*store_pointer)
1496 || !SYMBOL_VALUE_MAGIC_P(*store_pointer));
1497 *store_pointer = newval;
1499 const struct symbol_value_forward *fwd =
1500 XSYMBOL_VALUE_FORWARD(ovalue);
1501 int (*magicfun) (Lisp_Object simm, Lisp_Object * val,
1502 Lisp_Object in_object, int flags)
1503 = symbol_value_forward_magicfun(fwd);
1505 switch (XSYMBOL_VALUE_MAGIC_TYPE(ovalue)) {
1506 case SYMVAL_FIXNUM_FORWARD:
1509 magicfun(sym, &newval, Qnil, 0);
1510 *((Fixnum *) symbol_value_forward_forward(fwd)) =
1514 case SYMVAL_BOOLEAN_FORWARD:
1516 magicfun(sym, &newval, Qnil, 0);
1517 *((int *)symbol_value_forward_forward(fwd))
1521 case SYMVAL_OBJECT_FORWARD:
1523 magicfun(sym, &newval, Qnil, 0);
1524 *((Lisp_Object *) symbol_value_forward_forward(fwd)) =
1528 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1529 set_default_buffer_slot_variable(sym, newval);
1532 case SYMVAL_CURRENT_BUFFER_FORWARD:
1534 magicfun(sym, &newval,
1535 make_buffer(current_buffer), 0);
1536 *((Lisp_Object *) ((char *)current_buffer +
1538 symbol_value_forward_forward(fwd)
1539 - (char *)&buffer_local_flags)))
1543 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1544 set_default_console_slot_variable(sym, newval);
1547 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1549 magicfun(sym, &newval, Vselected_console, 0);
1550 *((Lisp_Object *) ((char *)XCONSOLE(Vselected_console)
1553 symbol_value_forward_forward(fwd)
1554 - (char *)&console_local_flags)))
1558 /* list all cases */
1559 case SYMVAL_CONST_FIXNUM_FORWARD:
1560 case SYMVAL_CONST_BOOLEAN_FORWARD:
1561 case SYMVAL_CONST_OBJECT_FORWARD:
1562 case SYMVAL_CONST_SPECIFIER_FORWARD:
1563 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1564 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1565 case SYMVAL_UNBOUND_MARKER:
1566 case SYMVAL_BUFFER_LOCAL:
1567 case SYMVAL_SOME_BUFFER_LOCAL:
1568 case SYMVAL_LISP_MAGIC:
1569 case SYMVAL_VARALIAS:
1577 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1578 BFWD, locate and return a pointer to the element in BUFFER's
1579 local_var_alist for SYMBOL. The return value will be Qnil if
1580 BUFFER does not have its own value for SYMBOL (i.e. the default
1581 value is seen in that buffer).
1585 buffer_local_alist_element(struct buffer *buffer, Lisp_Object symbol,
1586 struct symbol_value_buffer_local *bfwd)
1588 if (!NILP(bfwd->current_buffer) &&
1589 XBUFFER(bfwd->current_buffer) == buffer)
1590 /* This is just an optimization of the below. */
1591 return bfwd->current_alist_element;
1593 return assq_no_quit(symbol, buffer->local_var_alist);
1596 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1597 symbol-value-buffer-local of a per-buffer variable -- i.e. the
1598 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1599 slot -- may be out of date.]
1601 Write out any cached value in buffer-local variable SYMBOL's
1602 buffer-local structure, which is passed in as BFWD.
1606 write_out_buffer_local_cache(Lisp_Object symbol,
1607 struct symbol_value_buffer_local *bfwd)
1609 if (!NILP(bfwd->current_buffer)) {
1610 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1611 uses it, and that type cannot be inside a symbol-value-buffer-local */
1613 do_symval_forwarding(bfwd->current_value, 0, 0);
1614 if (NILP(bfwd->current_alist_element))
1615 /* current_value may be updated more recently than default_value */
1616 bfwd->default_value = cval;
1618 Fsetcdr(bfwd->current_alist_element, cval);
1622 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1623 Set up BFWD's cache for validity in buffer BUF. This assumes that
1624 the cache is currently in a consistent state (this can include
1625 not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1627 If the cache is already set up for BUF, this function does nothing
1630 Otherwise, if SYM forwards out to a C variable, this also forwards
1631 SYM's value in BUF out to the variable. Therefore, you generally
1632 only want to call this when BUF is, or is about to become, the
1635 (Otherwise, you can just retrieve the value without changing the
1636 cache, at the expense of slower retrieval.)
1640 set_up_buffer_local_cache(Lisp_Object sym,
1641 struct symbol_value_buffer_local *bfwd,
1643 Lisp_Object new_alist_el, int set_it_p)
1645 Lisp_Object new_val;
1647 if (!NILP(bfwd->current_buffer)
1648 && buf == XBUFFER(bfwd->current_buffer))
1649 /* Cache is already set up. */
1652 /* Flush out the old cache. */
1653 write_out_buffer_local_cache(sym, bfwd);
1655 /* Retrieve the new alist element and new value. */
1656 if (NILP(new_alist_el)
1658 new_alist_el = buffer_local_alist_element(buf, sym, bfwd);
1660 if (NILP(new_alist_el))
1661 new_val = bfwd->default_value;
1663 new_val = Fcdr(new_alist_el);
1665 bfwd->current_alist_element = new_alist_el;
1666 XSETBUFFER(bfwd->current_buffer, buf);
1668 /* Now store the value into the current-value slot.
1669 We don't simply write it there, because the current-value
1670 slot might be a forwarding pointer, in which case we need
1671 to instead write the value into the C variable.
1673 We might also want to call a magic function.
1675 So instead, we call this function. */
1676 store_symval_forwarding(sym, bfwd->current_value, new_val);
1679 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1680 Flush the cache. BFWD->CURRENT_BUFFER will be nil after this operation.
1684 flush_buffer_local_cache(Lisp_Object sym,
1685 struct symbol_value_buffer_local *bfwd)
1687 if (NILP(bfwd->current_buffer))
1688 /* Cache is already flushed. */
1691 /* Flush out the old cache. */
1692 write_out_buffer_local_cache(sym, bfwd);
1694 bfwd->current_alist_element = Qnil;
1695 bfwd->current_buffer = Qnil;
1697 /* Now store default the value into the current-value slot.
1698 We don't simply write it there, because the current-value
1699 slot might be a forwarding pointer, in which case we need
1700 to instead write the value into the C variable.
1702 We might also want to call a magic function.
1704 So instead, we call this function. */
1705 store_symval_forwarding(sym, bfwd->current_value, bfwd->default_value);
1708 /* Flush all the buffer-local variable caches. Whoever has a
1709 non-interned buffer-local variable will be spanked. Whoever has a
1710 magic variable that interns or uninterns symbols... I don't even
1711 want to think about it.
1714 void flush_all_buffer_local_cache(void)
1716 Lisp_Object *syms = XVECTOR_DATA(Vobarray);
1717 long count = XVECTOR_LENGTH(Vobarray);
1720 for (i = 0; i < count; i++) {
1721 Lisp_Object sym = syms[i];
1727 assert(SYMBOLP(sym));
1728 value = fetch_value_maybe_past_magic(sym, Qt);
1729 if (SYMBOL_VALUE_BUFFER_LOCAL_P(value))
1730 flush_buffer_local_cache(sym,
1731 XSYMBOL_VALUE_BUFFER_LOCAL
1734 next = symbol_next(XSYMBOL(sym));
1737 XSETSYMBOL(sym, next);
1742 void kill_buffer_local_variables(struct buffer *buf)
1744 Lisp_Object prev = Qnil;
1747 /* Any which are supposed to be permanent,
1748 make local again, with the same values they had. */
1750 for (alist = buf->local_var_alist; !NILP(alist); alist = XCDR(alist)) {
1751 Lisp_Object sym = XCAR(XCAR(alist));
1752 struct symbol_value_buffer_local *bfwd;
1753 /* Variables with a symbol-value-varalias should not be here
1754 (we should have forwarded past them) and there must be a
1755 symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
1756 just forward past it; if the variable has a handler, it was
1758 Lisp_Object value = fetch_value_maybe_past_magic(sym, Qt);
1760 assert(SYMBOL_VALUE_BUFFER_LOCAL_P(value));
1761 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL(value);
1763 if (!NILP(Fget(sym, Qpermanent_local, Qnil)))
1764 /* prev points to the last alist element that is still
1765 staying around, so *only* update it now. This didn't
1766 used to be the case; this bug has been around since
1767 mly's rewrite two years ago! */
1770 /* Really truly kill it. */
1772 XCDR(prev) = XCDR(alist);
1774 buf->local_var_alist = XCDR(alist);
1776 /* We just effectively changed the value for this variable
1779 /* (1) If the cache is caching BUF, invalidate the cache. */
1780 if (!NILP(bfwd->current_buffer) &&
1781 buf == XBUFFER(bfwd->current_buffer))
1782 bfwd->current_buffer = Qnil;
1784 /* (2) If we changed the value in current_buffer and this
1785 variable forwards to a C variable, we need to change the
1786 value of the C variable. set_up_buffer_local_cache()
1787 will do this. It doesn't hurt to do it whenever
1788 BUF == current_buffer, so just go ahead and do that. */
1789 if (buf == current_buffer)
1790 set_up_buffer_local_cache(sym, bfwd, buf, Qnil,
1797 find_symbol_value_1(Lisp_Object sym, struct buffer *buf,
1798 struct console *con, int swap_it_in,
1799 Lisp_Object symcons, int set_it_p)
1801 Lisp_Object valcontents;
1804 valcontents = XSYMBOL(sym)->value;
1807 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
1810 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
1811 case SYMVAL_LISP_MAGIC:
1813 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
1817 case SYMVAL_VARALIAS:
1818 sym = follow_varalias_pointers(sym, Qt /* #### kludge */ );
1820 /* presto change-o! */
1823 case SYMVAL_BUFFER_LOCAL:
1824 case SYMVAL_SOME_BUFFER_LOCAL:
1826 struct symbol_value_buffer_local *bfwd
1827 = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
1830 set_up_buffer_local_cache(sym, bfwd, buf,
1832 valcontents = bfwd->current_value;
1834 if (!NILP(bfwd->current_buffer) &&
1835 buf == XBUFFER(bfwd->current_buffer))
1836 valcontents = bfwd->current_value;
1837 else if (NILP(symcons)) {
1843 if (NILP(valcontents))
1845 bfwd->default_value;
1847 valcontents = XCDR(valcontents);
1849 valcontents = XCDR(symcons);
1854 case SYMVAL_FIXNUM_FORWARD:
1855 case SYMVAL_CONST_FIXNUM_FORWARD:
1856 case SYMVAL_BOOLEAN_FORWARD:
1857 case SYMVAL_CONST_BOOLEAN_FORWARD:
1858 case SYMVAL_OBJECT_FORWARD:
1859 case SYMVAL_CONST_OBJECT_FORWARD:
1860 case SYMVAL_CONST_SPECIFIER_FORWARD:
1861 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1862 case SYMVAL_CURRENT_BUFFER_FORWARD:
1863 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1864 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1865 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1866 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1867 case SYMVAL_UNBOUND_MARKER:
1871 return do_symval_forwarding(valcontents, buf, con);
1874 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1875 bound. Note that it must not be possible to QUIT within this
1878 Lisp_Object symbol_value_in_buffer(Lisp_Object sym, Lisp_Object buffer)
1885 buf = current_buffer;
1887 CHECK_BUFFER(buffer);
1888 buf = XBUFFER(buffer);
1891 return find_symbol_value_1(sym, buf,
1892 /* If it bombs out at startup due to a
1893 Lisp error, this may be nil. */
1894 CONSOLEP(Vselected_console)
1895 ? XCONSOLE(Vselected_console) : 0, 0, Qnil,
1899 static Lisp_Object symbol_value_in_console(Lisp_Object sym, Lisp_Object console)
1904 console = Vselected_console;
1906 CHECK_CONSOLE(console);
1908 return find_symbol_value_1(sym, current_buffer, XCONSOLE(console), 0,
1913 search_symbol_macro(Lisp_Object name)
1915 return Fget(name, Qsymbol_macro, Qnil);
1918 /* Return the current value of SYM. The difference between this function
1919 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1920 this updates the CURRENT_VALUE slot of buffer-local variables to
1921 point to the current buffer, while symbol_value_in_buffer doesn't. */
1923 Lisp_Object find_symbol_value(Lisp_Object sym)
1925 /* WARNING: This function can be called when current_buffer is 0
1926 and Vselected_console is Qnil, early in initialization. */
1927 struct console *con;
1928 Lisp_Object valcontents;
1932 valcontents = XSYMBOL(sym)->value;
1933 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
1936 if (CONSOLEP(Vselected_console))
1937 con = XCONSOLE(Vselected_console);
1939 /* This can also get called while we're preparing to shutdown.
1940 #### What should really happen in that case? Should we
1941 actually fix things so we can't get here in that case? */
1943 assert(!initialized || preparing_for_armageddon);
1948 return find_symbol_value_1(sym, current_buffer, con, 1, Qnil, 1);
1951 /* This is an optimized function for quick lookup of buffer local symbols
1952 by avoiding O(n) search. This will work when either:
1953 a) We have already found the symbol e.g. by traversing local_var_alist.
1955 b) We know that the symbol will not be found in the current buffer's
1956 list of local variables.
1957 In the former case, find_it_p is 1 and symbol_cons is the element from
1958 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1961 This function is called from set_buffer_internal which does both of these
1964 Lisp_Object find_symbol_value_quickly(Lisp_Object symbol_cons, int find_it_p)
1966 /* WARNING: This function can be called when current_buffer is 0
1967 and Vselected_console is Qnil, early in initialization. */
1968 struct console *con;
1969 Lisp_Object sym = find_it_p ? XCAR(symbol_cons) : symbol_cons;
1972 if (CONSOLEP(Vselected_console))
1973 con = XCONSOLE(Vselected_console);
1975 /* This can also get called while we're preparing to shutdown.
1976 #### What should really happen in that case? Should we
1977 actually fix things so we can't get here in that case? */
1979 assert(!initialized || preparing_for_armageddon);
1984 return find_symbol_value_1(sym, current_buffer, con, 1,
1985 find_it_p ? symbol_cons : Qnil, find_it_p);
1988 DEFUN("symbol-value", Fsymbol_value, 1, 1, 0, /*
1989 Return SYMBOL's value. Error if that is void.
1993 Lisp_Object val = find_symbol_value(symbol);
1995 if (UNBOUNDP(val)) {
1996 Lisp_Object fd = search_symbol_macro(symbol);
2000 return Fsignal(Qvoid_variable, list1(symbol));
2005 DEFUN("set", Fset, 2, 2, 0, /*
2006 Set SYMBOL's value to NEWVAL, and return NEWVAL.
2010 REGISTER Lisp_Object valcontents;
2013 /* remember, we're called by Fmakunbound() as well */
2015 CHECK_SYMBOL(symbol);
2018 sym = XSYMBOL(symbol);
2019 valcontents = sym->value;
2021 if (EQ(symbol, Qnil) || EQ(symbol, Qt) || SYMBOL_IS_KEYWORD(symbol))
2022 reject_constant_symbols(symbol, newval, 0,
2023 UNBOUNDP(newval) ? Qmakunbound : Qset);
2025 if (UNBOUNDP(valcontents)) {
2026 ssm = search_symbol_macro(symbol);
2028 return Feval(list3(Qsetf, ssm, list2(Qquote, newval)));
2031 if (!SYMBOL_VALUE_MAGIC_P(valcontents) || UNBOUNDP(valcontents)) {
2032 sym->value = newval;
2036 reject_constant_symbols(symbol, newval, 0,
2037 UNBOUNDP(newval) ? Qmakunbound : Qset);
2039 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2040 case SYMVAL_LISP_MAGIC: {
2041 if (UNBOUNDP(newval)) {
2042 maybe_call_magic_handler(symbol, Qmakunbound,
2044 return XSYMBOL_VALUE_LISP_MAGIC(valcontents)->
2045 shadowed = Qunbound;
2047 maybe_call_magic_handler(symbol, Qset, 1,
2049 return XSYMBOL_VALUE_LISP_MAGIC(valcontents)->
2054 case SYMVAL_VARALIAS:
2055 symbol = follow_varalias_pointers(symbol, UNBOUNDP(newval)
2056 ? Qmakunbound : Qset);
2057 /* presto change-o! */
2060 case SYMVAL_FIXNUM_FORWARD:
2061 case SYMVAL_BOOLEAN_FORWARD:
2062 case SYMVAL_OBJECT_FORWARD:
2063 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2064 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2065 if (UNBOUNDP(newval))
2066 signal_error(Qerror,
2067 list2(build_string("Cannot makunbound"),
2071 /* case SYMVAL_UNBOUND_MARKER: break; */
2073 case SYMVAL_CURRENT_BUFFER_FORWARD: {
2074 const struct symbol_value_forward *fwd
2075 = XSYMBOL_VALUE_FORWARD(valcontents);
2076 int mask = XINT(*((Lisp_Object *)
2077 symbol_value_forward_forward(fwd)));
2079 /* Setting this variable makes it buffer-local */
2080 current_buffer->local_var_flags |= mask;
2084 case SYMVAL_SELECTED_CONSOLE_FORWARD: {
2085 const struct symbol_value_forward *fwd
2086 = XSYMBOL_VALUE_FORWARD(valcontents);
2087 int mask = XINT(*((Lisp_Object *)
2088 symbol_value_forward_forward(fwd)));
2090 /* Setting this variable makes it console-local */
2091 XCONSOLE(Vselected_console)->local_var_flags |=
2096 case SYMVAL_BUFFER_LOCAL:
2097 case SYMVAL_SOME_BUFFER_LOCAL: {
2098 /* If we want to examine or set the value and
2099 CURRENT-BUFFER is current, we just examine or set
2100 CURRENT-VALUE. If CURRENT-BUFFER is not current, we
2101 store the current CURRENT-VALUE value into
2102 CURRENT-ALIST- ELEMENT, then find the appropriate alist
2103 element for the buffer now current and set up
2104 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
2105 of that element, and store into CURRENT-BUFFER.
2107 If we are setting the variable and the current buffer does
2108 not have an alist entry for this variable, an alist entry is
2111 Note that CURRENT-VALUE can be a forwarding pointer.
2112 Each time it is examined or set, forwarding must be
2114 struct symbol_value_buffer_local *bfwd
2115 = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2116 int some_buffer_local_p =
2117 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
2118 /* What value are we caching right now? */
2119 Lisp_Object aelt = bfwd->current_alist_element;
2121 if (!NILP(bfwd->current_buffer) &&
2122 current_buffer == XBUFFER(bfwd->current_buffer)
2123 && ((some_buffer_local_p)
2124 ? 1 /* doesn't automatically become local */
2125 : !NILP(aelt) /* already local */
2127 /* Cache is valid */
2128 valcontents = bfwd->current_value;
2130 /* If the current buffer is not the buffer whose binding
2131 is currently cached, or if it's a SYMVAL_BUFFER_LOCAL
2132 and we're looking at the default value, the cache is
2133 invalid; we need to write it out, and find the new
2134 CURRENT-ALIST-ELEMENT
2137 /* Write out the cached value for the old buffer; copy
2138 it back to its alist element. This works if the
2139 current buffer only sees the default value, too. */
2140 write_out_buffer_local_cache(symbol, bfwd);
2142 /* Find the new value for CURRENT-ALIST-ELEMENT. */
2143 aelt = buffer_local_alist_element(current_buffer,
2146 /* This buffer is still seeing the default
2148 if (!some_buffer_local_p) {
2149 /* If it's a SYMVAL_BUFFER_LOCAL, give
2150 this buffer a new assoc for a local
2151 value and set CURRENT-ALIST-ELEMENT
2152 to point to that. */
2153 aelt = do_symval_forwarding(
2154 bfwd->current_value,
2156 XCONSOLE(Vselected_console));
2157 aelt = Fcons(symbol, aelt);
2158 current_buffer->local_var_alist =
2163 /* If the variable is a
2164 SYMVAL_SOME_BUFFER_LOCAL, we're
2165 currently seeing the default
2170 /* Cache the new buffer's assoc in
2171 CURRENT-ALIST-ELEMENT. */
2172 bfwd->current_alist_element = aelt;
2173 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is
2175 XSETBUFFER(bfwd->current_buffer,
2177 valcontents = bfwd->current_value;
2182 case SYMVAL_CONST_FIXNUM_FORWARD:
2183 case SYMVAL_CONST_BOOLEAN_FORWARD:
2184 case SYMVAL_CONST_SPECIFIER_FORWARD:
2185 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2186 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2187 case SYMVAL_CONST_OBJECT_FORWARD:
2188 case SYMVAL_UNBOUND_MARKER:
2192 store_symval_forwarding(symbol, valcontents, newval);
2197 /* Access or set a buffer-local symbol's default value. */
2199 /* Return the default value of SYM, but don't check for voidness.
2200 Return Qunbound if it is void. */
2202 static Lisp_Object default_value(Lisp_Object sym)
2204 Lisp_Object valcontents;
2209 valcontents = XSYMBOL(sym)->value;
2212 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2215 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2216 case SYMVAL_LISP_MAGIC:
2218 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2222 case SYMVAL_VARALIAS:
2223 sym = follow_varalias_pointers(sym, Qt /* #### kludge */ );
2224 /* presto change-o! */
2227 case SYMVAL_UNBOUND_MARKER:
2230 case SYMVAL_CURRENT_BUFFER_FORWARD: {
2231 const struct symbol_value_forward *fwd
2232 = XSYMBOL_VALUE_FORWARD(valcontents);
2233 return (*((Lisp_Object *)
2234 ((char *)XBUFFER(Vbuffer_defaults) +
2235 ((char *)symbol_value_forward_forward(fwd) -
2236 (char *)&buffer_local_flags))));
2239 case SYMVAL_SELECTED_CONSOLE_FORWARD: {
2240 const struct symbol_value_forward *fwd =
2241 XSYMBOL_VALUE_FORWARD(valcontents);
2242 return (*((Lisp_Object *)
2243 ((char *)XCONSOLE(Vconsole_defaults) +
2244 ((char *)symbol_value_forward_forward(fwd) -
2245 (char *)&console_local_flags))));
2248 case SYMVAL_BUFFER_LOCAL:
2249 case SYMVAL_SOME_BUFFER_LOCAL: {
2250 struct symbol_value_buffer_local *bfwd =
2251 XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2253 /* Handle user-created local variables. */
2254 /* If var is set up for a buffer that lacks a local value for
2255 it, the current value is nominally the default value. But
2256 the current value slot may be more up to date, since ordinary
2257 setq stores just that slot. So use that. */
2258 if (NILP(bfwd->current_alist_element))
2259 return do_symval_forwarding(
2260 bfwd->current_value,
2262 XCONSOLE(Vselected_console));
2264 return bfwd->default_value;
2267 case SYMVAL_FIXNUM_FORWARD:
2268 case SYMVAL_CONST_FIXNUM_FORWARD:
2269 case SYMVAL_BOOLEAN_FORWARD:
2270 case SYMVAL_CONST_BOOLEAN_FORWARD:
2271 case SYMVAL_OBJECT_FORWARD:
2272 case SYMVAL_CONST_OBJECT_FORWARD:
2273 case SYMVAL_CONST_SPECIFIER_FORWARD:
2274 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2275 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2276 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2277 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2280 /* For other variables, get the current value. */
2281 return do_symval_forwarding(valcontents, current_buffer,
2282 XCONSOLE(Vselected_console));
2285 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2288 DEFUN("default-boundp", Fdefault_boundp, 1, 1, 0, /*
2289 Return t if SYMBOL has a non-void default value.
2290 This is the value that is seen in buffers that do not have their own values
2295 return UNBOUNDP(default_value(symbol)) ? Qnil : Qt;
2298 DEFUN("default-value", Fdefault_value, 1, 1, 0, /*
2299 Return SYMBOL's default value.
2300 This is the value that is seen in buffers that do not have their own values
2301 for this variable. The default value is meaningful for variables with
2302 local bindings in certain buffers.
2306 Lisp_Object value = default_value(symbol);
2308 return UNBOUNDP(value) ? Fsignal(Qvoid_variable, list1(symbol)) : value;
2311 DEFUN("set-default", Fset_default, 2, 2, 0, /*
2312 Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated.
2313 The default value is seen in buffers that do not have their own values
2318 Lisp_Object valcontents;
2320 CHECK_SYMBOL(symbol);
2323 valcontents = XSYMBOL(symbol)->value;
2326 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2327 return Fset(symbol, value);
2329 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2330 case SYMVAL_LISP_MAGIC:
2331 RETURN_IF_NOT_UNBOUND(maybe_call_magic_handler
2332 (symbol, Qset_default, 1, value));
2333 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2337 case SYMVAL_VARALIAS:
2338 symbol = follow_varalias_pointers(symbol, Qset_default);
2339 /* presto change-o! */
2342 case SYMVAL_CURRENT_BUFFER_FORWARD:
2343 set_default_buffer_slot_variable(symbol, value);
2346 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2347 set_default_console_slot_variable(symbol, value);
2350 case SYMVAL_BUFFER_LOCAL:
2351 case SYMVAL_SOME_BUFFER_LOCAL: {
2352 /* Store new value into the DEFAULT-VALUE slot */
2353 struct symbol_value_buffer_local *bfwd
2354 = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2356 bfwd->default_value = value;
2357 /* If current-buffer doesn't shadow default_value,
2358 * we must set the CURRENT-VALUE slot too */
2359 if (NILP(bfwd->current_alist_element))
2360 store_symval_forwarding(symbol,
2361 bfwd->current_value,
2366 case SYMVAL_FIXNUM_FORWARD:
2367 case SYMVAL_CONST_FIXNUM_FORWARD:
2368 case SYMVAL_BOOLEAN_FORWARD:
2369 case SYMVAL_CONST_BOOLEAN_FORWARD:
2370 case SYMVAL_OBJECT_FORWARD:
2371 case SYMVAL_CONST_OBJECT_FORWARD:
2372 case SYMVAL_CONST_SPECIFIER_FORWARD:
2373 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2374 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2375 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2376 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2377 case SYMVAL_UNBOUND_MARKER:
2380 return Fset(symbol, value);
2384 DEFUN("setq-default", Fsetq_default, 0, UNEVALLED, 0, /*
2385 Set the default value of variable SYMBOL to VALUE.
2386 SYMBOL, the variable name, is literal (not evaluated);
2387 VALUE is an expression and it is evaluated.
2388 The default value of a variable is seen in buffers
2389 that do not have their own values for the variable.
2391 More generally, you can use multiple variables and values, as in
2392 (setq-default SYMBOL VALUE SYMBOL VALUE...)
2393 This sets each SYMBOL's default value to the corresponding VALUE.
2394 The VALUE for the Nth SYMBOL can refer to the new default values
2395 of previous SYMBOLs.
2399 /* This function can GC */
2400 Lisp_Object symbol, tail, val = Qnil;
2402 struct gcpro gcpro1;
2404 GET_LIST_LENGTH(args, nargs);
2406 if (nargs & 1) /* Odd number of arguments? */
2407 Fsignal(Qwrong_number_of_arguments,
2408 list2(Qsetq_default, make_int(nargs)));
2412 PROPERTY_LIST_LOOP(tail, symbol, val, args) {
2414 Fset_default(symbol, val);
2421 /* Lisp functions for creating and removing buffer-local variables. */
2423 DEFUN("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1, "vMake Variable Buffer Local: ", /*
2424 Make VARIABLE have a separate value for each buffer.
2425 At any time, the value for the current buffer is in effect.
2426 There is also a default value which is seen in any buffer which has not yet
2428 Using `set' or `setq' to set the variable causes it to have a separate value
2429 for the current buffer if it was previously using the default value.
2430 The function `default-value' gets the default value and `set-default'
2435 Lisp_Object valcontents;
2437 CHECK_SYMBOL(variable);
2440 verify_ok_for_buffer_local(variable, Qmake_variable_buffer_local);
2442 valcontents = XSYMBOL(variable)->value;
2445 if (SYMBOL_VALUE_MAGIC_P(valcontents)) {
2446 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2447 case SYMVAL_LISP_MAGIC:
2448 if (!UNBOUNDP(maybe_call_magic_handler
2449 (variable, Qmake_variable_buffer_local,
2453 XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2457 case SYMVAL_VARALIAS:
2458 variable = follow_varalias_pointers(
2460 Qmake_variable_buffer_local);
2461 /* presto change-o! */
2464 case SYMVAL_FIXNUM_FORWARD:
2465 case SYMVAL_BOOLEAN_FORWARD:
2466 case SYMVAL_OBJECT_FORWARD:
2467 case SYMVAL_UNBOUND_MARKER:
2470 case SYMVAL_CURRENT_BUFFER_FORWARD:
2471 case SYMVAL_BUFFER_LOCAL:
2472 /* Already per-each-buffer */
2475 case SYMVAL_SOME_BUFFER_LOCAL:
2477 XSYMBOL_VALUE_BUFFER_LOCAL(valcontents)->magic.type =
2478 SYMVAL_BUFFER_LOCAL;
2481 case SYMVAL_CONST_FIXNUM_FORWARD:
2482 case SYMVAL_CONST_BOOLEAN_FORWARD:
2483 case SYMVAL_CONST_OBJECT_FORWARD:
2484 case SYMVAL_CONST_SPECIFIER_FORWARD:
2485 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2486 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2487 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2488 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2489 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2497 struct symbol_value_buffer_local *bfwd
2498 = alloc_lcrecord_type(struct symbol_value_buffer_local,
2499 &lrecord_symbol_value_buffer_local);
2501 zero_lcrecord(&bfwd->magic);
2502 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2504 bfwd->default_value = find_symbol_value(variable);
2505 bfwd->current_value = valcontents;
2506 bfwd->current_alist_element = Qnil;
2507 bfwd->current_buffer = Fcurrent_buffer();
2508 XSETSYMBOL_VALUE_MAGIC(foo, bfwd);
2509 *value_slot_past_magic(variable) = foo;
2510 #if 1 /* #### Yuck! FSFmacs bug-compatibility */
2511 /* This sets the default-value of any make-variable-buffer-local to nil.
2512 That just sucks. User can just use setq-default to effect that,
2513 but there's no way to do makunbound-default to undo this lossage. */
2514 if (UNBOUNDP(valcontents))
2515 bfwd->default_value = Qnil;
2517 #if 0 /* #### Yuck! */
2518 /* This sets the value to nil in this buffer.
2519 User could use (setq variable nil) to do this.
2520 It isn't as egregious to do this automatically
2521 as it is to do so to the default-value, but it's
2522 still really dubious. */
2523 if (UNBOUNDP(valcontents))
2524 Fset(variable, Qnil);
2530 DEFUN("make-local-variable", Fmake_local_variable, 1, 1, "vMake Local Variable: ", /*
2531 Make VARIABLE have a separate value in the current buffer.
2532 Other buffers will continue to share a common default value.
2533 \(The buffer-local value of VARIABLE starts out as the same value
2534 VARIABLE previously had. If VARIABLE was void, it remains void.)
2535 See also `make-variable-buffer-local'.
2537 If the variable is already arranged to become local when set,
2538 this function causes a local value to exist for this buffer,
2539 just as setting the variable would do.
2541 Do not use `make-local-variable' to make a hook variable buffer-local.
2542 Use `make-local-hook' instead.
2546 Lisp_Object valcontents;
2547 struct symbol_value_buffer_local *bfwd;
2549 CHECK_SYMBOL(variable);
2552 verify_ok_for_buffer_local(variable, Qmake_local_variable);
2554 valcontents = XSYMBOL(variable)->value;
2557 if (SYMBOL_VALUE_MAGIC_P(valcontents)) {
2558 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2559 case SYMVAL_LISP_MAGIC:
2560 if (!UNBOUNDP(maybe_call_magic_handler
2561 (variable, Qmake_local_variable, 0)))
2564 XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2568 case SYMVAL_VARALIAS:
2570 follow_varalias_pointers(variable,
2571 Qmake_local_variable);
2572 /* presto change-o! */
2575 case SYMVAL_FIXNUM_FORWARD:
2576 case SYMVAL_BOOLEAN_FORWARD:
2577 case SYMVAL_OBJECT_FORWARD:
2578 case SYMVAL_UNBOUND_MARKER:
2581 case SYMVAL_BUFFER_LOCAL:
2582 case SYMVAL_CURRENT_BUFFER_FORWARD: {
2583 /* Make sure the symbol has a local value in this
2584 particular buffer, by setting it to the same value it
2586 Fset(variable, find_symbol_value(variable));
2590 case SYMVAL_SOME_BUFFER_LOCAL: {
2591 if (!NILP(buffer_local_alist_element
2592 (current_buffer, variable,
2593 (XSYMBOL_VALUE_BUFFER_LOCAL(valcontents)))))
2594 goto already_local_to_current_buffer;
2596 goto already_local_to_some_other_buffer;
2599 case SYMVAL_CONST_FIXNUM_FORWARD:
2600 case SYMVAL_CONST_BOOLEAN_FORWARD:
2601 case SYMVAL_CONST_OBJECT_FORWARD:
2602 case SYMVAL_CONST_SPECIFIER_FORWARD:
2603 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2604 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2605 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2606 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2607 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2613 /* Make sure variable is set up to hold per-buffer values */
2614 bfwd = alloc_lcrecord_type(struct symbol_value_buffer_local,
2615 &lrecord_symbol_value_buffer_local);
2616 zero_lcrecord(&bfwd->magic);
2617 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2619 bfwd->current_buffer = Qnil;
2620 bfwd->current_alist_element = Qnil;
2621 bfwd->current_value = valcontents;
2622 /* passing 0 is OK because this should never be a
2623 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2625 bfwd->default_value = do_symval_forwarding(valcontents, 0, 0);
2628 if (UNBOUNDP(bfwd->default_value))
2629 bfwd->default_value = Qnil; /* Yuck! */
2632 XSETSYMBOL_VALUE_MAGIC(valcontents, bfwd);
2633 *value_slot_past_magic(variable) = valcontents;
2635 already_local_to_some_other_buffer:
2637 /* Make sure this buffer has its own value of variable */
2638 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2640 if (UNBOUNDP(bfwd->default_value)) {
2641 /* If default value is unbound, set local value to nil. */
2642 XSETBUFFER(bfwd->current_buffer, current_buffer);
2643 bfwd->current_alist_element = Fcons(variable, Qnil);
2644 current_buffer->local_var_alist =
2645 Fcons(bfwd->current_alist_element,
2646 current_buffer->local_var_alist);
2647 store_symval_forwarding(variable, bfwd->current_value, Qnil);
2651 current_buffer->local_var_alist
2652 = Fcons(Fcons(variable, bfwd->default_value),
2653 current_buffer->local_var_alist);
2655 /* Make sure symbol does not think it is set up for this buffer;
2656 force it to look once again for this buffer's value */
2657 if (!NILP(bfwd->current_buffer) &&
2658 current_buffer == XBUFFER(bfwd->current_buffer))
2659 bfwd->current_buffer = Qnil;
2661 already_local_to_current_buffer:
2663 /* If the symbol forwards into a C variable, then swap in the
2664 variable for this buffer immediately. If C code modifies the
2665 variable before we swap in, then that new value will clobber the
2666 default value the next time we swap. */
2667 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2668 if (SYMBOL_VALUE_MAGIC_P(bfwd->current_value)) {
2669 switch (XSYMBOL_VALUE_MAGIC_TYPE(bfwd->current_value)) {
2670 case SYMVAL_FIXNUM_FORWARD:
2671 case SYMVAL_BOOLEAN_FORWARD:
2672 case SYMVAL_OBJECT_FORWARD:
2673 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2674 set_up_buffer_local_cache(variable, bfwd,
2675 current_buffer, Qnil, 1);
2678 case SYMVAL_UNBOUND_MARKER:
2679 case SYMVAL_CURRENT_BUFFER_FORWARD:
2682 case SYMVAL_CONST_FIXNUM_FORWARD:
2683 case SYMVAL_CONST_BOOLEAN_FORWARD:
2684 case SYMVAL_CONST_OBJECT_FORWARD:
2685 case SYMVAL_CONST_SPECIFIER_FORWARD:
2686 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2687 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2688 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2689 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2690 case SYMVAL_BUFFER_LOCAL:
2691 case SYMVAL_SOME_BUFFER_LOCAL:
2692 case SYMVAL_LISP_MAGIC:
2693 case SYMVAL_VARALIAS:
2703 DEFUN("kill-local-variable", Fkill_local_variable, 1, 1, "vKill Local Variable: ", /*
2704 Make VARIABLE no longer have a separate value in the current buffer.
2705 From now on the default value will apply in this buffer.
2709 Lisp_Object valcontents;
2711 CHECK_SYMBOL(variable);
2714 valcontents = XSYMBOL(variable)->value;
2717 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2720 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2721 case SYMVAL_LISP_MAGIC:
2722 if (!UNBOUNDP(maybe_call_magic_handler
2723 (variable, Qkill_local_variable, 0)))
2725 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2729 case SYMVAL_VARALIAS:
2731 follow_varalias_pointers(variable, Qkill_local_variable);
2732 /* presto change-o! */
2735 case SYMVAL_CURRENT_BUFFER_FORWARD: {
2736 const struct symbol_value_forward *fwd
2737 = XSYMBOL_VALUE_FORWARD(valcontents);
2738 int offset = ((char *)symbol_value_forward_forward(fwd)
2739 - (char *)&buffer_local_flags);
2740 int mask = XINT(*((Lisp_Object *)
2741 symbol_value_forward_forward(fwd)));
2744 int (*magicfun) (Lisp_Object sym,
2746 Lisp_Object in_object,
2748 symbol_value_forward_magicfun(fwd);
2749 Lisp_Object oldval = *(Lisp_Object *)
2750 (offset + (char *)XBUFFER(Vbuffer_defaults));
2752 (magicfun) (variable, &oldval,
2753 make_buffer(current_buffer),
2756 *(Lisp_Object *)(offset + (char *)current_buffer) =
2758 current_buffer->local_var_flags &= ~mask;
2763 case SYMVAL_BUFFER_LOCAL:
2764 case SYMVAL_SOME_BUFFER_LOCAL: {
2765 /* Get rid of this buffer's alist element, if any */
2766 struct symbol_value_buffer_local *bfwd
2767 = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2768 Lisp_Object alist = current_buffer->local_var_alist;
2769 Lisp_Object alist_element
2771 buffer_local_alist_element(current_buffer, variable,
2774 if (!NILP(alist_element))
2775 current_buffer->local_var_alist =
2776 Fdelq(alist_element, alist);
2778 /* Make sure symbol does not think it is set up for this buffer;
2779 force it to look once again for this buffer's value */
2780 if (!NILP(bfwd->current_buffer) &&
2781 current_buffer == XBUFFER(bfwd->current_buffer))
2782 bfwd->current_buffer = Qnil;
2784 /* We just changed the value in the current_buffer. If this
2785 variable forwards to a C variable, we need to change the
2786 value of the C variable. set_up_buffer_local_cache() will do
2787 this. It doesn't hurt to do it always, so just go ahead and
2789 set_up_buffer_local_cache(variable, bfwd,
2790 current_buffer, Qnil, 1);
2794 case SYMVAL_FIXNUM_FORWARD:
2795 case SYMVAL_CONST_FIXNUM_FORWARD:
2796 case SYMVAL_BOOLEAN_FORWARD:
2797 case SYMVAL_CONST_BOOLEAN_FORWARD:
2798 case SYMVAL_OBJECT_FORWARD:
2799 case SYMVAL_CONST_OBJECT_FORWARD:
2800 case SYMVAL_CONST_SPECIFIER_FORWARD:
2801 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2802 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2803 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2804 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2805 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2806 case SYMVAL_UNBOUND_MARKER:
2811 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2814 DEFUN("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2815 "vKill Console Local Variable: ", /*
2816 Make VARIABLE no longer have a separate value in the selected console.
2817 From now on the default value will apply in this console.
2821 Lisp_Object valcontents;
2823 CHECK_SYMBOL(variable);
2826 valcontents = XSYMBOL(variable)->value;
2829 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2832 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2833 case SYMVAL_LISP_MAGIC:
2834 if (!UNBOUNDP(maybe_call_magic_handler
2835 (variable, Qkill_console_local_variable, 0)))
2837 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2841 case SYMVAL_VARALIAS:
2842 variable = follow_varalias_pointers(variable,
2843 Qkill_console_local_variable);
2844 /* presto change-o! */
2847 case SYMVAL_SELECTED_CONSOLE_FORWARD: {
2848 const struct symbol_value_forward *fwd
2849 = XSYMBOL_VALUE_FORWARD(valcontents);
2850 int offset = ((char *)symbol_value_forward_forward(fwd)
2851 - (char *)&console_local_flags);
2852 int mask = XINT(*((Lisp_Object *)
2853 symbol_value_forward_forward(fwd)));
2856 int (*magicfun) (Lisp_Object sym,
2858 Lisp_Object in_object,
2860 symbol_value_forward_magicfun(fwd);
2861 Lisp_Object oldval = *(Lisp_Object *)
2863 (char *)XCONSOLE(Vconsole_defaults));
2865 magicfun(variable, &oldval,
2866 Vselected_console, 0);
2868 *(Lisp_Object *) (offset +
2869 (char *)XCONSOLE(Vselected_console)) =
2871 XCONSOLE(Vselected_console)->local_var_flags &= ~mask;
2876 case SYMVAL_FIXNUM_FORWARD:
2877 case SYMVAL_CONST_FIXNUM_FORWARD:
2878 case SYMVAL_BOOLEAN_FORWARD:
2879 case SYMVAL_CONST_BOOLEAN_FORWARD:
2880 case SYMVAL_OBJECT_FORWARD:
2881 case SYMVAL_CONST_OBJECT_FORWARD:
2882 case SYMVAL_CONST_SPECIFIER_FORWARD:
2883 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2884 case SYMVAL_CURRENT_BUFFER_FORWARD:
2885 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2886 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2887 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2888 case SYMVAL_UNBOUND_MARKER:
2889 case SYMVAL_BUFFER_LOCAL:
2890 case SYMVAL_SOME_BUFFER_LOCAL:
2897 /* Used by specbind to determine what effects it might have. Returns:
2898 * 0 if symbol isn't buffer-local, and wouldn't be after it is set
2899 * <0 if symbol isn't presently buffer-local, but set would make it so
2900 * >0 if symbol is presently buffer-local
2902 int symbol_value_buffer_local_info(Lisp_Object symbol, struct buffer *buffer)
2904 Lisp_Object valcontents;
2907 valcontents = XSYMBOL(symbol)->value;
2910 if (SYMBOL_VALUE_MAGIC_P(valcontents)) {
2911 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2912 case SYMVAL_LISP_MAGIC:
2915 XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2919 case SYMVAL_VARALIAS:
2921 follow_varalias_pointers(symbol,
2922 Qt /* #### kludge */ );
2923 /* presto change-o! */
2926 case SYMVAL_CURRENT_BUFFER_FORWARD: {
2927 const struct symbol_value_forward *fwd
2928 = XSYMBOL_VALUE_FORWARD(valcontents);
2929 int mask = XINT(*((Lisp_Object *)
2930 symbol_value_forward_forward
2933 (buffer && (buffer->local_var_flags & mask))){
2934 /* Already buffer-local */
2937 /* Would be buffer-local after set */
2941 case SYMVAL_BUFFER_LOCAL:
2942 case SYMVAL_SOME_BUFFER_LOCAL: {
2943 struct symbol_value_buffer_local *bfwd
2944 = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2947 !NILP(buffer_local_alist_element
2948 (buffer, symbol, bfwd)))
2951 /* Automatically becomes local when set */
2952 return bfwd->magic.type ==
2953 SYMVAL_BUFFER_LOCAL ? -1 : 0;
2956 case SYMVAL_FIXNUM_FORWARD:
2957 case SYMVAL_CONST_FIXNUM_FORWARD:
2958 case SYMVAL_BOOLEAN_FORWARD:
2959 case SYMVAL_CONST_BOOLEAN_FORWARD:
2960 case SYMVAL_OBJECT_FORWARD:
2961 case SYMVAL_CONST_OBJECT_FORWARD:
2962 case SYMVAL_CONST_SPECIFIER_FORWARD:
2963 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2964 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2965 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2966 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2967 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2968 case SYMVAL_UNBOUND_MARKER:
2977 DEFUN("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2978 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2980 (symbol, buffer, unbound_value))
2983 CHECK_SYMBOL(symbol);
2984 CHECK_BUFFER(buffer);
2985 value = symbol_value_in_buffer(symbol, buffer);
2986 return UNBOUNDP(value) ? unbound_value : value;
2989 DEFUN("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2990 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2992 (symbol, console, unbound_value))
2995 CHECK_SYMBOL(symbol);
2996 CHECK_CONSOLE(console);
2997 value = symbol_value_in_console(symbol, console);
2998 return UNBOUNDP(value) ? unbound_value : value;
3001 DEFUN("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
3002 -in variable, return info about this; else return nil.
3003 ll be a symbol, one of
3005 A simple built-in variable.
3006 Same, but cannot be set.
3007 A built-in integer variable.
3008 Same, but cannot be set.
3009 A built-in boolean variable.
3010 Same, but cannot be set.
3011 Always contains a specifier; e.g. `has-modeline-p'.
3012 A built-in buffer-local variable.
3013 fer' Same, but cannot be set.
3014 Forwards to the default value of a built-in
3015 buffer-local variable.
3016 A built-in console-local variable.
3017 nsole' Same, but cannot be set.
3018 Forwards to the default value of a built-in
3019 console-local variable.
3023 REGISTER Lisp_Object valcontents;
3025 CHECK_SYMBOL(symbol);
3028 valcontents = XSYMBOL(symbol)->value;
3031 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
3034 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
3035 case SYMVAL_LISP_MAGIC:
3036 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
3040 case SYMVAL_VARALIAS:
3041 symbol = follow_varalias_pointers(symbol, Qt);
3042 /* presto change-o! */
3045 case SYMVAL_BUFFER_LOCAL:
3046 case SYMVAL_SOME_BUFFER_LOCAL:
3048 XSYMBOL_VALUE_BUFFER_LOCAL(valcontents)->current_value;
3052 case SYMVAL_FIXNUM_FORWARD:
3054 case SYMVAL_CONST_FIXNUM_FORWARD:
3055 return Qconst_integer;
3056 case SYMVAL_BOOLEAN_FORWARD:
3058 case SYMVAL_CONST_BOOLEAN_FORWARD:
3059 return Qconst_boolean;
3060 case SYMVAL_OBJECT_FORWARD:
3062 case SYMVAL_CONST_OBJECT_FORWARD:
3063 return Qconst_object;
3064 case SYMVAL_CONST_SPECIFIER_FORWARD:
3065 return Qconst_specifier;
3066 case SYMVAL_DEFAULT_BUFFER_FORWARD:
3067 return Qdefault_buffer;
3068 case SYMVAL_CURRENT_BUFFER_FORWARD:
3069 return Qcurrent_buffer;
3070 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
3071 return Qconst_current_buffer;
3072 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
3073 return Qdefault_console;
3074 case SYMVAL_SELECTED_CONSOLE_FORWARD:
3075 return Qselected_console;
3076 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
3077 return Qconst_selected_console;
3078 case SYMVAL_UNBOUND_MARKER:
3087 DEFUN("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
3088 n t if SYMBOL's value is local to BUFFER.
3089 tional third arg AFTER-SET is non-nil, return t if SYMBOL would be
3090 r-local after it is set, regardless of whether it is so presently.
3091 value for BUFFER is *not* the same as (current-buffer), but means
3092 uffer". Specifically:
3094 If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
3095 the variable is one of the special built-in variables that is always
3096 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
3097 `buffer-undo-list', and others.)
3099 If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
3100 the variable has had `make-variable-buffer-local' applied to it.
3102 (symbol, buffer, after_set))
3106 CHECK_SYMBOL(symbol);
3107 if (!NILP(buffer)) {
3108 buffer = emacs_get_buffer(buffer, 1);
3110 symbol_value_buffer_local_info(symbol, XBUFFER(buffer));
3112 local_info = symbol_value_buffer_local_info(symbol, 0);
3115 if (NILP(after_set))
3116 return local_info > 0 ? Qt : Qnil;
3118 return local_info != 0 ? Qt : Qnil;
3122 I've gone ahead and partially implemented this because it's
3123 super-useful for dealing with the compatibility problems in supporting
3124 the old pointer-shape variables, and preventing people from `setq'ing
3125 the new variables. Any other way of handling this problem is way
3126 ugly, likely to be slow, and generally not something I want to waste
3127 my time worrying about.
3129 The interface and/or function name is sure to change before this
3130 gets into its final form. I currently like the way everything is
3131 set up and it has all the features I want it to have, except for
3132 one: I really want to be able to have multiple nested handlers,
3133 to implement an `advice'-like capability. This would allow,
3134 for example, a clean way of implementing `debug-if-set' or
3135 `debug-if-referenced' and such.
3137 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
3138 ************************************************************
3139 **Only** the `set-value', `make-unbound', and `make-local'
3140 handler types are currently implemented. Implementing the
3141 get-value and bound-predicate handlers is somewhat tricky
3142 because there are lots of subfunctions (e.g. find_symbol_value()).
3143 find_symbol_value(), in fact, is called from outside of
3144 this module. You'd have to have it do this:
3146 -- check for a `bound-predicate' handler, call that if so;
3147 if it returns nil, return Qunbound
3148 -- check for a `get-value' handler and call it and return
3151 It gets even trickier when you have to deal with
3152 sub-subfunctions like find_symbol_value_1(), and esp.
3153 when you have to properly handle variable aliases, which
3154 can lead to lots of tricky situations. So I've just
3155 punted on this, since the interface isn't officially
3156 exported and we can get by with just a `set-value'
3159 Actions in unimplemented handler types will correctly
3160 ignore any handlers, and will not fuck anything up or
3163 WARNING WARNING: If you do go and implement another
3164 type of handler, make *sure* to change
3165 would_be_magic_handled() so it knows about this,
3166 or dire things could result.
3167 ************************************************************
3168 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
3170 Real documentation is as follows.
3172 Set a magic handler for VARIABLE.
3173 This allows you to specify arbitrary behavior that results from
3174 accessing or setting a variable. For example, retrieving the
3175 variable's value might actually retrieve the first element off of
3176 a list stored in another variable, and setting the variable's value
3177 might add an element to the front of that list. (This is how the
3178 obsolete variable `unread-command-event' is implemented.)
3180 In general it is NOT good programming practice to use magic variables
3181 in a new package that you are designing. If you feel the need to
3182 do this, it's almost certainly a sign that you should be using a
3183 function instead of a variable. This facility is provided to allow
3184 a package to support obsolete variables and provide compatibility
3185 with similar packages with different variable names and semantics.
3186 By using magic handlers, you can cleanly provide obsoleteness and
3187 compatibility support and separate this support from the core
3188 routines in a package.
3190 VARIABLE should be a symbol naming the variable for which the
3191 magic behavior is provided. HANDLER-TYPE is a symbol specifying
3192 which behavior is being controlled, and HANDLER is the function
3193 that will be called to control this behavior. HARG is a
3194 value that will be passed to HANDLER but is otherwise
3195 uninterpreted. KEEP-EXISTING specifies what to do with existing
3196 handlers of the same type; nil means "erase them all", t means
3197 "keep them but insert at the beginning", the list (t) means
3198 "keep them but insert at the end", a function means "keep
3199 them but insert before the specified function", a list containing
3200 a function means "keep them but insert after the specified
3203 You can specify magic behavior for any type of variable at all,
3204 and for any handler types that are unspecified, the standard
3205 behavior applies. This allows you, for example, to use
3206 `defvaralias' in conjunction with this function. (For that
3207 matter, `defvaralias' could be implemented using this function.)
3209 The behaviors that can be specified in HANDLER-TYPE are
3211 get-value (SYM ARGS FUN HARG HANDLERS)
3212 This means that one of the functions `symbol-value',
3213 `default-value', `symbol-value-in-buffer', or
3214 `symbol-value-in-console' was called on SYM.
3216 set-value (SYM ARGS FUN HARG HANDLERS)
3217 This means that one of the functions `set' or `set-default'
3220 bound-predicate (SYM ARGS FUN HARG HANDLERS)
3221 This means that one of the functions `boundp', `globally-boundp',
3222 or `default-boundp' was called on SYM.
3224 make-unbound (SYM ARGS FUN HARG HANDLERS)
3225 This means that the function `makunbound' was called on SYM.
3227 local-predicate (SYM ARGS FUN HARG HANDLERS)
3228 This means that the function `local-variable-p' was called
3231 make-local (SYM ARGS FUN HARG HANDLERS)
3232 This means that one of the functions `make-local-variable',
3233 `make-variable-buffer-local', `kill-local-variable',
3234 or `kill-console-local-variable' was called on SYM.
3236 The meanings of the arguments are as follows:
3238 SYM is the symbol on which the function was called, and is always
3239 the first argument to the function.
3241 ARGS are the remaining arguments in the original call (i.e. all
3242 but the first). In the case of `set-value' in particular,
3243 the first element of ARGS is the value to which the variable
3244 is being set. In some cases, ARGS is sanitized from what was
3245 actually given. For example, whenever `nil' is passed to an
3246 argument and it means `current-buffer', the current buffer is
3247 substituted instead.
3249 FUN is a symbol indicating which function is being called.
3250 For many of the functions, you can determine the corresponding
3251 function of a different class using
3252 `symbol-function-corresponding-function'.
3254 HARG is the argument that was given in the call
3255 to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
3257 HANDLERS is a structure containing the remaining handlers
3258 for the variable; to call one of them, use
3259 `chain-to-symbol-value-handler'.
3261 NOTE: You may *not* modify the list in ARGS, and if you want to
3262 keep it around after the handler function exits, you must make
3263 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
3266 static enum lisp_magic_handler decode_magic_handler_type(Lisp_Object symbol)
3268 if (EQ(symbol, Qget_value))
3269 return MAGIC_HANDLER_GET_VALUE;
3270 if (EQ(symbol, Qset_value))
3271 return MAGIC_HANDLER_SET_VALUE;
3272 if (EQ(symbol, Qbound_predicate))
3273 return MAGIC_HANDLER_BOUND_PREDICATE;
3274 if (EQ(symbol, Qmake_unbound))
3275 return MAGIC_HANDLER_MAKE_UNBOUND;
3276 if (EQ(symbol, Qlocal_predicate))
3277 return MAGIC_HANDLER_LOCAL_PREDICATE;
3278 if (EQ(symbol, Qmake_local))
3279 return MAGIC_HANDLER_MAKE_LOCAL;
3281 signal_simple_error("Unrecognized symbol value handler type", symbol);
3283 return MAGIC_HANDLER_MAX;
3286 static enum lisp_magic_handler
3287 handler_type_from_function_symbol(Lisp_Object funsym, int abort_if_not_found)
3289 if (EQ(funsym, Qsymbol_value)
3290 || EQ(funsym, Qdefault_value)
3291 || EQ(funsym, Qsymbol_value_in_buffer)
3292 || EQ(funsym, Qsymbol_value_in_console))
3293 return MAGIC_HANDLER_GET_VALUE;
3295 if (EQ(funsym, Qset)
3296 || EQ(funsym, Qset_default))
3297 return MAGIC_HANDLER_SET_VALUE;
3299 if (EQ(funsym, Qboundp)
3300 || EQ(funsym, Qglobally_boundp)
3301 || EQ(funsym, Qdefault_boundp))
3302 return MAGIC_HANDLER_BOUND_PREDICATE;
3304 if (EQ(funsym, Qmakunbound))
3305 return MAGIC_HANDLER_MAKE_UNBOUND;
3307 if (EQ(funsym, Qlocal_variable_p))
3308 return MAGIC_HANDLER_LOCAL_PREDICATE;
3310 if (EQ(funsym, Qmake_variable_buffer_local)
3311 || EQ(funsym, Qmake_local_variable))
3312 return MAGIC_HANDLER_MAKE_LOCAL;
3314 if (abort_if_not_found)
3316 signal_simple_error("Unrecognized symbol-value function", funsym);
3317 return MAGIC_HANDLER_MAX;
3320 static int would_be_magic_handled(Lisp_Object sym, Lisp_Object funsym)
3322 /* does not take into account variable aliasing. */
3323 Lisp_Object valcontents = XSYMBOL(sym)->value;
3324 enum lisp_magic_handler slot;
3326 if (!SYMBOL_VALUE_LISP_MAGIC_P(valcontents))
3328 slot = handler_type_from_function_symbol(funsym, 1);
3329 if (slot != MAGIC_HANDLER_SET_VALUE
3330 && slot != MAGIC_HANDLER_MAKE_UNBOUND
3331 && slot != MAGIC_HANDLER_MAKE_LOCAL)
3332 /* #### temporary kludge because we haven't implemented
3333 lisp-magic variables completely */
3335 return !NILP(XSYMBOL_VALUE_LISP_MAGIC(valcontents)->handler[slot]);
3339 fetch_value_maybe_past_magic(Lisp_Object sym,
3340 Lisp_Object follow_past_lisp_magic)
3342 Lisp_Object value = XSYMBOL(sym)->value;
3343 if (SYMBOL_VALUE_LISP_MAGIC_P(value)
3344 && (EQ(follow_past_lisp_magic, Qt)
3345 || (!NILP(follow_past_lisp_magic)
3346 && !would_be_magic_handled(sym, follow_past_lisp_magic))))
3347 value = XSYMBOL_VALUE_LISP_MAGIC(value)->shadowed;
3351 static Lisp_Object *value_slot_past_magic(Lisp_Object sym)
3353 Lisp_Object *store_pointer = &XSYMBOL(sym)->value;
3355 if (SYMBOL_VALUE_LISP_MAGIC_P(*store_pointer))
3356 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC(sym)->shadowed;
3357 return store_pointer;
3361 maybe_call_magic_handler(Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
3364 Lisp_Object args[20]; /* should be enough ... */
3366 enum lisp_magic_handler htype;
3367 Lisp_Object legerdemain;
3368 struct symbol_value_lisp_magic *bfwd;
3370 assert(nargs >= 0 && nargs < countof(args));
3371 legerdemain = XSYMBOL(sym)->value;
3372 assert(SYMBOL_VALUE_LISP_MAGIC_P(legerdemain));
3373 bfwd = XSYMBOL_VALUE_LISP_MAGIC(legerdemain);
3375 va_start(vargs, nargs);
3376 for (i = 0; i < nargs; i++)
3377 args[i] = va_arg(vargs, Lisp_Object);
3380 htype = handler_type_from_function_symbol(funsym, 1);
3381 if (NILP(bfwd->handler[htype]))
3383 /* #### should be reusing the arglist, not always consing anew.
3384 Repeated handler invocations should not cause repeated consing.
3385 Doesn't matter for now, because this is just a quick implementation
3386 for obsolescence support. */
3387 return call5(bfwd->handler[htype], sym, Flist(nargs, args), funsym,
3388 bfwd->harg[htype], Qnil);
3391 DEFUN("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler, 3, 5, 0, /*
3392 Don't you dare use this.
3393 If you do, suffer the wrath of Ben, who is likely to rename
3394 this function (or change the semantics of its arguments) without
3395 pity, thereby invalidating your code.
3397 (variable, handler_type, handler, harg, keep_existing))
3399 Lisp_Object valcontents;
3400 struct symbol_value_lisp_magic *bfwd;
3401 enum lisp_magic_handler htype;
3404 /* #### WARNING, only some handler types are implemented. See above.
3405 Actions of other types will ignore a handler if it's there.
3407 #### Also, `chain-to-symbol-value-handler' and
3408 `symbol-function-corresponding-function' are not implemented. */
3409 CHECK_SYMBOL(variable);
3410 CHECK_SYMBOL(handler_type);
3411 htype = decode_magic_handler_type(handler_type);
3412 valcontents = XSYMBOL(variable)->value;
3413 if (!SYMBOL_VALUE_LISP_MAGIC_P(valcontents)) {
3414 bfwd = alloc_lcrecord_type(struct symbol_value_lisp_magic,
3415 &lrecord_symbol_value_lisp_magic);
3416 zero_lcrecord(&bfwd->magic);
3417 bfwd->magic.type = SYMVAL_LISP_MAGIC;
3418 for (i = 0; i < MAGIC_HANDLER_MAX; i++) {
3419 bfwd->handler[i] = Qnil;
3420 bfwd->harg[i] = Qnil;
3422 bfwd->shadowed = valcontents;
3423 XSETSYMBOL_VALUE_MAGIC(XSYMBOL(variable)->value, bfwd);
3425 bfwd = XSYMBOL_VALUE_LISP_MAGIC(valcontents);
3426 bfwd->handler[htype] = handler;
3427 bfwd->harg[htype] = harg;
3429 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
3430 if (!NILP(bfwd->handler[i]))
3433 if (i == MAGIC_HANDLER_MAX)
3434 /* there are no remaining handlers, so remove the structure. */
3435 XSYMBOL(variable)->value = bfwd->shadowed;
3440 /* functions for working with variable aliases. */
3442 /* Follow the chain of variable aliases for SYMBOL. Return the
3443 resulting symbol, whose value cell is guaranteed not to be a
3444 symbol-value-varalias.
3446 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
3447 If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
3448 never follow; stop right there. Otherwise FUNSYM should be a
3449 recognized symbol-value function symbol; this means, follow
3450 unless there is a special handler for the named function.
3452 OK, there is at least one reason why it's necessary for
3453 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
3454 can always be sure to catch cyclic variable aliasing. If we never
3455 follow past Lisp magic, then if the following is done:
3458 add some magic behavior to a, but not a "get-value" handler
3461 then an attempt to retrieve a's or b's value would cause infinite
3462 looping in `symbol-value'.
3464 We (of course) can't always follow past Lisp magic, because then
3465 we make any variable that is lisp-magic -> varalias behave as if
3466 the lisp-magic is not present at all.
3470 follow_varalias_pointers(Lisp_Object symbol, Lisp_Object follow_past_lisp_magic)
3472 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
3473 Lisp_Object tortoise, hare, val;
3476 /* quick out just in case */
3477 if (!SYMBOL_VALUE_MAGIC_P(XSYMBOL(symbol)->value))
3480 /* Compare implementation of indirect_function(). */
3481 for (hare = tortoise = symbol, count = 0;
3482 val = fetch_value_maybe_past_magic(hare, follow_past_lisp_magic),
3483 SYMBOL_VALUE_VARALIAS_P(val);
3484 hare = symbol_value_varalias_aliasee(XSYMBOL_VALUE_VARALIAS(val)),
3486 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) {
3491 fetch_value_maybe_past_magic(
3492 tortoise, follow_past_lisp_magic);
3493 tortoise = symbol_value_varalias_aliasee(
3494 XSYMBOL_VALUE_VARALIAS(tmp));
3496 if (EQ(hare, tortoise)) {
3497 return Fsignal(Qcyclic_variable_indirection,
3505 DEFUN("defvaralias", Fdefvaralias, 2, 2, 0, /*
3506 Define a variable as an alias for another variable.
3507 Thenceforth, any operations performed on VARIABLE will actually be
3508 performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
3509 If ALIAS is nil, remove any aliases for VARIABLE.
3510 ALIAS can itself be aliased, and the chain of variable aliases
3511 will be followed appropriately.
3512 If VARIABLE already has a value, this value will be shadowed
3513 until the alias is removed, at which point it will be restored.
3514 Currently VARIABLE cannot be a built-in variable, a variable that
3515 has a buffer-local value in any buffer, or the symbols nil or t.
3516 \(ALIAS, however, can be any type of variable.)
3520 struct symbol_value_varalias *bfwd;
3521 Lisp_Object valcontents;
3523 CHECK_SYMBOL(variable);
3524 reject_constant_symbols(variable, Qunbound, 0, Qt);
3526 valcontents = XSYMBOL(variable)->value;
3529 if (SYMBOL_VALUE_VARALIAS_P(valcontents)) {
3530 XSYMBOL(variable)->value =
3531 symbol_value_varalias_shadowed
3532 (XSYMBOL_VALUE_VARALIAS(valcontents));
3537 CHECK_SYMBOL(alias);
3538 if (SYMBOL_VALUE_VARALIAS_P(valcontents)) {
3540 XSYMBOL_VALUE_VARALIAS(valcontents)->aliasee = alias;
3544 if (SYMBOL_VALUE_MAGIC_P(valcontents)
3545 && !UNBOUNDP(valcontents))
3546 signal_simple_error("Variable is magic and cannot be aliased",
3548 reject_constant_symbols(variable, Qunbound, 0, Qt);
3550 bfwd = alloc_lcrecord_type(struct symbol_value_varalias,
3551 &lrecord_symbol_value_varalias);
3552 zero_lcrecord(&bfwd->magic);
3553 bfwd->magic.type = SYMVAL_VARALIAS;
3554 bfwd->aliasee = alias;
3555 bfwd->shadowed = valcontents;
3557 XSETSYMBOL_VALUE_MAGIC(valcontents, bfwd);
3558 XSYMBOL(variable)->value = valcontents;
3562 DEFUN("variable-alias", Fvariable_alias, 1, 2, 0, /*
3563 If VARIABLE is aliased to another variable, return that variable.
3564 VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
3565 Variable aliases are created with `defvaralias'. See also
3566 `indirect-variable'.
3568 (variable, follow_past_lisp_magic))
3570 Lisp_Object valcontents;
3572 CHECK_SYMBOL(variable);
3573 if (!NILP(follow_past_lisp_magic) && !EQ(follow_past_lisp_magic, Qt)) {
3574 CHECK_SYMBOL(follow_past_lisp_magic);
3575 handler_type_from_function_symbol(follow_past_lisp_magic, 0);
3578 valcontents = fetch_value_maybe_past_magic(variable,
3579 follow_past_lisp_magic);
3581 if (SYMBOL_VALUE_VARALIAS_P(valcontents))
3582 return symbol_value_varalias_aliasee
3583 (XSYMBOL_VALUE_VARALIAS(valcontents));
3588 DEFUN("indirect-variable", Findirect_variable, 1, 2, 0, /*
3589 Return the variable at the end of OBJECT's variable-alias chain.
3590 If OBJECT is a symbol, follow all variable aliases and return
3591 the final (non-aliased) symbol. Variable aliases are created with
3592 the function `defvaralias'.
3593 If OBJECT is not a symbol, just return it.
3594 Signal a cyclic-variable-indirection error if there is a loop in the
3595 variable chain of symbols.
3597 (object, follow_past_lisp_magic))
3599 if (!SYMBOLP(object))
3601 if (!NILP(follow_past_lisp_magic) && !EQ(follow_past_lisp_magic, Qt)) {
3602 CHECK_SYMBOL(follow_past_lisp_magic);
3603 handler_type_from_function_symbol(follow_past_lisp_magic, 0);
3605 return follow_varalias_pointers(object, follow_past_lisp_magic);
3608 DEFUN("variable-binding-locus", Fvariable_binding_locus, 1, 1, 0, /*
3609 Return a value indicating where VARIABLE's current binding comes from.
3610 If the current binding is buffer-local, the value is the current buffer.
3611 If the current binding is global (the default), the value is nil.
3615 Lisp_Object valcontents;
3617 CHECK_SYMBOL(variable);
3618 variable = Findirect_variable(variable, Qnil);
3620 /* Make sure the current binding is actually swapped in. */
3621 find_symbol_value(variable);
3623 valcontents = XSYMBOL(variable)->value;
3625 if (SYMBOL_VALUE_MAGIC_P(valcontents)
3626 && ((XSYMBOL_VALUE_MAGIC_TYPE(valcontents) == SYMVAL_BUFFER_LOCAL)
3627 || (XSYMBOL_VALUE_MAGIC_TYPE(valcontents) ==
3628 SYMVAL_SOME_BUFFER_LOCAL))
3629 && (!NILP(Flocal_variable_p(variable, Fcurrent_buffer(), Qnil))))
3630 return Fcurrent_buffer();
3635 /************************************************************************/
3636 /* initialization */
3637 /************************************************************************/
3639 /* A dumped SXEmacs image has a lot more than 1511 symbols. Last
3640 estimate was that there were actually around 6300. So let's try
3641 making this bigger and see if we get better hashing behavior. */
3642 #define OBARRAY_SIZE 16411
3647 #ifndef Qnull_pointer
3648 Lisp_Object Qnull_pointer;
3651 /* some losing systems can't have static vars at function scope... */
3652 static struct symbol_value_magic guts_of_unbound_marker = {
3653 /* struct symbol_value_magic */
3654 { /* struct lcrecord_header */
3655 { /* struct lrecord_header */
3656 lrecord_type_symbol_value_forward, /* lrecord_type_index */
3658 1, /* c_readonly bit */
3659 1, /* lisp_readonly bit */
3661 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
3668 SYMVAL_UNBOUND_MARKER
3674 hcode_t hash = hash_string(string_data(XSYMBOL(Qnil)->name), 3);
3675 XVECTOR_DATA(Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3679 void init_symbols_once_early(void)
3681 INIT_LRECORD_IMPLEMENTATION(symbol);
3682 INIT_LRECORD_IMPLEMENTATION(symbol_value_forward);
3683 INIT_LRECORD_IMPLEMENTATION(symbol_value_buffer_local);
3684 INIT_LRECORD_IMPLEMENTATION(symbol_value_lisp_magic);
3685 INIT_LRECORD_IMPLEMENTATION(symbol_value_varalias);
3687 reinit_symbols_once_early();
3689 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3690 called the first time. */
3691 Qnil = Fmake_symbol(make_string_nocopy((Bufbyte *)"nil", 3));
3692 XSYMBOL(Qnil)->name->plist = Qnil;
3693 XSYMBOL(Qnil)->value = Qnil; /* Nihil ex nihil */
3694 XSYMBOL(Qnil)->plist = Qnil;
3696 Vobarray = make_vector(OBARRAY_SIZE, Qzero);
3697 initial_obarray = Vobarray;
3698 staticpro(&initial_obarray);
3699 /* Intern nil in the obarray */
3703 /* Required to get around a GCC syntax error on certain
3705 struct symbol_value_magic *tem = &guts_of_unbound_marker;
3707 XSETSYMBOL_VALUE_MAGIC(Qunbound, tem);
3710 XSYMBOL(Qnil)->function = Qunbound;
3712 defsymbol(&Qt, "t");
3713 XSYMBOL(Qt)->value = Qt; /* Veritas aeterna */
3716 dump_add_root_object(&Qnil);
3717 dump_add_root_object(&Qunbound);
3718 dump_add_root_object(&Vquit_flag);
3721 void reinit_symbols_once_early(void)
3724 Qzero = make_int(0); /* Only used if Lisp_Object is a union type */
3727 #ifndef Qnull_pointer
3728 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3729 so the following is actually a no-op. */
3730 XSETOBJ(Qnull_pointer, 0);
3735 defsymbol_massage_name_1(Lisp_Object * location, const char *name, int dump_p,
3736 int multiword_predicate_p)
3739 size_t len = strlen(name) - 1;
3742 if (multiword_predicate_p)
3743 /* If it is a multiword_predicate_p it is expected
3744 the last char of name is a p, which should be
3745 removed and replaced with "_p", so the net length
3746 difference is 1 char, the '_' */
3747 assert(len + 1 < sizeof(temp));
3749 assert(len < sizeof(temp));
3751 strncat(temp, name + 1, sizeof(temp)-1); /* Remove initial Q */
3752 if (multiword_predicate_p) {
3753 /* Overwrite the 'p' which is the last char of name
3754 and put "_p" instead. */
3755 strcpy(temp + len - 1, "_p");
3758 for (i = 0; i < len; i++)
3761 *location = Fintern(make_string((const Bufbyte *)temp, len), Qnil);
3763 staticpro(location);
3765 staticpro_nodump(location);
3768 void defsymbol_massage_name_nodump(Lisp_Object * location, const char *name)
3770 defsymbol_massage_name_1(location, name, 0, 0);
3773 void defsymbol_massage_name(Lisp_Object * location, const char *name)
3775 defsymbol_massage_name_1(location, name, 1, 0);
3779 defsymbol_massage_multiword_predicate_nodump(Lisp_Object * location,
3782 defsymbol_massage_name_1(location, name, 0, 1);
3786 defsymbol_massage_multiword_predicate(Lisp_Object * location, const char *name)
3788 defsymbol_massage_name_1(location, name, 1, 1);
3791 void defsymbol_nodump(Lisp_Object * location, char *name)
3793 *location = Fintern(make_string_nocopy(
3794 (Bufbyte *)name, strlen(name)), Qnil);
3795 staticpro_nodump(location);
3798 void defsymbol(Lisp_Object * location, char *name)
3800 *location = Fintern(make_string_nocopy(
3801 (Bufbyte*)name, strlen(name)), Qnil);
3802 staticpro(location);
3805 void defkeyword(Lisp_Object * location, char *name)
3807 defsymbol(location, name);
3808 Fset(*location, *location);
3811 void defkeyword_massage_name(Lisp_Object * location, const char *name)
3814 size_t len = strlen(name);
3816 assert(len < sizeof(temp));
3818 temp[1] = ':'; /* it's an underscore in the C variable */
3820 defsymbol_massage_name(location, temp);
3821 Fset(*location, *location);
3824 #ifdef DEBUG_SXEMACS
3825 /* Check that nobody spazzed writing a DEFUN. */
3826 static void check_sane_subr(Lisp_Subr * subr, Lisp_Object sym)
3828 assert(subr->min_args >= 0);
3829 assert(subr->min_args <= SUBR_MAX_ARGS);
3831 if (subr->max_args != MANY && subr->max_args != UNEVALLED) {
3832 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3833 assert(subr->max_args <= SUBR_MAX_ARGS);
3834 assert(subr->min_args <= subr->max_args);
3837 #if defined somebody_can_explain_why_a_symbol_must_not_be_bound && \
3838 somebody_can_explain_why_a_symbol_must_not_be_bound
3839 assert(UNBOUNDP(XSYMBOL(sym)->function));
3840 #endif /* somebody_can_explain_why_a_symbol_must_not_be_bound */
3843 #define check_sane_subr(subr, sym) /* nothing */
3847 void defsubr(Lisp_Subr * subr)
3849 Lisp_Object sym = intern(subr_name(subr));
3852 check_sane_subr(subr, sym);
3854 XSETSUBR(fun, subr);
3855 XSYMBOL(sym)->function = fun;
3859 /* If it is declared in a module, update the load history */
3861 LOADHIST_ATTACH(sym);
3867 undefsubr(Lisp_Subr *subr)
3869 Lisp_Object sym = intern(subr_name(subr));
3871 check_sane_subr(subr, sym);
3872 XSYMBOL(sym)->function = Qunbound;
3876 /* Define a lisp macro using a Lisp_Subr. */
3877 void defsubr_macro(Lisp_Subr * subr)
3879 Lisp_Object sym = intern(subr_name(subr));
3882 check_sane_subr(subr, sym);
3884 XSETSUBR(fun, subr);
3885 XSYMBOL(sym)->function = Fcons(Qmacro, fun);
3889 deferror_1(Lisp_Object * symbol, char *name, const char *messuhhj,
3890 Lisp_Object inherits_from, int massage_p)
3894 defsymbol_massage_name(symbol, name);
3896 defsymbol(symbol, name);
3898 assert(SYMBOLP(inherits_from));
3899 conds = Fget(inherits_from, Qerror_conditions, Qnil);
3900 Fput(*symbol, Qerror_conditions, Fcons(*symbol, conds));
3901 /* NOT build_translated_string (). This function is called at load time
3902 and the string needs to get translated at run time. (This happens
3903 in the function (display-error) in cmdloop.el.) */
3904 Fput(*symbol, Qerror_message, build_string(messuhhj));
3908 deferror(Lisp_Object *symbol, char *name, const char *messuhhj,
3909 Lisp_Object inherits_from)
3911 deferror_1(symbol, name, messuhhj, inherits_from, 0);
3915 deferror_massage_name(Lisp_Object * symbol, char *name,
3916 const char *messuhhj, Lisp_Object inherits_from)
3918 deferror_1(symbol, name, messuhhj, inherits_from, 1);
3922 deferror_massage_name_and_message(Lisp_Object * symbol, char *name,
3923 Lisp_Object inherits_from)
3927 size_t len = strlen(name) - 1;
3929 assert(len < sizeof(temp));
3931 strncat(temp, name + 1, sizeof(temp)-1); /* Remove initial Q */
3932 temp[0] = toupper(temp[0]);
3933 for (i = 0; i < len; i++)
3937 deferror_1(symbol, name, temp, inherits_from, 1);
3940 void syms_of_symbols(void)
3942 DEFSYMBOL(Qvariable_documentation);
3943 DEFSYMBOL(Qvariable_domain); /* I18N3 */
3944 DEFSYMBOL(Qad_advice_info);
3945 DEFSYMBOL(Qad_activate);
3947 DEFSYMBOL(Qget_value);
3948 DEFSYMBOL(Qset_value);
3949 DEFSYMBOL(Qbound_predicate);
3950 DEFSYMBOL(Qmake_unbound);
3951 DEFSYMBOL(Qlocal_predicate);
3952 DEFSYMBOL(Qmake_local);
3955 DEFSYMBOL(Qglobally_boundp);
3956 DEFSYMBOL(Qmakunbound);
3957 DEFSYMBOL(Qsymbol_value);
3959 DEFSYMBOL(Qsetq_default);
3960 DEFSYMBOL(Qdefault_boundp);
3961 DEFSYMBOL(Qdefault_value);
3962 DEFSYMBOL(Qset_default);
3963 DEFSYMBOL(Qmake_variable_buffer_local);
3964 DEFSYMBOL(Qmake_local_variable);
3965 DEFSYMBOL(Qkill_local_variable);
3966 DEFSYMBOL(Qkill_console_local_variable);
3967 DEFSYMBOL(Qsymbol_value_in_buffer);
3968 DEFSYMBOL(Qsymbol_value_in_console);
3969 DEFSYMBOL(Qlocal_variable_p);
3970 DEFSYMBOL(Qconst_integer);
3971 DEFSYMBOL(Qconst_boolean);
3972 DEFSYMBOL(Qconst_object);
3973 DEFSYMBOL(Qconst_specifier);
3974 DEFSYMBOL(Qdefault_buffer);
3975 DEFSYMBOL(Qcurrent_buffer);
3976 DEFSYMBOL(Qconst_current_buffer);
3977 DEFSYMBOL(Qdefault_console);
3978 DEFSYMBOL(Qselected_console);
3979 DEFSYMBOL(Qconst_selected_console);
3981 DEFSYMBOL(Qsymbol_macro);
3984 DEFSUBR(Fintern_soft);
3987 DEFSUBR(Fapropos_internal);
3989 DEFSUBR(Fsymbol_function);
3990 DEFSUBR(Fsymbol_plist);
3991 DEFSUBR(Fsymbol_name);
3992 DEFSUBR(Fmakunbound);
3993 DEFSUBR(Ffmakunbound);
3995 DEFSUBR(Fglobally_boundp);
3998 DEFSUBR(Fdefine_function);
3999 Ffset(intern("defalias"), intern("define-function"));
4000 DEFSUBR (Fspecial_form_p);
4001 DEFSUBR (Fsubr_name);
4003 DEFSUBR(Fsymbol_value_in_buffer);
4004 DEFSUBR(Fsymbol_value_in_console);
4005 DEFSUBR(Fbuilt_in_variable_type);
4006 DEFSUBR(Fsymbol_value);
4008 DEFSUBR(Fdefault_boundp);
4009 DEFSUBR(Fdefault_value);
4010 DEFSUBR(Fset_default);
4011 DEFSUBR(Fsetq_default);
4012 DEFSUBR(Fmake_variable_buffer_local);
4013 DEFSUBR(Fmake_local_variable);
4014 DEFSUBR(Fkill_local_variable);
4015 DEFSUBR(Fkill_console_local_variable);
4016 DEFSUBR(Flocal_variable_p);
4017 DEFSUBR(Fdefvaralias);
4018 DEFSUBR(Fvariable_alias);
4019 DEFSUBR(Findirect_variable);
4020 DEFSUBR(Fvariable_binding_locus);
4021 DEFSUBR(Fdontusethis_set_symbol_value_handler);
4024 /* Create and initialize a Lisp variable whose value is forwarded to C data */
4026 defvar_magic(char *symbol_name, const struct symbol_value_forward *magic)
4030 #if defined WITH_EMODULES && defined HAVE_EMODULES
4032 * As with defsubr(), this will only be called in a dumped Emacs when
4033 * we are adding variables from a dynamically loaded module. That means
4034 * we can't use purespace. Take that into account.
4037 sym = Fintern(build_string(symbol_name), Qnil);
4040 sym = Fintern(make_string_nocopy((Bufbyte *)symbol_name,
4041 strlen(symbol_name)), Qnil);
4042 XSYMBOL(sym)->value = (Lisp_Object)(const void*)magic;
4046 void vars_of_symbols(void)
4048 DEFVAR_LISP("obarray", &Vobarray /*
4049 Symbol table for use by `intern' and `read'.
4050 It is a vector whose length ought to be prime for best results.
4051 The vector's contents don't make sense if examined from Lisp programs;
4052 to find all the symbols in an obarray, use `mapatoms'.
4054 /* obarray has been initialized long before */