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 ((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)
1242 sprintf(buf, "#<INTERNAL OBJECT (SXEmacs bug?) (%s type %d) 0x%lx>",
1243 XRECORD_LHEADER_IMPLEMENTATION(obj)->name,
1244 XSYMBOL_VALUE_MAGIC_TYPE(obj), (long)XPNTR(obj));
1245 write_c_string(buf, printcharfun);
1248 static const struct lrecord_description symbol_value_forward_description[] = {
1252 static const struct lrecord_description symbol_value_buffer_local_description[]
1255 offsetof(struct symbol_value_buffer_local, default_value)},
1257 offsetof(struct symbol_value_buffer_local, current_value)},
1259 offsetof(struct symbol_value_buffer_local, current_buffer)},
1261 offsetof(struct symbol_value_buffer_local, current_alist_element)},
1265 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
1266 {XD_LISP_OBJECT_ARRAY,
1267 offsetof(struct symbol_value_lisp_magic, handler),
1268 2 * MAGIC_HANDLER_MAX + 1},
1272 static const struct lrecord_description symbol_value_varalias_description[] = {
1273 {XD_LISP_OBJECT, offsetof(struct symbol_value_varalias, aliasee)},
1274 {XD_LISP_OBJECT, offsetof(struct symbol_value_varalias, shadowed)},
1278 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-forward",
1279 symbol_value_forward,
1281 print_symbol_value_magic, 0, 0, 0,
1282 symbol_value_forward_description,
1283 struct symbol_value_forward);
1285 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-buffer-local",
1286 symbol_value_buffer_local,
1287 mark_symbol_value_buffer_local,
1288 print_symbol_value_magic, 0, 0, 0,
1289 symbol_value_buffer_local_description,
1290 struct symbol_value_buffer_local);
1292 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-lisp-magic",
1293 symbol_value_lisp_magic,
1294 mark_symbol_value_lisp_magic,
1295 print_symbol_value_magic, 0, 0, 0,
1296 symbol_value_lisp_magic_description,
1297 struct symbol_value_lisp_magic);
1299 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-varalias",
1300 symbol_value_varalias,
1301 mark_symbol_value_varalias,
1302 print_symbol_value_magic, 0, 0, 0,
1303 symbol_value_varalias_description,
1304 struct symbol_value_varalias);
1306 /* Getting and setting values of symbols */
1308 /* Given the raw contents of a symbol value cell, return the Lisp value of
1309 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
1310 symbol-value-lisp-magic, or symbol-value-varalias.
1312 BUFFER specifies a buffer, and is used for built-in buffer-local
1313 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
1314 Note that such variables are never encapsulated in a
1315 symbol-value-buffer-local structure.
1317 CONSOLE specifies a console, and is used for built-in console-local
1318 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
1319 Note that such variables are (currently) never encapsulated in a
1320 symbol-value-buffer-local structure.
1324 do_symval_forwarding(Lisp_Object valcontents, struct buffer *buffer,
1325 struct console *console)
1327 const struct symbol_value_forward *fwd;
1329 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
1332 fwd = XSYMBOL_VALUE_FORWARD(valcontents);
1333 switch (fwd->magic.type) {
1334 case SYMVAL_FIXNUM_FORWARD:
1335 case SYMVAL_CONST_FIXNUM_FORWARD:
1337 make_int(*((Fixnum *) symbol_value_forward_forward(fwd)));
1339 case SYMVAL_BOOLEAN_FORWARD:
1340 case SYMVAL_CONST_BOOLEAN_FORWARD:
1341 return *((int *)symbol_value_forward_forward(fwd)) ? Qt : Qnil;
1343 case SYMVAL_OBJECT_FORWARD:
1344 case SYMVAL_CONST_OBJECT_FORWARD:
1345 case SYMVAL_CONST_SPECIFIER_FORWARD:
1346 return *((Lisp_Object *) symbol_value_forward_forward(fwd));
1348 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1349 return (*((Lisp_Object *) ((char *)XBUFFER(Vbuffer_defaults)
1352 symbol_value_forward_forward(fwd)
1353 - (char *)&buffer_local_flags))));
1355 case SYMVAL_CURRENT_BUFFER_FORWARD:
1356 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1358 return (*((Lisp_Object *) ((char *)buffer
1361 symbol_value_forward_forward(fwd)
1362 - (char *)&buffer_local_flags))));
1364 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1365 return (*((Lisp_Object *) ((char *)XCONSOLE(Vconsole_defaults)
1368 symbol_value_forward_forward(fwd)
1369 - (char *)&console_local_flags))));
1371 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1372 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1374 return (*((Lisp_Object *) ((char *)console
1377 symbol_value_forward_forward(fwd)
1378 - (char *)&console_local_flags))));
1380 case SYMVAL_UNBOUND_MARKER:
1383 case SYMVAL_BUFFER_LOCAL:
1384 case SYMVAL_SOME_BUFFER_LOCAL:
1385 case SYMVAL_LISP_MAGIC:
1386 case SYMVAL_VARALIAS:
1390 return Qnil; /* suppress compiler warning */
1393 /* Set the value of default-buffer-local variable SYM to VALUE. */
1395 static void set_default_buffer_slot_variable(Lisp_Object sym, Lisp_Object value)
1397 /* Handle variables like case-fold-search that have special slots in
1398 the buffer. Make them work apparently like buffer_local variables.
1400 /* At this point, the value cell may not contain a symbol-value-varalias
1401 or symbol-value-buffer-local, and if there's a handler, we should
1402 have already called it. */
1403 Lisp_Object valcontents = fetch_value_maybe_past_magic(sym, Qt);
1404 const struct symbol_value_forward *fwd
1405 = XSYMBOL_VALUE_FORWARD(valcontents);
1406 int offset = ((char *)symbol_value_forward_forward(fwd)
1407 - (char *)&buffer_local_flags);
1408 int mask = XINT(*((Lisp_Object *) symbol_value_forward_forward(fwd)));
1409 int (*magicfun) (Lisp_Object simm, Lisp_Object * val,
1410 Lisp_Object in_object, int flags) =
1411 symbol_value_forward_magicfun(fwd);
1413 *((Lisp_Object *) (offset + (char *)XBUFFER(Vbuffer_defaults)))
1416 if (mask > 0) { /* Not always per-buffer */
1417 /* Set value in each buffer which hasn't shadowed the default */
1418 LIST_LOOP_2(elt, Vbuffer_alist) {
1419 struct buffer *b = XBUFFER(XCDR(elt));
1420 if (!(b->local_var_flags & mask)) {
1422 magicfun(sym, &value, make_buffer(b),
1424 *((Lisp_Object *) (offset + (char *)b)) = value;
1430 /* Set the value of default-console-local variable SYM to VALUE. */
1433 set_default_console_slot_variable(Lisp_Object sym, Lisp_Object value)
1435 /* Handle variables like case-fold-search that have special slots in
1436 the console. Make them work apparently like console_local variables.
1438 /* At this point, the value cell may not contain a symbol-value-varalias
1439 or symbol-value-buffer-local, and if there's a handler, we should
1440 have already called it. */
1441 Lisp_Object valcontents = fetch_value_maybe_past_magic(sym, Qt);
1442 const struct symbol_value_forward *fwd
1443 = XSYMBOL_VALUE_FORWARD(valcontents);
1444 int offset = ((char *)symbol_value_forward_forward(fwd)
1445 - (char *)&console_local_flags);
1446 int mask = XINT(*((Lisp_Object *) symbol_value_forward_forward(fwd)));
1447 int (*magicfun) (Lisp_Object simm, Lisp_Object * val,
1448 Lisp_Object in_object, int flags) =
1449 symbol_value_forward_magicfun(fwd);
1451 *((Lisp_Object *) (offset + (char *)XCONSOLE(Vconsole_defaults)))
1454 if (mask > 0) { /* Not always per-console */
1455 /* Set value in each console which hasn't shadowed the default */
1456 LIST_LOOP_2(console, Vconsole_list) {
1457 struct console *d = XCONSOLE(console);
1458 if (!(d->local_var_flags & mask)) {
1460 magicfun(sym, &value, console, 0);
1461 *((Lisp_Object *) (offset + (char *)d)) = value;
1467 /* Store NEWVAL into SYM.
1469 SYM's value slot may *not* be types (5) or (6) above,
1470 i.e. no symbol-value-varalias objects. (You should have
1471 forwarded past all of these.)
1473 SYM should not be an unsettable symbol or a symbol with
1474 a magic `set-value' handler (unless you want to explicitly
1475 ignore this handler).
1477 OVALUE is the current value of SYM, but forwarded past any
1478 symbol-value-buffer-local and symbol-value-lisp-magic objects.
1479 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1480 the contents of its current-value cell.) NEWVAL may only be
1481 a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
1482 this function will only modify its current-value cell, which should
1483 already be set up to point to the current buffer.
1487 store_symval_forwarding(Lisp_Object sym, Lisp_Object ovalue, Lisp_Object newval)
1489 if (!SYMBOL_VALUE_MAGIC_P(ovalue) || UNBOUNDP(ovalue)) {
1490 Lisp_Object *store_pointer = value_slot_past_magic(sym);
1492 if (SYMBOL_VALUE_BUFFER_LOCAL_P(*store_pointer))
1494 &XSYMBOL_VALUE_BUFFER_LOCAL(*store_pointer)->
1497 assert(UNBOUNDP(*store_pointer)
1498 || !SYMBOL_VALUE_MAGIC_P(*store_pointer));
1499 *store_pointer = newval;
1501 const struct symbol_value_forward *fwd =
1502 XSYMBOL_VALUE_FORWARD(ovalue);
1503 int (*magicfun) (Lisp_Object simm, Lisp_Object * val,
1504 Lisp_Object in_object, int flags)
1505 = symbol_value_forward_magicfun(fwd);
1507 switch (XSYMBOL_VALUE_MAGIC_TYPE(ovalue)) {
1508 case SYMVAL_FIXNUM_FORWARD:
1511 magicfun(sym, &newval, Qnil, 0);
1512 *((Fixnum *) symbol_value_forward_forward(fwd)) =
1516 case SYMVAL_BOOLEAN_FORWARD:
1518 magicfun(sym, &newval, Qnil, 0);
1519 *((int *)symbol_value_forward_forward(fwd))
1523 case SYMVAL_OBJECT_FORWARD:
1525 magicfun(sym, &newval, Qnil, 0);
1526 *((Lisp_Object *) symbol_value_forward_forward(fwd)) =
1530 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1531 set_default_buffer_slot_variable(sym, newval);
1534 case SYMVAL_CURRENT_BUFFER_FORWARD:
1536 magicfun(sym, &newval,
1537 make_buffer(current_buffer), 0);
1538 *((Lisp_Object *) ((char *)current_buffer +
1540 symbol_value_forward_forward(fwd)
1541 - (char *)&buffer_local_flags)))
1545 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1546 set_default_console_slot_variable(sym, newval);
1549 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1551 magicfun(sym, &newval, Vselected_console, 0);
1552 *((Lisp_Object *) ((char *)XCONSOLE(Vselected_console)
1555 symbol_value_forward_forward(fwd)
1556 - (char *)&console_local_flags)))
1560 /* list all cases */
1561 case SYMVAL_CONST_FIXNUM_FORWARD:
1562 case SYMVAL_CONST_BOOLEAN_FORWARD:
1563 case SYMVAL_CONST_OBJECT_FORWARD:
1564 case SYMVAL_CONST_SPECIFIER_FORWARD:
1565 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1566 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1567 case SYMVAL_UNBOUND_MARKER:
1568 case SYMVAL_BUFFER_LOCAL:
1569 case SYMVAL_SOME_BUFFER_LOCAL:
1570 case SYMVAL_LISP_MAGIC:
1571 case SYMVAL_VARALIAS:
1579 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1580 BFWD, locate and return a pointer to the element in BUFFER's
1581 local_var_alist for SYMBOL. The return value will be Qnil if
1582 BUFFER does not have its own value for SYMBOL (i.e. the default
1583 value is seen in that buffer).
1587 buffer_local_alist_element(struct buffer *buffer, Lisp_Object symbol,
1588 struct symbol_value_buffer_local *bfwd)
1590 if (!NILP(bfwd->current_buffer) &&
1591 XBUFFER(bfwd->current_buffer) == buffer)
1592 /* This is just an optimization of the below. */
1593 return bfwd->current_alist_element;
1595 return assq_no_quit(symbol, buffer->local_var_alist);
1598 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1599 symbol-value-buffer-local of a per-buffer variable -- i.e. the
1600 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1601 slot -- may be out of date.]
1603 Write out any cached value in buffer-local variable SYMBOL's
1604 buffer-local structure, which is passed in as BFWD.
1608 write_out_buffer_local_cache(Lisp_Object symbol,
1609 struct symbol_value_buffer_local *bfwd)
1611 if (!NILP(bfwd->current_buffer)) {
1612 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1613 uses it, and that type cannot be inside a symbol-value-buffer-local */
1615 do_symval_forwarding(bfwd->current_value, 0, 0);
1616 if (NILP(bfwd->current_alist_element))
1617 /* current_value may be updated more recently than default_value */
1618 bfwd->default_value = cval;
1620 Fsetcdr(bfwd->current_alist_element, cval);
1624 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1625 Set up BFWD's cache for validity in buffer BUF. This assumes that
1626 the cache is currently in a consistent state (this can include
1627 not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1629 If the cache is already set up for BUF, this function does nothing
1632 Otherwise, if SYM forwards out to a C variable, this also forwards
1633 SYM's value in BUF out to the variable. Therefore, you generally
1634 only want to call this when BUF is, or is about to become, the
1637 (Otherwise, you can just retrieve the value without changing the
1638 cache, at the expense of slower retrieval.)
1642 set_up_buffer_local_cache(Lisp_Object sym,
1643 struct symbol_value_buffer_local *bfwd,
1645 Lisp_Object new_alist_el, int set_it_p)
1647 Lisp_Object new_val;
1649 if (!NILP(bfwd->current_buffer)
1650 && buf == XBUFFER(bfwd->current_buffer))
1651 /* Cache is already set up. */
1654 /* Flush out the old cache. */
1655 write_out_buffer_local_cache(sym, bfwd);
1657 /* Retrieve the new alist element and new value. */
1658 if (NILP(new_alist_el)
1660 new_alist_el = buffer_local_alist_element(buf, sym, bfwd);
1662 if (NILP(new_alist_el))
1663 new_val = bfwd->default_value;
1665 new_val = Fcdr(new_alist_el);
1667 bfwd->current_alist_element = new_alist_el;
1668 XSETBUFFER(bfwd->current_buffer, buf);
1670 /* Now store the value into the current-value slot.
1671 We don't simply write it there, because the current-value
1672 slot might be a forwarding pointer, in which case we need
1673 to instead write the value into the C variable.
1675 We might also want to call a magic function.
1677 So instead, we call this function. */
1678 store_symval_forwarding(sym, bfwd->current_value, new_val);
1681 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1682 Flush the cache. BFWD->CURRENT_BUFFER will be nil after this operation.
1686 flush_buffer_local_cache(Lisp_Object sym,
1687 struct symbol_value_buffer_local *bfwd)
1689 if (NILP(bfwd->current_buffer))
1690 /* Cache is already flushed. */
1693 /* Flush out the old cache. */
1694 write_out_buffer_local_cache(sym, bfwd);
1696 bfwd->current_alist_element = Qnil;
1697 bfwd->current_buffer = Qnil;
1699 /* Now store default the value into the current-value slot.
1700 We don't simply write it there, because the current-value
1701 slot might be a forwarding pointer, in which case we need
1702 to instead write the value into the C variable.
1704 We might also want to call a magic function.
1706 So instead, we call this function. */
1707 store_symval_forwarding(sym, bfwd->current_value, bfwd->default_value);
1710 /* Flush all the buffer-local variable caches. Whoever has a
1711 non-interned buffer-local variable will be spanked. Whoever has a
1712 magic variable that interns or uninterns symbols... I don't even
1713 want to think about it.
1716 void flush_all_buffer_local_cache(void)
1718 Lisp_Object *syms = XVECTOR_DATA(Vobarray);
1719 long count = XVECTOR_LENGTH(Vobarray);
1722 for (i = 0; i < count; i++) {
1723 Lisp_Object sym = syms[i];
1729 assert(SYMBOLP(sym));
1730 value = fetch_value_maybe_past_magic(sym, Qt);
1731 if (SYMBOL_VALUE_BUFFER_LOCAL_P(value))
1732 flush_buffer_local_cache(sym,
1733 XSYMBOL_VALUE_BUFFER_LOCAL
1736 next = symbol_next(XSYMBOL(sym));
1739 XSETSYMBOL(sym, next);
1744 void kill_buffer_local_variables(struct buffer *buf)
1746 Lisp_Object prev = Qnil;
1749 /* Any which are supposed to be permanent,
1750 make local again, with the same values they had. */
1752 for (alist = buf->local_var_alist; !NILP(alist); alist = XCDR(alist)) {
1753 Lisp_Object sym = XCAR(XCAR(alist));
1754 struct symbol_value_buffer_local *bfwd;
1755 /* Variables with a symbol-value-varalias should not be here
1756 (we should have forwarded past them) and there must be a
1757 symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
1758 just forward past it; if the variable has a handler, it was
1760 Lisp_Object value = fetch_value_maybe_past_magic(sym, Qt);
1762 assert(SYMBOL_VALUE_BUFFER_LOCAL_P(value));
1763 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL(value);
1765 if (!NILP(Fget(sym, Qpermanent_local, Qnil)))
1766 /* prev points to the last alist element that is still
1767 staying around, so *only* update it now. This didn't
1768 used to be the case; this bug has been around since
1769 mly's rewrite two years ago! */
1772 /* Really truly kill it. */
1774 XCDR(prev) = XCDR(alist);
1776 buf->local_var_alist = XCDR(alist);
1778 /* We just effectively changed the value for this variable
1781 /* (1) If the cache is caching BUF, invalidate the cache. */
1782 if (!NILP(bfwd->current_buffer) &&
1783 buf == XBUFFER(bfwd->current_buffer))
1784 bfwd->current_buffer = Qnil;
1786 /* (2) If we changed the value in current_buffer and this
1787 variable forwards to a C variable, we need to change the
1788 value of the C variable. set_up_buffer_local_cache()
1789 will do this. It doesn't hurt to do it whenever
1790 BUF == current_buffer, so just go ahead and do that. */
1791 if (buf == current_buffer)
1792 set_up_buffer_local_cache(sym, bfwd, buf, Qnil,
1799 find_symbol_value_1(Lisp_Object sym, struct buffer *buf,
1800 struct console *con, int swap_it_in,
1801 Lisp_Object symcons, int set_it_p)
1803 Lisp_Object valcontents;
1806 valcontents = XSYMBOL(sym)->value;
1809 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
1812 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
1813 case SYMVAL_LISP_MAGIC:
1815 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
1819 case SYMVAL_VARALIAS:
1820 sym = follow_varalias_pointers(sym, Qt /* #### kludge */ );
1822 /* presto change-o! */
1825 case SYMVAL_BUFFER_LOCAL:
1826 case SYMVAL_SOME_BUFFER_LOCAL:
1828 struct symbol_value_buffer_local *bfwd
1829 = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
1832 set_up_buffer_local_cache(sym, bfwd, buf,
1834 valcontents = bfwd->current_value;
1836 if (!NILP(bfwd->current_buffer) &&
1837 buf == XBUFFER(bfwd->current_buffer))
1838 valcontents = bfwd->current_value;
1839 else if (NILP(symcons)) {
1845 if (NILP(valcontents))
1847 bfwd->default_value;
1849 valcontents = XCDR(valcontents);
1851 valcontents = XCDR(symcons);
1856 case SYMVAL_FIXNUM_FORWARD:
1857 case SYMVAL_CONST_FIXNUM_FORWARD:
1858 case SYMVAL_BOOLEAN_FORWARD:
1859 case SYMVAL_CONST_BOOLEAN_FORWARD:
1860 case SYMVAL_OBJECT_FORWARD:
1861 case SYMVAL_CONST_OBJECT_FORWARD:
1862 case SYMVAL_CONST_SPECIFIER_FORWARD:
1863 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1864 case SYMVAL_CURRENT_BUFFER_FORWARD:
1865 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1866 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1867 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1868 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1869 case SYMVAL_UNBOUND_MARKER:
1873 return do_symval_forwarding(valcontents, buf, con);
1876 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1877 bound. Note that it must not be possible to QUIT within this
1880 Lisp_Object symbol_value_in_buffer(Lisp_Object sym, Lisp_Object buffer)
1887 buf = current_buffer;
1889 CHECK_BUFFER(buffer);
1890 buf = XBUFFER(buffer);
1893 return find_symbol_value_1(sym, buf,
1894 /* If it bombs out at startup due to a
1895 Lisp error, this may be nil. */
1896 CONSOLEP(Vselected_console)
1897 ? XCONSOLE(Vselected_console) : 0, 0, Qnil,
1901 static Lisp_Object symbol_value_in_console(Lisp_Object sym, Lisp_Object console)
1906 console = Vselected_console;
1908 CHECK_CONSOLE(console);
1910 return find_symbol_value_1(sym, current_buffer, XCONSOLE(console), 0,
1915 search_symbol_macro(Lisp_Object name)
1917 return Fget(name, Qsymbol_macro, Qnil);
1920 /* Return the current value of SYM. The difference between this function
1921 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1922 this updates the CURRENT_VALUE slot of buffer-local variables to
1923 point to the current buffer, while symbol_value_in_buffer doesn't. */
1925 Lisp_Object find_symbol_value(Lisp_Object sym)
1927 /* WARNING: This function can be called when current_buffer is 0
1928 and Vselected_console is Qnil, early in initialization. */
1929 struct console *con;
1930 Lisp_Object valcontents;
1934 valcontents = XSYMBOL(sym)->value;
1935 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
1938 if (CONSOLEP(Vselected_console))
1939 con = XCONSOLE(Vselected_console);
1941 /* This can also get called while we're preparing to shutdown.
1942 #### What should really happen in that case? Should we
1943 actually fix things so we can't get here in that case? */
1945 assert(!initialized || preparing_for_armageddon);
1950 return find_symbol_value_1(sym, current_buffer, con, 1, Qnil, 1);
1953 /* This is an optimized function for quick lookup of buffer local symbols
1954 by avoiding O(n) search. This will work when either:
1955 a) We have already found the symbol e.g. by traversing local_var_alist.
1957 b) We know that the symbol will not be found in the current buffer's
1958 list of local variables.
1959 In the former case, find_it_p is 1 and symbol_cons is the element from
1960 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1963 This function is called from set_buffer_internal which does both of these
1966 Lisp_Object find_symbol_value_quickly(Lisp_Object symbol_cons, int find_it_p)
1968 /* WARNING: This function can be called when current_buffer is 0
1969 and Vselected_console is Qnil, early in initialization. */
1970 struct console *con;
1971 Lisp_Object sym = find_it_p ? XCAR(symbol_cons) : symbol_cons;
1974 if (CONSOLEP(Vselected_console))
1975 con = XCONSOLE(Vselected_console);
1977 /* This can also get called while we're preparing to shutdown.
1978 #### What should really happen in that case? Should we
1979 actually fix things so we can't get here in that case? */
1981 assert(!initialized || preparing_for_armageddon);
1986 return find_symbol_value_1(sym, current_buffer, con, 1,
1987 find_it_p ? symbol_cons : Qnil, find_it_p);
1990 DEFUN("symbol-value", Fsymbol_value, 1, 1, 0, /*
1991 Return SYMBOL's value. Error if that is void.
1995 Lisp_Object val = find_symbol_value(symbol);
1997 if (UNBOUNDP(val)) {
1998 Lisp_Object fd = search_symbol_macro(symbol);
2002 return Fsignal(Qvoid_variable, list1(symbol));
2007 DEFUN("set", Fset, 2, 2, 0, /*
2008 Set SYMBOL's value to NEWVAL, and return NEWVAL.
2012 REGISTER Lisp_Object valcontents;
2015 /* remember, we're called by Fmakunbound() as well */
2017 CHECK_SYMBOL(symbol);
2020 sym = XSYMBOL(symbol);
2021 valcontents = sym->value;
2023 if (EQ(symbol, Qnil) || EQ(symbol, Qt) || SYMBOL_IS_KEYWORD(symbol))
2024 reject_constant_symbols(symbol, newval, 0,
2025 UNBOUNDP(newval) ? Qmakunbound : Qset);
2027 if (UNBOUNDP(valcontents)) {
2028 ssm = search_symbol_macro(symbol);
2030 return Feval(list3(Qsetf, ssm, list2(Qquote, newval)));
2033 if (!SYMBOL_VALUE_MAGIC_P(valcontents) || UNBOUNDP(valcontents)) {
2034 sym->value = newval;
2038 reject_constant_symbols(symbol, newval, 0,
2039 UNBOUNDP(newval) ? Qmakunbound : Qset);
2041 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2042 case SYMVAL_LISP_MAGIC: {
2043 if (UNBOUNDP(newval)) {
2044 maybe_call_magic_handler(symbol, Qmakunbound,
2046 return XSYMBOL_VALUE_LISP_MAGIC(valcontents)->
2047 shadowed = Qunbound;
2049 maybe_call_magic_handler(symbol, Qset, 1,
2051 return XSYMBOL_VALUE_LISP_MAGIC(valcontents)->
2056 case SYMVAL_VARALIAS:
2057 symbol = follow_varalias_pointers(symbol, UNBOUNDP(newval)
2058 ? Qmakunbound : Qset);
2059 /* presto change-o! */
2062 case SYMVAL_FIXNUM_FORWARD:
2063 case SYMVAL_BOOLEAN_FORWARD:
2064 case SYMVAL_OBJECT_FORWARD:
2065 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2066 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2067 if (UNBOUNDP(newval))
2068 signal_error(Qerror,
2069 list2(build_string("Cannot makunbound"),
2073 /* case SYMVAL_UNBOUND_MARKER: break; */
2075 case SYMVAL_CURRENT_BUFFER_FORWARD: {
2076 const struct symbol_value_forward *fwd
2077 = XSYMBOL_VALUE_FORWARD(valcontents);
2078 int mask = XINT(*((Lisp_Object *)
2079 symbol_value_forward_forward(fwd)));
2081 /* Setting this variable makes it buffer-local */
2082 current_buffer->local_var_flags |= mask;
2086 case SYMVAL_SELECTED_CONSOLE_FORWARD: {
2087 const struct symbol_value_forward *fwd
2088 = XSYMBOL_VALUE_FORWARD(valcontents);
2089 int mask = XINT(*((Lisp_Object *)
2090 symbol_value_forward_forward(fwd)));
2092 /* Setting this variable makes it console-local */
2093 XCONSOLE(Vselected_console)->local_var_flags |=
2098 case SYMVAL_BUFFER_LOCAL:
2099 case SYMVAL_SOME_BUFFER_LOCAL: {
2100 /* If we want to examine or set the value and
2101 CURRENT-BUFFER is current, we just examine or set
2102 CURRENT-VALUE. If CURRENT-BUFFER is not current, we
2103 store the current CURRENT-VALUE value into
2104 CURRENT-ALIST- ELEMENT, then find the appropriate alist
2105 element for the buffer now current and set up
2106 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
2107 of that element, and store into CURRENT-BUFFER.
2109 If we are setting the variable and the current buffer does
2110 not have an alist entry for this variable, an alist entry is
2113 Note that CURRENT-VALUE can be a forwarding pointer.
2114 Each time it is examined or set, forwarding must be
2116 struct symbol_value_buffer_local *bfwd
2117 = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2118 int some_buffer_local_p =
2119 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
2120 /* What value are we caching right now? */
2121 Lisp_Object aelt = bfwd->current_alist_element;
2123 if (!NILP(bfwd->current_buffer) &&
2124 current_buffer == XBUFFER(bfwd->current_buffer)
2125 && ((some_buffer_local_p)
2126 ? 1 /* doesn't automatically become local */
2127 : !NILP(aelt) /* already local */
2129 /* Cache is valid */
2130 valcontents = bfwd->current_value;
2132 /* If the current buffer is not the buffer whose binding
2133 is currently cached, or if it's a SYMVAL_BUFFER_LOCAL
2134 and we're looking at the default value, the cache is
2135 invalid; we need to write it out, and find the new
2136 CURRENT-ALIST-ELEMENT
2139 /* Write out the cached value for the old buffer; copy
2140 it back to its alist element. This works if the
2141 current buffer only sees the default value, too. */
2142 write_out_buffer_local_cache(symbol, bfwd);
2144 /* Find the new value for CURRENT-ALIST-ELEMENT. */
2145 aelt = buffer_local_alist_element(current_buffer,
2148 /* This buffer is still seeing the default
2150 if (!some_buffer_local_p) {
2151 /* If it's a SYMVAL_BUFFER_LOCAL, give
2152 this buffer a new assoc for a local
2153 value and set CURRENT-ALIST-ELEMENT
2154 to point to that. */
2155 aelt = do_symval_forwarding(
2156 bfwd->current_value,
2158 XCONSOLE(Vselected_console));
2159 aelt = Fcons(symbol, aelt);
2160 current_buffer->local_var_alist =
2165 /* If the variable is a
2166 SYMVAL_SOME_BUFFER_LOCAL, we're
2167 currently seeing the default
2172 /* Cache the new buffer's assoc in
2173 CURRENT-ALIST-ELEMENT. */
2174 bfwd->current_alist_element = aelt;
2175 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is
2177 XSETBUFFER(bfwd->current_buffer,
2179 valcontents = bfwd->current_value;
2184 case SYMVAL_CONST_FIXNUM_FORWARD:
2185 case SYMVAL_CONST_BOOLEAN_FORWARD:
2186 case SYMVAL_CONST_SPECIFIER_FORWARD:
2187 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2188 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2189 case SYMVAL_CONST_OBJECT_FORWARD:
2190 case SYMVAL_UNBOUND_MARKER:
2194 store_symval_forwarding(symbol, valcontents, newval);
2199 /* Access or set a buffer-local symbol's default value. */
2201 /* Return the default value of SYM, but don't check for voidness.
2202 Return Qunbound if it is void. */
2204 static Lisp_Object default_value(Lisp_Object sym)
2206 Lisp_Object valcontents;
2211 valcontents = XSYMBOL(sym)->value;
2214 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2217 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2218 case SYMVAL_LISP_MAGIC:
2220 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2224 case SYMVAL_VARALIAS:
2225 sym = follow_varalias_pointers(sym, Qt /* #### kludge */ );
2226 /* presto change-o! */
2229 case SYMVAL_UNBOUND_MARKER:
2232 case SYMVAL_CURRENT_BUFFER_FORWARD: {
2233 const struct symbol_value_forward *fwd
2234 = XSYMBOL_VALUE_FORWARD(valcontents);
2235 return (*((Lisp_Object *)
2236 ((char *)XBUFFER(Vbuffer_defaults) +
2237 ((char *)symbol_value_forward_forward(fwd) -
2238 (char *)&buffer_local_flags))));
2241 case SYMVAL_SELECTED_CONSOLE_FORWARD: {
2242 const struct symbol_value_forward *fwd =
2243 XSYMBOL_VALUE_FORWARD(valcontents);
2244 return (*((Lisp_Object *)
2245 ((char *)XCONSOLE(Vconsole_defaults) +
2246 ((char *)symbol_value_forward_forward(fwd) -
2247 (char *)&console_local_flags))));
2250 case SYMVAL_BUFFER_LOCAL:
2251 case SYMVAL_SOME_BUFFER_LOCAL: {
2252 struct symbol_value_buffer_local *bfwd =
2253 XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2255 /* Handle user-created local variables. */
2256 /* If var is set up for a buffer that lacks a local value for
2257 it, the current value is nominally the default value. But
2258 the current value slot may be more up to date, since ordinary
2259 setq stores just that slot. So use that. */
2260 if (NILP(bfwd->current_alist_element))
2261 return do_symval_forwarding(
2262 bfwd->current_value,
2264 XCONSOLE(Vselected_console));
2266 return bfwd->default_value;
2269 case SYMVAL_FIXNUM_FORWARD:
2270 case SYMVAL_CONST_FIXNUM_FORWARD:
2271 case SYMVAL_BOOLEAN_FORWARD:
2272 case SYMVAL_CONST_BOOLEAN_FORWARD:
2273 case SYMVAL_OBJECT_FORWARD:
2274 case SYMVAL_CONST_OBJECT_FORWARD:
2275 case SYMVAL_CONST_SPECIFIER_FORWARD:
2276 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2277 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2278 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2279 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2282 /* For other variables, get the current value. */
2283 return do_symval_forwarding(valcontents, current_buffer,
2284 XCONSOLE(Vselected_console));
2287 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2290 DEFUN("default-boundp", Fdefault_boundp, 1, 1, 0, /*
2291 Return t if SYMBOL has a non-void default value.
2292 This is the value that is seen in buffers that do not have their own values
2297 return UNBOUNDP(default_value(symbol)) ? Qnil : Qt;
2300 DEFUN("default-value", Fdefault_value, 1, 1, 0, /*
2301 Return SYMBOL's default value.
2302 This is the value that is seen in buffers that do not have their own values
2303 for this variable. The default value is meaningful for variables with
2304 local bindings in certain buffers.
2308 Lisp_Object value = default_value(symbol);
2310 return UNBOUNDP(value) ? Fsignal(Qvoid_variable, list1(symbol)) : value;
2313 DEFUN("set-default", Fset_default, 2, 2, 0, /*
2314 Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated.
2315 The default value is seen in buffers that do not have their own values
2320 Lisp_Object valcontents;
2322 CHECK_SYMBOL(symbol);
2325 valcontents = XSYMBOL(symbol)->value;
2328 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2329 return Fset(symbol, value);
2331 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2332 case SYMVAL_LISP_MAGIC:
2333 RETURN_IF_NOT_UNBOUND(maybe_call_magic_handler
2334 (symbol, Qset_default, 1, value));
2335 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2339 case SYMVAL_VARALIAS:
2340 symbol = follow_varalias_pointers(symbol, Qset_default);
2341 /* presto change-o! */
2344 case SYMVAL_CURRENT_BUFFER_FORWARD:
2345 set_default_buffer_slot_variable(symbol, value);
2348 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2349 set_default_console_slot_variable(symbol, value);
2352 case SYMVAL_BUFFER_LOCAL:
2353 case SYMVAL_SOME_BUFFER_LOCAL: {
2354 /* Store new value into the DEFAULT-VALUE slot */
2355 struct symbol_value_buffer_local *bfwd
2356 = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2358 bfwd->default_value = value;
2359 /* If current-buffer doesn't shadow default_value,
2360 * we must set the CURRENT-VALUE slot too */
2361 if (NILP(bfwd->current_alist_element))
2362 store_symval_forwarding(symbol,
2363 bfwd->current_value,
2368 case SYMVAL_FIXNUM_FORWARD:
2369 case SYMVAL_CONST_FIXNUM_FORWARD:
2370 case SYMVAL_BOOLEAN_FORWARD:
2371 case SYMVAL_CONST_BOOLEAN_FORWARD:
2372 case SYMVAL_OBJECT_FORWARD:
2373 case SYMVAL_CONST_OBJECT_FORWARD:
2374 case SYMVAL_CONST_SPECIFIER_FORWARD:
2375 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2376 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2377 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2378 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2379 case SYMVAL_UNBOUND_MARKER:
2382 return Fset(symbol, value);
2386 DEFUN("setq-default", Fsetq_default, 0, UNEVALLED, 0, /*
2387 Set the default value of variable SYMBOL to VALUE.
2388 SYMBOL, the variable name, is literal (not evaluated);
2389 VALUE is an expression and it is evaluated.
2390 The default value of a variable is seen in buffers
2391 that do not have their own values for the variable.
2393 More generally, you can use multiple variables and values, as in
2394 (setq-default SYMBOL VALUE SYMBOL VALUE...)
2395 This sets each SYMBOL's default value to the corresponding VALUE.
2396 The VALUE for the Nth SYMBOL can refer to the new default values
2397 of previous SYMBOLs.
2401 /* This function can GC */
2402 Lisp_Object symbol, tail, val = Qnil;
2404 struct gcpro gcpro1;
2406 GET_LIST_LENGTH(args, nargs);
2408 if (nargs & 1) /* Odd number of arguments? */
2409 Fsignal(Qwrong_number_of_arguments,
2410 list2(Qsetq_default, make_int(nargs)));
2414 PROPERTY_LIST_LOOP(tail, symbol, val, args) {
2416 Fset_default(symbol, val);
2423 /* Lisp functions for creating and removing buffer-local variables. */
2425 DEFUN("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1, "vMake Variable Buffer Local: ", /*
2426 Make VARIABLE have a separate value for each buffer.
2427 At any time, the value for the current buffer is in effect.
2428 There is also a default value which is seen in any buffer which has not yet
2430 Using `set' or `setq' to set the variable causes it to have a separate value
2431 for the current buffer if it was previously using the default value.
2432 The function `default-value' gets the default value and `set-default'
2437 Lisp_Object valcontents;
2439 CHECK_SYMBOL(variable);
2442 verify_ok_for_buffer_local(variable, Qmake_variable_buffer_local);
2444 valcontents = XSYMBOL(variable)->value;
2447 if (SYMBOL_VALUE_MAGIC_P(valcontents)) {
2448 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2449 case SYMVAL_LISP_MAGIC:
2450 if (!UNBOUNDP(maybe_call_magic_handler
2451 (variable, Qmake_variable_buffer_local,
2455 XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2459 case SYMVAL_VARALIAS:
2460 variable = follow_varalias_pointers(
2462 Qmake_variable_buffer_local);
2463 /* presto change-o! */
2466 case SYMVAL_FIXNUM_FORWARD:
2467 case SYMVAL_BOOLEAN_FORWARD:
2468 case SYMVAL_OBJECT_FORWARD:
2469 case SYMVAL_UNBOUND_MARKER:
2472 case SYMVAL_CURRENT_BUFFER_FORWARD:
2473 case SYMVAL_BUFFER_LOCAL:
2474 /* Already per-each-buffer */
2477 case SYMVAL_SOME_BUFFER_LOCAL:
2479 XSYMBOL_VALUE_BUFFER_LOCAL(valcontents)->magic.type =
2480 SYMVAL_BUFFER_LOCAL;
2483 case SYMVAL_CONST_FIXNUM_FORWARD:
2484 case SYMVAL_CONST_BOOLEAN_FORWARD:
2485 case SYMVAL_CONST_OBJECT_FORWARD:
2486 case SYMVAL_CONST_SPECIFIER_FORWARD:
2487 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2488 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2489 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2490 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2491 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2499 struct symbol_value_buffer_local *bfwd
2500 = alloc_lcrecord_type(struct symbol_value_buffer_local,
2501 &lrecord_symbol_value_buffer_local);
2503 zero_lcrecord(&bfwd->magic);
2504 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2506 bfwd->default_value = find_symbol_value(variable);
2507 bfwd->current_value = valcontents;
2508 bfwd->current_alist_element = Qnil;
2509 bfwd->current_buffer = Fcurrent_buffer();
2510 XSETSYMBOL_VALUE_MAGIC(foo, bfwd);
2511 *value_slot_past_magic(variable) = foo;
2512 #if 1 /* #### Yuck! FSFmacs bug-compatibility */
2513 /* This sets the default-value of any make-variable-buffer-local to nil.
2514 That just sucks. User can just use setq-default to effect that,
2515 but there's no way to do makunbound-default to undo this lossage. */
2516 if (UNBOUNDP(valcontents))
2517 bfwd->default_value = Qnil;
2519 #if 0 /* #### Yuck! */
2520 /* This sets the value to nil in this buffer.
2521 User could use (setq variable nil) to do this.
2522 It isn't as egregious to do this automatically
2523 as it is to do so to the default-value, but it's
2524 still really dubious. */
2525 if (UNBOUNDP(valcontents))
2526 Fset(variable, Qnil);
2532 DEFUN("make-local-variable", Fmake_local_variable, 1, 1, "vMake Local Variable: ", /*
2533 Make VARIABLE have a separate value in the current buffer.
2534 Other buffers will continue to share a common default value.
2535 \(The buffer-local value of VARIABLE starts out as the same value
2536 VARIABLE previously had. If VARIABLE was void, it remains void.)
2537 See also `make-variable-buffer-local'.
2539 If the variable is already arranged to become local when set,
2540 this function causes a local value to exist for this buffer,
2541 just as setting the variable would do.
2543 Do not use `make-local-variable' to make a hook variable buffer-local.
2544 Use `make-local-hook' instead.
2548 Lisp_Object valcontents;
2549 struct symbol_value_buffer_local *bfwd;
2551 CHECK_SYMBOL(variable);
2554 verify_ok_for_buffer_local(variable, Qmake_local_variable);
2556 valcontents = XSYMBOL(variable)->value;
2559 if (SYMBOL_VALUE_MAGIC_P(valcontents)) {
2560 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2561 case SYMVAL_LISP_MAGIC:
2562 if (!UNBOUNDP(maybe_call_magic_handler
2563 (variable, Qmake_local_variable, 0)))
2566 XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2570 case SYMVAL_VARALIAS:
2572 follow_varalias_pointers(variable,
2573 Qmake_local_variable);
2574 /* presto change-o! */
2577 case SYMVAL_FIXNUM_FORWARD:
2578 case SYMVAL_BOOLEAN_FORWARD:
2579 case SYMVAL_OBJECT_FORWARD:
2580 case SYMVAL_UNBOUND_MARKER:
2583 case SYMVAL_BUFFER_LOCAL:
2584 case SYMVAL_CURRENT_BUFFER_FORWARD: {
2585 /* Make sure the symbol has a local value in this
2586 particular buffer, by setting it to the same value it
2588 Fset(variable, find_symbol_value(variable));
2592 case SYMVAL_SOME_BUFFER_LOCAL: {
2593 if (!NILP(buffer_local_alist_element
2594 (current_buffer, variable,
2595 (XSYMBOL_VALUE_BUFFER_LOCAL(valcontents)))))
2596 goto already_local_to_current_buffer;
2598 goto already_local_to_some_other_buffer;
2601 case SYMVAL_CONST_FIXNUM_FORWARD:
2602 case SYMVAL_CONST_BOOLEAN_FORWARD:
2603 case SYMVAL_CONST_OBJECT_FORWARD:
2604 case SYMVAL_CONST_SPECIFIER_FORWARD:
2605 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2606 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2607 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2608 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2609 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2615 /* Make sure variable is set up to hold per-buffer values */
2616 bfwd = alloc_lcrecord_type(struct symbol_value_buffer_local,
2617 &lrecord_symbol_value_buffer_local);
2618 zero_lcrecord(&bfwd->magic);
2619 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2621 bfwd->current_buffer = Qnil;
2622 bfwd->current_alist_element = Qnil;
2623 bfwd->current_value = valcontents;
2624 /* passing 0 is OK because this should never be a
2625 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2627 bfwd->default_value = do_symval_forwarding(valcontents, 0, 0);
2630 if (UNBOUNDP(bfwd->default_value))
2631 bfwd->default_value = Qnil; /* Yuck! */
2634 XSETSYMBOL_VALUE_MAGIC(valcontents, bfwd);
2635 *value_slot_past_magic(variable) = valcontents;
2637 already_local_to_some_other_buffer:
2639 /* Make sure this buffer has its own value of variable */
2640 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2642 if (UNBOUNDP(bfwd->default_value)) {
2643 /* If default value is unbound, set local value to nil. */
2644 XSETBUFFER(bfwd->current_buffer, current_buffer);
2645 bfwd->current_alist_element = Fcons(variable, Qnil);
2646 current_buffer->local_var_alist =
2647 Fcons(bfwd->current_alist_element,
2648 current_buffer->local_var_alist);
2649 store_symval_forwarding(variable, bfwd->current_value, Qnil);
2653 current_buffer->local_var_alist
2654 = Fcons(Fcons(variable, bfwd->default_value),
2655 current_buffer->local_var_alist);
2657 /* Make sure symbol does not think it is set up for this buffer;
2658 force it to look once again for this buffer's value */
2659 if (!NILP(bfwd->current_buffer) &&
2660 current_buffer == XBUFFER(bfwd->current_buffer))
2661 bfwd->current_buffer = Qnil;
2663 already_local_to_current_buffer:
2665 /* If the symbol forwards into a C variable, then swap in the
2666 variable for this buffer immediately. If C code modifies the
2667 variable before we swap in, then that new value will clobber the
2668 default value the next time we swap. */
2669 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2670 if (SYMBOL_VALUE_MAGIC_P(bfwd->current_value)) {
2671 switch (XSYMBOL_VALUE_MAGIC_TYPE(bfwd->current_value)) {
2672 case SYMVAL_FIXNUM_FORWARD:
2673 case SYMVAL_BOOLEAN_FORWARD:
2674 case SYMVAL_OBJECT_FORWARD:
2675 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2676 set_up_buffer_local_cache(variable, bfwd,
2677 current_buffer, Qnil, 1);
2680 case SYMVAL_UNBOUND_MARKER:
2681 case SYMVAL_CURRENT_BUFFER_FORWARD:
2684 case SYMVAL_CONST_FIXNUM_FORWARD:
2685 case SYMVAL_CONST_BOOLEAN_FORWARD:
2686 case SYMVAL_CONST_OBJECT_FORWARD:
2687 case SYMVAL_CONST_SPECIFIER_FORWARD:
2688 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2689 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2690 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2691 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2692 case SYMVAL_BUFFER_LOCAL:
2693 case SYMVAL_SOME_BUFFER_LOCAL:
2694 case SYMVAL_LISP_MAGIC:
2695 case SYMVAL_VARALIAS:
2705 DEFUN("kill-local-variable", Fkill_local_variable, 1, 1, "vKill Local Variable: ", /*
2706 Make VARIABLE no longer have a separate value in the current buffer.
2707 From now on the default value will apply in this buffer.
2711 Lisp_Object valcontents;
2713 CHECK_SYMBOL(variable);
2716 valcontents = XSYMBOL(variable)->value;
2719 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2722 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2723 case SYMVAL_LISP_MAGIC:
2724 if (!UNBOUNDP(maybe_call_magic_handler
2725 (variable, Qkill_local_variable, 0)))
2727 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2731 case SYMVAL_VARALIAS:
2733 follow_varalias_pointers(variable, Qkill_local_variable);
2734 /* presto change-o! */
2737 case SYMVAL_CURRENT_BUFFER_FORWARD: {
2738 const struct symbol_value_forward *fwd
2739 = XSYMBOL_VALUE_FORWARD(valcontents);
2740 int offset = ((char *)symbol_value_forward_forward(fwd)
2741 - (char *)&buffer_local_flags);
2742 int mask = XINT(*((Lisp_Object *)
2743 symbol_value_forward_forward(fwd)));
2746 int (*magicfun) (Lisp_Object sym,
2748 Lisp_Object in_object,
2750 symbol_value_forward_magicfun(fwd);
2751 Lisp_Object oldval = *(Lisp_Object *)
2752 (offset + (char *)XBUFFER(Vbuffer_defaults));
2754 (magicfun) (variable, &oldval,
2755 make_buffer(current_buffer),
2758 *(Lisp_Object *)(offset + (char *)current_buffer) =
2760 current_buffer->local_var_flags &= ~mask;
2765 case SYMVAL_BUFFER_LOCAL:
2766 case SYMVAL_SOME_BUFFER_LOCAL: {
2767 /* Get rid of this buffer's alist element, if any */
2768 struct symbol_value_buffer_local *bfwd
2769 = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2770 Lisp_Object alist = current_buffer->local_var_alist;
2771 Lisp_Object alist_element
2773 buffer_local_alist_element(current_buffer, variable,
2776 if (!NILP(alist_element))
2777 current_buffer->local_var_alist =
2778 Fdelq(alist_element, alist);
2780 /* Make sure symbol does not think it is set up for this buffer;
2781 force it to look once again for this buffer's value */
2782 if (!NILP(bfwd->current_buffer) &&
2783 current_buffer == XBUFFER(bfwd->current_buffer))
2784 bfwd->current_buffer = Qnil;
2786 /* We just changed the value in the current_buffer. If this
2787 variable forwards to a C variable, we need to change the
2788 value of the C variable. set_up_buffer_local_cache() will do
2789 this. It doesn't hurt to do it always, so just go ahead and
2791 set_up_buffer_local_cache(variable, bfwd,
2792 current_buffer, Qnil, 1);
2796 case SYMVAL_FIXNUM_FORWARD:
2797 case SYMVAL_CONST_FIXNUM_FORWARD:
2798 case SYMVAL_BOOLEAN_FORWARD:
2799 case SYMVAL_CONST_BOOLEAN_FORWARD:
2800 case SYMVAL_OBJECT_FORWARD:
2801 case SYMVAL_CONST_OBJECT_FORWARD:
2802 case SYMVAL_CONST_SPECIFIER_FORWARD:
2803 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2804 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2805 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2806 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2807 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2808 case SYMVAL_UNBOUND_MARKER:
2813 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2816 DEFUN("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2817 "vKill Console Local Variable: ", /*
2818 Make VARIABLE no longer have a separate value in the selected console.
2819 From now on the default value will apply in this console.
2823 Lisp_Object valcontents;
2825 CHECK_SYMBOL(variable);
2828 valcontents = XSYMBOL(variable)->value;
2831 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2834 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2835 case SYMVAL_LISP_MAGIC:
2836 if (!UNBOUNDP(maybe_call_magic_handler
2837 (variable, Qkill_console_local_variable, 0)))
2839 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2843 case SYMVAL_VARALIAS:
2844 variable = follow_varalias_pointers(variable,
2845 Qkill_console_local_variable);
2846 /* presto change-o! */
2849 case SYMVAL_SELECTED_CONSOLE_FORWARD: {
2850 const struct symbol_value_forward *fwd
2851 = XSYMBOL_VALUE_FORWARD(valcontents);
2852 int offset = ((char *)symbol_value_forward_forward(fwd)
2853 - (char *)&console_local_flags);
2854 int mask = XINT(*((Lisp_Object *)
2855 symbol_value_forward_forward(fwd)));
2858 int (*magicfun) (Lisp_Object sym,
2860 Lisp_Object in_object,
2862 symbol_value_forward_magicfun(fwd);
2863 Lisp_Object oldval = *(Lisp_Object *)
2865 (char *)XCONSOLE(Vconsole_defaults));
2867 magicfun(variable, &oldval,
2868 Vselected_console, 0);
2870 *(Lisp_Object *) (offset +
2871 (char *)XCONSOLE(Vselected_console)) =
2873 XCONSOLE(Vselected_console)->local_var_flags &= ~mask;
2878 case SYMVAL_FIXNUM_FORWARD:
2879 case SYMVAL_CONST_FIXNUM_FORWARD:
2880 case SYMVAL_BOOLEAN_FORWARD:
2881 case SYMVAL_CONST_BOOLEAN_FORWARD:
2882 case SYMVAL_OBJECT_FORWARD:
2883 case SYMVAL_CONST_OBJECT_FORWARD:
2884 case SYMVAL_CONST_SPECIFIER_FORWARD:
2885 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2886 case SYMVAL_CURRENT_BUFFER_FORWARD:
2887 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2888 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2889 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2890 case SYMVAL_UNBOUND_MARKER:
2891 case SYMVAL_BUFFER_LOCAL:
2892 case SYMVAL_SOME_BUFFER_LOCAL:
2899 /* Used by specbind to determine what effects it might have. Returns:
2900 * 0 if symbol isn't buffer-local, and wouldn't be after it is set
2901 * <0 if symbol isn't presently buffer-local, but set would make it so
2902 * >0 if symbol is presently buffer-local
2904 int symbol_value_buffer_local_info(Lisp_Object symbol, struct buffer *buffer)
2906 Lisp_Object valcontents;
2909 valcontents = XSYMBOL(symbol)->value;
2912 if (SYMBOL_VALUE_MAGIC_P(valcontents)) {
2913 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2914 case SYMVAL_LISP_MAGIC:
2917 XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2921 case SYMVAL_VARALIAS:
2923 follow_varalias_pointers(symbol,
2924 Qt /* #### kludge */ );
2925 /* presto change-o! */
2928 case SYMVAL_CURRENT_BUFFER_FORWARD: {
2929 const struct symbol_value_forward *fwd
2930 = XSYMBOL_VALUE_FORWARD(valcontents);
2931 int mask = XINT(*((Lisp_Object *)
2932 symbol_value_forward_forward
2935 (buffer && (buffer->local_var_flags & mask))){
2936 /* Already buffer-local */
2939 /* Would be buffer-local after set */
2943 case SYMVAL_BUFFER_LOCAL:
2944 case SYMVAL_SOME_BUFFER_LOCAL: {
2945 struct symbol_value_buffer_local *bfwd
2946 = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2949 !NILP(buffer_local_alist_element
2950 (buffer, symbol, bfwd)))
2953 /* Automatically becomes local when set */
2954 return bfwd->magic.type ==
2955 SYMVAL_BUFFER_LOCAL ? -1 : 0;
2958 case SYMVAL_FIXNUM_FORWARD:
2959 case SYMVAL_CONST_FIXNUM_FORWARD:
2960 case SYMVAL_BOOLEAN_FORWARD:
2961 case SYMVAL_CONST_BOOLEAN_FORWARD:
2962 case SYMVAL_OBJECT_FORWARD:
2963 case SYMVAL_CONST_OBJECT_FORWARD:
2964 case SYMVAL_CONST_SPECIFIER_FORWARD:
2965 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2966 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2967 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2968 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2969 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2970 case SYMVAL_UNBOUND_MARKER:
2979 DEFUN("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2980 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2982 (symbol, buffer, unbound_value))
2985 CHECK_SYMBOL(symbol);
2986 CHECK_BUFFER(buffer);
2987 value = symbol_value_in_buffer(symbol, buffer);
2988 return UNBOUNDP(value) ? unbound_value : value;
2991 DEFUN("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2992 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2994 (symbol, console, unbound_value))
2997 CHECK_SYMBOL(symbol);
2998 CHECK_CONSOLE(console);
2999 value = symbol_value_in_console(symbol, console);
3000 return UNBOUNDP(value) ? unbound_value : value;
3003 DEFUN("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
3004 -in variable, return info about this; else return nil.
3005 ll be a symbol, one of
3007 A simple built-in variable.
3008 Same, but cannot be set.
3009 A built-in integer variable.
3010 Same, but cannot be set.
3011 A built-in boolean variable.
3012 Same, but cannot be set.
3013 Always contains a specifier; e.g. `has-modeline-p'.
3014 A built-in buffer-local variable.
3015 fer' Same, but cannot be set.
3016 Forwards to the default value of a built-in
3017 buffer-local variable.
3018 A built-in console-local variable.
3019 nsole' Same, but cannot be set.
3020 Forwards to the default value of a built-in
3021 console-local variable.
3025 REGISTER Lisp_Object valcontents;
3027 CHECK_SYMBOL(symbol);
3030 valcontents = XSYMBOL(symbol)->value;
3033 if (!SYMBOL_VALUE_MAGIC_P(valcontents))
3036 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
3037 case SYMVAL_LISP_MAGIC:
3038 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
3042 case SYMVAL_VARALIAS:
3043 symbol = follow_varalias_pointers(symbol, Qt);
3044 /* presto change-o! */
3047 case SYMVAL_BUFFER_LOCAL:
3048 case SYMVAL_SOME_BUFFER_LOCAL:
3050 XSYMBOL_VALUE_BUFFER_LOCAL(valcontents)->current_value;
3054 case SYMVAL_FIXNUM_FORWARD:
3056 case SYMVAL_CONST_FIXNUM_FORWARD:
3057 return Qconst_integer;
3058 case SYMVAL_BOOLEAN_FORWARD:
3060 case SYMVAL_CONST_BOOLEAN_FORWARD:
3061 return Qconst_boolean;
3062 case SYMVAL_OBJECT_FORWARD:
3064 case SYMVAL_CONST_OBJECT_FORWARD:
3065 return Qconst_object;
3066 case SYMVAL_CONST_SPECIFIER_FORWARD:
3067 return Qconst_specifier;
3068 case SYMVAL_DEFAULT_BUFFER_FORWARD:
3069 return Qdefault_buffer;
3070 case SYMVAL_CURRENT_BUFFER_FORWARD:
3071 return Qcurrent_buffer;
3072 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
3073 return Qconst_current_buffer;
3074 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
3075 return Qdefault_console;
3076 case SYMVAL_SELECTED_CONSOLE_FORWARD:
3077 return Qselected_console;
3078 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
3079 return Qconst_selected_console;
3080 case SYMVAL_UNBOUND_MARKER:
3089 DEFUN("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
3090 n t if SYMBOL's value is local to BUFFER.
3091 tional third arg AFTER-SET is non-nil, return t if SYMBOL would be
3092 r-local after it is set, regardless of whether it is so presently.
3093 value for BUFFER is *not* the same as (current-buffer), but means
3094 uffer". Specifically:
3096 If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
3097 the variable is one of the special built-in variables that is always
3098 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
3099 `buffer-undo-list', and others.)
3101 If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
3102 the variable has had `make-variable-buffer-local' applied to it.
3104 (symbol, buffer, after_set))
3108 CHECK_SYMBOL(symbol);
3109 if (!NILP(buffer)) {
3110 buffer = emacs_get_buffer(buffer, 1);
3112 symbol_value_buffer_local_info(symbol, XBUFFER(buffer));
3114 local_info = symbol_value_buffer_local_info(symbol, 0);
3117 if (NILP(after_set))
3118 return local_info > 0 ? Qt : Qnil;
3120 return local_info != 0 ? Qt : Qnil;
3124 I've gone ahead and partially implemented this because it's
3125 super-useful for dealing with the compatibility problems in supporting
3126 the old pointer-shape variables, and preventing people from `setq'ing
3127 the new variables. Any other way of handling this problem is way
3128 ugly, likely to be slow, and generally not something I want to waste
3129 my time worrying about.
3131 The interface and/or function name is sure to change before this
3132 gets into its final form. I currently like the way everything is
3133 set up and it has all the features I want it to have, except for
3134 one: I really want to be able to have multiple nested handlers,
3135 to implement an `advice'-like capability. This would allow,
3136 for example, a clean way of implementing `debug-if-set' or
3137 `debug-if-referenced' and such.
3139 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
3140 ************************************************************
3141 **Only** the `set-value', `make-unbound', and `make-local'
3142 handler types are currently implemented. Implementing the
3143 get-value and bound-predicate handlers is somewhat tricky
3144 because there are lots of subfunctions (e.g. find_symbol_value()).
3145 find_symbol_value(), in fact, is called from outside of
3146 this module. You'd have to have it do this:
3148 -- check for a `bound-predicate' handler, call that if so;
3149 if it returns nil, return Qunbound
3150 -- check for a `get-value' handler and call it and return
3153 It gets even trickier when you have to deal with
3154 sub-subfunctions like find_symbol_value_1(), and esp.
3155 when you have to properly handle variable aliases, which
3156 can lead to lots of tricky situations. So I've just
3157 punted on this, since the interface isn't officially
3158 exported and we can get by with just a `set-value'
3161 Actions in unimplemented handler types will correctly
3162 ignore any handlers, and will not fuck anything up or
3165 WARNING WARNING: If you do go and implement another
3166 type of handler, make *sure* to change
3167 would_be_magic_handled() so it knows about this,
3168 or dire things could result.
3169 ************************************************************
3170 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
3172 Real documentation is as follows.
3174 Set a magic handler for VARIABLE.
3175 This allows you to specify arbitrary behavior that results from
3176 accessing or setting a variable. For example, retrieving the
3177 variable's value might actually retrieve the first element off of
3178 a list stored in another variable, and setting the variable's value
3179 might add an element to the front of that list. (This is how the
3180 obsolete variable `unread-command-event' is implemented.)
3182 In general it is NOT good programming practice to use magic variables
3183 in a new package that you are designing. If you feel the need to
3184 do this, it's almost certainly a sign that you should be using a
3185 function instead of a variable. This facility is provided to allow
3186 a package to support obsolete variables and provide compatibility
3187 with similar packages with different variable names and semantics.
3188 By using magic handlers, you can cleanly provide obsoleteness and
3189 compatibility support and separate this support from the core
3190 routines in a package.
3192 VARIABLE should be a symbol naming the variable for which the
3193 magic behavior is provided. HANDLER-TYPE is a symbol specifying
3194 which behavior is being controlled, and HANDLER is the function
3195 that will be called to control this behavior. HARG is a
3196 value that will be passed to HANDLER but is otherwise
3197 uninterpreted. KEEP-EXISTING specifies what to do with existing
3198 handlers of the same type; nil means "erase them all", t means
3199 "keep them but insert at the beginning", the list (t) means
3200 "keep them but insert at the end", a function means "keep
3201 them but insert before the specified function", a list containing
3202 a function means "keep them but insert after the specified
3205 You can specify magic behavior for any type of variable at all,
3206 and for any handler types that are unspecified, the standard
3207 behavior applies. This allows you, for example, to use
3208 `defvaralias' in conjunction with this function. (For that
3209 matter, `defvaralias' could be implemented using this function.)
3211 The behaviors that can be specified in HANDLER-TYPE are
3213 get-value (SYM ARGS FUN HARG HANDLERS)
3214 This means that one of the functions `symbol-value',
3215 `default-value', `symbol-value-in-buffer', or
3216 `symbol-value-in-console' was called on SYM.
3218 set-value (SYM ARGS FUN HARG HANDLERS)
3219 This means that one of the functions `set' or `set-default'
3222 bound-predicate (SYM ARGS FUN HARG HANDLERS)
3223 This means that one of the functions `boundp', `globally-boundp',
3224 or `default-boundp' was called on SYM.
3226 make-unbound (SYM ARGS FUN HARG HANDLERS)
3227 This means that the function `makunbound' was called on SYM.
3229 local-predicate (SYM ARGS FUN HARG HANDLERS)
3230 This means that the function `local-variable-p' was called
3233 make-local (SYM ARGS FUN HARG HANDLERS)
3234 This means that one of the functions `make-local-variable',
3235 `make-variable-buffer-local', `kill-local-variable',
3236 or `kill-console-local-variable' was called on SYM.
3238 The meanings of the arguments are as follows:
3240 SYM is the symbol on which the function was called, and is always
3241 the first argument to the function.
3243 ARGS are the remaining arguments in the original call (i.e. all
3244 but the first). In the case of `set-value' in particular,
3245 the first element of ARGS is the value to which the variable
3246 is being set. In some cases, ARGS is sanitized from what was
3247 actually given. For example, whenever `nil' is passed to an
3248 argument and it means `current-buffer', the current buffer is
3249 substituted instead.
3251 FUN is a symbol indicating which function is being called.
3252 For many of the functions, you can determine the corresponding
3253 function of a different class using
3254 `symbol-function-corresponding-function'.
3256 HARG is the argument that was given in the call
3257 to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
3259 HANDLERS is a structure containing the remaining handlers
3260 for the variable; to call one of them, use
3261 `chain-to-symbol-value-handler'.
3263 NOTE: You may *not* modify the list in ARGS, and if you want to
3264 keep it around after the handler function exits, you must make
3265 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
3268 static enum lisp_magic_handler decode_magic_handler_type(Lisp_Object symbol)
3270 if (EQ(symbol, Qget_value))
3271 return MAGIC_HANDLER_GET_VALUE;
3272 if (EQ(symbol, Qset_value))
3273 return MAGIC_HANDLER_SET_VALUE;
3274 if (EQ(symbol, Qbound_predicate))
3275 return MAGIC_HANDLER_BOUND_PREDICATE;
3276 if (EQ(symbol, Qmake_unbound))
3277 return MAGIC_HANDLER_MAKE_UNBOUND;
3278 if (EQ(symbol, Qlocal_predicate))
3279 return MAGIC_HANDLER_LOCAL_PREDICATE;
3280 if (EQ(symbol, Qmake_local))
3281 return MAGIC_HANDLER_MAKE_LOCAL;
3283 signal_simple_error("Unrecognized symbol value handler type", symbol);
3285 return MAGIC_HANDLER_MAX;
3288 static enum lisp_magic_handler
3289 handler_type_from_function_symbol(Lisp_Object funsym, int abort_if_not_found)
3291 if (EQ(funsym, Qsymbol_value)
3292 || EQ(funsym, Qdefault_value)
3293 || EQ(funsym, Qsymbol_value_in_buffer)
3294 || EQ(funsym, Qsymbol_value_in_console))
3295 return MAGIC_HANDLER_GET_VALUE;
3297 if (EQ(funsym, Qset)
3298 || EQ(funsym, Qset_default))
3299 return MAGIC_HANDLER_SET_VALUE;
3301 if (EQ(funsym, Qboundp)
3302 || EQ(funsym, Qglobally_boundp)
3303 || EQ(funsym, Qdefault_boundp))
3304 return MAGIC_HANDLER_BOUND_PREDICATE;
3306 if (EQ(funsym, Qmakunbound))
3307 return MAGIC_HANDLER_MAKE_UNBOUND;
3309 if (EQ(funsym, Qlocal_variable_p))
3310 return MAGIC_HANDLER_LOCAL_PREDICATE;
3312 if (EQ(funsym, Qmake_variable_buffer_local)
3313 || EQ(funsym, Qmake_local_variable))
3314 return MAGIC_HANDLER_MAKE_LOCAL;
3316 if (abort_if_not_found)
3318 signal_simple_error("Unrecognized symbol-value function", funsym);
3319 return MAGIC_HANDLER_MAX;
3322 static int would_be_magic_handled(Lisp_Object sym, Lisp_Object funsym)
3324 /* does not take into account variable aliasing. */
3325 Lisp_Object valcontents = XSYMBOL(sym)->value;
3326 enum lisp_magic_handler slot;
3328 if (!SYMBOL_VALUE_LISP_MAGIC_P(valcontents))
3330 slot = handler_type_from_function_symbol(funsym, 1);
3331 if (slot != MAGIC_HANDLER_SET_VALUE
3332 && slot != MAGIC_HANDLER_MAKE_UNBOUND
3333 && slot != MAGIC_HANDLER_MAKE_LOCAL)
3334 /* #### temporary kludge because we haven't implemented
3335 lisp-magic variables completely */
3337 return !NILP(XSYMBOL_VALUE_LISP_MAGIC(valcontents)->handler[slot]);
3341 fetch_value_maybe_past_magic(Lisp_Object sym,
3342 Lisp_Object follow_past_lisp_magic)
3344 Lisp_Object value = XSYMBOL(sym)->value;
3345 if (SYMBOL_VALUE_LISP_MAGIC_P(value)
3346 && (EQ(follow_past_lisp_magic, Qt)
3347 || (!NILP(follow_past_lisp_magic)
3348 && !would_be_magic_handled(sym, follow_past_lisp_magic))))
3349 value = XSYMBOL_VALUE_LISP_MAGIC(value)->shadowed;
3353 static Lisp_Object *value_slot_past_magic(Lisp_Object sym)
3355 Lisp_Object *store_pointer = &XSYMBOL(sym)->value;
3357 if (SYMBOL_VALUE_LISP_MAGIC_P(*store_pointer))
3358 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC(sym)->shadowed;
3359 return store_pointer;
3363 maybe_call_magic_handler(Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
3366 Lisp_Object args[20]; /* should be enough ... */
3368 enum lisp_magic_handler htype;
3369 Lisp_Object legerdemain;
3370 struct symbol_value_lisp_magic *bfwd;
3372 assert(nargs >= 0 && nargs < countof(args));
3373 legerdemain = XSYMBOL(sym)->value;
3374 assert(SYMBOL_VALUE_LISP_MAGIC_P(legerdemain));
3375 bfwd = XSYMBOL_VALUE_LISP_MAGIC(legerdemain);
3377 va_start(vargs, nargs);
3378 for (i = 0; i < nargs; i++)
3379 args[i] = va_arg(vargs, Lisp_Object);
3382 htype = handler_type_from_function_symbol(funsym, 1);
3383 if (NILP(bfwd->handler[htype]))
3385 /* #### should be reusing the arglist, not always consing anew.
3386 Repeated handler invocations should not cause repeated consing.
3387 Doesn't matter for now, because this is just a quick implementation
3388 for obsolescence support. */
3389 return call5(bfwd->handler[htype], sym, Flist(nargs, args), funsym,
3390 bfwd->harg[htype], Qnil);
3393 DEFUN("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler, 3, 5, 0, /*
3394 Don't you dare use this.
3395 If you do, suffer the wrath of Ben, who is likely to rename
3396 this function (or change the semantics of its arguments) without
3397 pity, thereby invalidating your code.
3399 (variable, handler_type, handler, harg, keep_existing))
3401 Lisp_Object valcontents;
3402 struct symbol_value_lisp_magic *bfwd;
3403 enum lisp_magic_handler htype;
3406 /* #### WARNING, only some handler types are implemented. See above.
3407 Actions of other types will ignore a handler if it's there.
3409 #### Also, `chain-to-symbol-value-handler' and
3410 `symbol-function-corresponding-function' are not implemented. */
3411 CHECK_SYMBOL(variable);
3412 CHECK_SYMBOL(handler_type);
3413 htype = decode_magic_handler_type(handler_type);
3414 valcontents = XSYMBOL(variable)->value;
3415 if (!SYMBOL_VALUE_LISP_MAGIC_P(valcontents)) {
3416 bfwd = alloc_lcrecord_type(struct symbol_value_lisp_magic,
3417 &lrecord_symbol_value_lisp_magic);
3418 zero_lcrecord(&bfwd->magic);
3419 bfwd->magic.type = SYMVAL_LISP_MAGIC;
3420 for (i = 0; i < MAGIC_HANDLER_MAX; i++) {
3421 bfwd->handler[i] = Qnil;
3422 bfwd->harg[i] = Qnil;
3424 bfwd->shadowed = valcontents;
3425 XSETSYMBOL_VALUE_MAGIC(XSYMBOL(variable)->value, bfwd);
3427 bfwd = XSYMBOL_VALUE_LISP_MAGIC(valcontents);
3428 bfwd->handler[htype] = handler;
3429 bfwd->harg[htype] = harg;
3431 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
3432 if (!NILP(bfwd->handler[i]))
3435 if (i == MAGIC_HANDLER_MAX)
3436 /* there are no remaining handlers, so remove the structure. */
3437 XSYMBOL(variable)->value = bfwd->shadowed;
3442 /* functions for working with variable aliases. */
3444 /* Follow the chain of variable aliases for SYMBOL. Return the
3445 resulting symbol, whose value cell is guaranteed not to be a
3446 symbol-value-varalias.
3448 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
3449 If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
3450 never follow; stop right there. Otherwise FUNSYM should be a
3451 recognized symbol-value function symbol; this means, follow
3452 unless there is a special handler for the named function.
3454 OK, there is at least one reason why it's necessary for
3455 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
3456 can always be sure to catch cyclic variable aliasing. If we never
3457 follow past Lisp magic, then if the following is done:
3460 add some magic behavior to a, but not a "get-value" handler
3463 then an attempt to retrieve a's or b's value would cause infinite
3464 looping in `symbol-value'.
3466 We (of course) can't always follow past Lisp magic, because then
3467 we make any variable that is lisp-magic -> varalias behave as if
3468 the lisp-magic is not present at all.
3472 follow_varalias_pointers(Lisp_Object symbol, Lisp_Object follow_past_lisp_magic)
3474 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
3475 Lisp_Object tortoise, hare, val;
3478 /* quick out just in case */
3479 if (!SYMBOL_VALUE_MAGIC_P(XSYMBOL(symbol)->value))
3482 /* Compare implementation of indirect_function(). */
3483 for (hare = tortoise = symbol, count = 0;
3484 val = fetch_value_maybe_past_magic(hare, follow_past_lisp_magic),
3485 SYMBOL_VALUE_VARALIAS_P(val);
3486 hare = symbol_value_varalias_aliasee(XSYMBOL_VALUE_VARALIAS(val)),
3488 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) {
3493 fetch_value_maybe_past_magic(
3494 tortoise, follow_past_lisp_magic);
3495 tortoise = symbol_value_varalias_aliasee(
3496 XSYMBOL_VALUE_VARALIAS(tmp));
3498 if (EQ(hare, tortoise)) {
3499 return Fsignal(Qcyclic_variable_indirection,
3507 DEFUN("defvaralias", Fdefvaralias, 2, 2, 0, /*
3508 Define a variable as an alias for another variable.
3509 Thenceforth, any operations performed on VARIABLE will actually be
3510 performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
3511 If ALIAS is nil, remove any aliases for VARIABLE.
3512 ALIAS can itself be aliased, and the chain of variable aliases
3513 will be followed appropriately.
3514 If VARIABLE already has a value, this value will be shadowed
3515 until the alias is removed, at which point it will be restored.
3516 Currently VARIABLE cannot be a built-in variable, a variable that
3517 has a buffer-local value in any buffer, or the symbols nil or t.
3518 \(ALIAS, however, can be any type of variable.)
3522 struct symbol_value_varalias *bfwd;
3523 Lisp_Object valcontents;
3525 CHECK_SYMBOL(variable);
3526 reject_constant_symbols(variable, Qunbound, 0, Qt);
3528 valcontents = XSYMBOL(variable)->value;
3531 if (SYMBOL_VALUE_VARALIAS_P(valcontents)) {
3532 XSYMBOL(variable)->value =
3533 symbol_value_varalias_shadowed
3534 (XSYMBOL_VALUE_VARALIAS(valcontents));
3539 CHECK_SYMBOL(alias);
3540 if (SYMBOL_VALUE_VARALIAS_P(valcontents)) {
3542 XSYMBOL_VALUE_VARALIAS(valcontents)->aliasee = alias;
3546 if (SYMBOL_VALUE_MAGIC_P(valcontents)
3547 && !UNBOUNDP(valcontents))
3548 signal_simple_error("Variable is magic and cannot be aliased",
3550 reject_constant_symbols(variable, Qunbound, 0, Qt);
3552 bfwd = alloc_lcrecord_type(struct symbol_value_varalias,
3553 &lrecord_symbol_value_varalias);
3554 zero_lcrecord(&bfwd->magic);
3555 bfwd->magic.type = SYMVAL_VARALIAS;
3556 bfwd->aliasee = alias;
3557 bfwd->shadowed = valcontents;
3559 XSETSYMBOL_VALUE_MAGIC(valcontents, bfwd);
3560 XSYMBOL(variable)->value = valcontents;
3564 DEFUN("variable-alias", Fvariable_alias, 1, 2, 0, /*
3565 If VARIABLE is aliased to another variable, return that variable.
3566 VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
3567 Variable aliases are created with `defvaralias'. See also
3568 `indirect-variable'.
3570 (variable, follow_past_lisp_magic))
3572 Lisp_Object valcontents;
3574 CHECK_SYMBOL(variable);
3575 if (!NILP(follow_past_lisp_magic) && !EQ(follow_past_lisp_magic, Qt)) {
3576 CHECK_SYMBOL(follow_past_lisp_magic);
3577 handler_type_from_function_symbol(follow_past_lisp_magic, 0);
3580 valcontents = fetch_value_maybe_past_magic(variable,
3581 follow_past_lisp_magic);
3583 if (SYMBOL_VALUE_VARALIAS_P(valcontents))
3584 return symbol_value_varalias_aliasee
3585 (XSYMBOL_VALUE_VARALIAS(valcontents));
3590 DEFUN("indirect-variable", Findirect_variable, 1, 2, 0, /*
3591 Return the variable at the end of OBJECT's variable-alias chain.
3592 If OBJECT is a symbol, follow all variable aliases and return
3593 the final (non-aliased) symbol. Variable aliases are created with
3594 the function `defvaralias'.
3595 If OBJECT is not a symbol, just return it.
3596 Signal a cyclic-variable-indirection error if there is a loop in the
3597 variable chain of symbols.
3599 (object, follow_past_lisp_magic))
3601 if (!SYMBOLP(object))
3603 if (!NILP(follow_past_lisp_magic) && !EQ(follow_past_lisp_magic, Qt)) {
3604 CHECK_SYMBOL(follow_past_lisp_magic);
3605 handler_type_from_function_symbol(follow_past_lisp_magic, 0);
3607 return follow_varalias_pointers(object, follow_past_lisp_magic);
3610 DEFUN("variable-binding-locus", Fvariable_binding_locus, 1, 1, 0, /*
3611 Return a value indicating where VARIABLE's current binding comes from.
3612 If the current binding is buffer-local, the value is the current buffer.
3613 If the current binding is global (the default), the value is nil.
3617 Lisp_Object valcontents;
3619 CHECK_SYMBOL(variable);
3620 variable = Findirect_variable(variable, Qnil);
3622 /* Make sure the current binding is actually swapped in. */
3623 find_symbol_value(variable);
3625 valcontents = XSYMBOL(variable)->value;
3627 if (SYMBOL_VALUE_MAGIC_P(valcontents)
3628 && ((XSYMBOL_VALUE_MAGIC_TYPE(valcontents) == SYMVAL_BUFFER_LOCAL)
3629 || (XSYMBOL_VALUE_MAGIC_TYPE(valcontents) ==
3630 SYMVAL_SOME_BUFFER_LOCAL))
3631 && (!NILP(Flocal_variable_p(variable, Fcurrent_buffer(), Qnil))))
3632 return Fcurrent_buffer();
3637 /************************************************************************/
3638 /* initialization */
3639 /************************************************************************/
3641 /* A dumped SXEmacs image has a lot more than 1511 symbols. Last
3642 estimate was that there were actually around 6300. So let's try
3643 making this bigger and see if we get better hashing behavior. */
3644 #define OBARRAY_SIZE 16411
3649 #ifndef Qnull_pointer
3650 Lisp_Object Qnull_pointer;
3653 /* some losing systems can't have static vars at function scope... */
3654 static struct symbol_value_magic guts_of_unbound_marker = {
3655 /* struct symbol_value_magic */
3656 { /* struct lcrecord_header */
3657 { /* struct lrecord_header */
3658 lrecord_type_symbol_value_forward, /* lrecord_type_index */
3660 1, /* c_readonly bit */
3661 1, /* lisp_readonly bit */
3663 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
3670 SYMVAL_UNBOUND_MARKER
3676 hcode_t hash = hash_string(string_data(XSYMBOL(Qnil)->name), 3);
3677 XVECTOR_DATA(Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3681 void init_symbols_once_early(void)
3683 INIT_LRECORD_IMPLEMENTATION(symbol);
3684 INIT_LRECORD_IMPLEMENTATION(symbol_value_forward);
3685 INIT_LRECORD_IMPLEMENTATION(symbol_value_buffer_local);
3686 INIT_LRECORD_IMPLEMENTATION(symbol_value_lisp_magic);
3687 INIT_LRECORD_IMPLEMENTATION(symbol_value_varalias);
3689 reinit_symbols_once_early();
3691 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3692 called the first time. */
3693 Qnil = Fmake_symbol(make_string_nocopy((Bufbyte *)"nil", 3));
3694 XSYMBOL(Qnil)->name->plist = Qnil;
3695 XSYMBOL(Qnil)->value = Qnil; /* Nihil ex nihil */
3696 XSYMBOL(Qnil)->plist = Qnil;
3698 Vobarray = make_vector(OBARRAY_SIZE, Qzero);
3699 initial_obarray = Vobarray;
3700 staticpro(&initial_obarray);
3701 /* Intern nil in the obarray */
3705 /* Required to get around a GCC syntax error on certain
3707 struct symbol_value_magic *tem = &guts_of_unbound_marker;
3709 XSETSYMBOL_VALUE_MAGIC(Qunbound, tem);
3712 XSYMBOL(Qnil)->function = Qunbound;
3714 defsymbol(&Qt, "t");
3715 XSYMBOL(Qt)->value = Qt; /* Veritas aeterna */
3718 dump_add_root_object(&Qnil);
3719 dump_add_root_object(&Qunbound);
3720 dump_add_root_object(&Vquit_flag);
3723 void reinit_symbols_once_early(void)
3726 Qzero = make_int(0); /* Only used if Lisp_Object is a union type */
3729 #ifndef Qnull_pointer
3730 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3731 so the following is actually a no-op. */
3732 XSETOBJ(Qnull_pointer, 0);
3737 defsymbol_massage_name_1(Lisp_Object * location, const char *name, int dump_p,
3738 int multiword_predicate_p)
3741 size_t len = strlen(name) - 1;
3744 if (multiword_predicate_p)
3745 /* If it is a multiword_predicate_p it is expected
3746 the last char of name is a p, which should be
3747 removed and replaced with "_p", so the net length
3748 difference is 1 char, the '_' */
3749 assert(len + 1 < sizeof(temp));
3751 assert(len < sizeof(temp));
3753 strncat(temp, name + 1, sizeof(temp)-1); /* Remove initial Q */
3754 if (multiword_predicate_p) {
3755 /* Overwrite the 'p' which is the last char of name
3756 and put "_p" instead. */
3757 strcpy(temp + len - 1, "_p");
3760 for (i = 0; i < len; i++)
3763 *location = Fintern(make_string((const Bufbyte *)temp, len), Qnil);
3765 staticpro(location);
3767 staticpro_nodump(location);
3770 void defsymbol_massage_name_nodump(Lisp_Object * location, const char *name)
3772 defsymbol_massage_name_1(location, name, 0, 0);
3775 void defsymbol_massage_name(Lisp_Object * location, const char *name)
3777 defsymbol_massage_name_1(location, name, 1, 0);
3781 defsymbol_massage_multiword_predicate_nodump(Lisp_Object * location,
3784 defsymbol_massage_name_1(location, name, 0, 1);
3788 defsymbol_massage_multiword_predicate(Lisp_Object * location, const char *name)
3790 defsymbol_massage_name_1(location, name, 1, 1);
3793 void defsymbol_nodump(Lisp_Object * location, char *name)
3795 *location = Fintern(make_string_nocopy(
3796 (Bufbyte *)name, strlen(name)), Qnil);
3797 staticpro_nodump(location);
3800 void defsymbol(Lisp_Object * location, char *name)
3802 *location = Fintern(make_string_nocopy(
3803 (Bufbyte*)name, strlen(name)), Qnil);
3804 staticpro(location);
3807 void defkeyword(Lisp_Object * location, char *name)
3809 defsymbol(location, name);
3810 Fset(*location, *location);
3813 void defkeyword_massage_name(Lisp_Object * location, const char *name)
3816 size_t len = strlen(name);
3818 assert(len < sizeof(temp));
3820 temp[1] = ':'; /* it's an underscore in the C variable */
3822 defsymbol_massage_name(location, temp);
3823 Fset(*location, *location);
3826 #ifdef DEBUG_SXEMACS
3827 /* Check that nobody spazzed writing a DEFUN. */
3828 static void check_sane_subr(Lisp_Subr * subr, Lisp_Object sym)
3830 assert(subr->min_args >= 0);
3831 assert(subr->min_args <= SUBR_MAX_ARGS);
3833 if (subr->max_args != MANY && subr->max_args != UNEVALLED) {
3834 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3835 assert(subr->max_args <= SUBR_MAX_ARGS);
3836 assert(subr->min_args <= subr->max_args);
3839 #if defined somebody_can_explain_why_a_symbol_must_not_be_bound && \
3840 somebody_can_explain_why_a_symbol_must_not_be_bound
3841 assert(UNBOUNDP(XSYMBOL(sym)->function));
3842 #endif /* somebody_can_explain_why_a_symbol_must_not_be_bound */
3845 #define check_sane_subr(subr, sym) /* nothing */
3849 void defsubr(Lisp_Subr * subr)
3851 Lisp_Object sym = intern(subr_name(subr));
3854 check_sane_subr(subr, sym);
3856 XSETSUBR(fun, subr);
3857 XSYMBOL(sym)->function = fun;
3861 /* If it is declared in a module, update the load history */
3863 LOADHIST_ATTACH(sym);
3869 undefsubr(Lisp_Subr *subr)
3871 Lisp_Object sym = intern(subr_name(subr));
3873 check_sane_subr(subr, sym);
3874 XSYMBOL(sym)->function = Qunbound;
3878 /* Define a lisp macro using a Lisp_Subr. */
3879 void defsubr_macro(Lisp_Subr * subr)
3881 Lisp_Object sym = intern(subr_name(subr));
3884 check_sane_subr(subr, sym);
3886 XSETSUBR(fun, subr);
3887 XSYMBOL(sym)->function = Fcons(Qmacro, fun);
3891 deferror_1(Lisp_Object * symbol, char *name, const char *messuhhj,
3892 Lisp_Object inherits_from, int massage_p)
3896 defsymbol_massage_name(symbol, name);
3898 defsymbol(symbol, name);
3900 assert(SYMBOLP(inherits_from));
3901 conds = Fget(inherits_from, Qerror_conditions, Qnil);
3902 Fput(*symbol, Qerror_conditions, Fcons(*symbol, conds));
3903 /* NOT build_translated_string (). This function is called at load time
3904 and the string needs to get translated at run time. (This happens
3905 in the function (display-error) in cmdloop.el.) */
3906 Fput(*symbol, Qerror_message, build_string(messuhhj));
3910 deferror(Lisp_Object *symbol, char *name, const char *messuhhj,
3911 Lisp_Object inherits_from)
3913 deferror_1(symbol, name, messuhhj, inherits_from, 0);
3917 deferror_massage_name(Lisp_Object * symbol, char *name,
3918 const char *messuhhj, Lisp_Object inherits_from)
3920 deferror_1(symbol, name, messuhhj, inherits_from, 1);
3924 deferror_massage_name_and_message(Lisp_Object * symbol, char *name,
3925 Lisp_Object inherits_from)
3929 size_t len = strlen(name) - 1;
3931 assert(len < sizeof(temp));
3933 strncat(temp, name + 1, sizeof(temp)-1); /* Remove initial Q */
3934 temp[0] = toupper(temp[0]);
3935 for (i = 0; i < len; i++)
3939 deferror_1(symbol, name, temp, inherits_from, 1);
3942 void syms_of_symbols(void)
3944 DEFSYMBOL(Qvariable_documentation);
3945 DEFSYMBOL(Qvariable_domain); /* I18N3 */
3946 DEFSYMBOL(Qad_advice_info);
3947 DEFSYMBOL(Qad_activate);
3949 DEFSYMBOL(Qget_value);
3950 DEFSYMBOL(Qset_value);
3951 DEFSYMBOL(Qbound_predicate);
3952 DEFSYMBOL(Qmake_unbound);
3953 DEFSYMBOL(Qlocal_predicate);
3954 DEFSYMBOL(Qmake_local);
3957 DEFSYMBOL(Qglobally_boundp);
3958 DEFSYMBOL(Qmakunbound);
3959 DEFSYMBOL(Qsymbol_value);
3961 DEFSYMBOL(Qsetq_default);
3962 DEFSYMBOL(Qdefault_boundp);
3963 DEFSYMBOL(Qdefault_value);
3964 DEFSYMBOL(Qset_default);
3965 DEFSYMBOL(Qmake_variable_buffer_local);
3966 DEFSYMBOL(Qmake_local_variable);
3967 DEFSYMBOL(Qkill_local_variable);
3968 DEFSYMBOL(Qkill_console_local_variable);
3969 DEFSYMBOL(Qsymbol_value_in_buffer);
3970 DEFSYMBOL(Qsymbol_value_in_console);
3971 DEFSYMBOL(Qlocal_variable_p);
3972 DEFSYMBOL(Qconst_integer);
3973 DEFSYMBOL(Qconst_boolean);
3974 DEFSYMBOL(Qconst_object);
3975 DEFSYMBOL(Qconst_specifier);
3976 DEFSYMBOL(Qdefault_buffer);
3977 DEFSYMBOL(Qcurrent_buffer);
3978 DEFSYMBOL(Qconst_current_buffer);
3979 DEFSYMBOL(Qdefault_console);
3980 DEFSYMBOL(Qselected_console);
3981 DEFSYMBOL(Qconst_selected_console);
3983 DEFSYMBOL(Qsymbol_macro);
3986 DEFSUBR(Fintern_soft);
3989 DEFSUBR(Fapropos_internal);
3991 DEFSUBR(Fsymbol_function);
3992 DEFSUBR(Fsymbol_plist);
3993 DEFSUBR(Fsymbol_name);
3994 DEFSUBR(Fmakunbound);
3995 DEFSUBR(Ffmakunbound);
3997 DEFSUBR(Fglobally_boundp);
4000 DEFSUBR(Fdefine_function);
4001 Ffset(intern("defalias"), intern("define-function"));
4002 DEFSUBR (Fspecial_form_p);
4003 DEFSUBR (Fsubr_name);
4005 DEFSUBR(Fsymbol_value_in_buffer);
4006 DEFSUBR(Fsymbol_value_in_console);
4007 DEFSUBR(Fbuilt_in_variable_type);
4008 DEFSUBR(Fsymbol_value);
4010 DEFSUBR(Fdefault_boundp);
4011 DEFSUBR(Fdefault_value);
4012 DEFSUBR(Fset_default);
4013 DEFSUBR(Fsetq_default);
4014 DEFSUBR(Fmake_variable_buffer_local);
4015 DEFSUBR(Fmake_local_variable);
4016 DEFSUBR(Fkill_local_variable);
4017 DEFSUBR(Fkill_console_local_variable);
4018 DEFSUBR(Flocal_variable_p);
4019 DEFSUBR(Fdefvaralias);
4020 DEFSUBR(Fvariable_alias);
4021 DEFSUBR(Findirect_variable);
4022 DEFSUBR(Fvariable_binding_locus);
4023 DEFSUBR(Fdontusethis_set_symbol_value_handler);
4026 /* Create and initialize a Lisp variable whose value is forwarded to C data */
4028 defvar_magic(char *symbol_name, const struct symbol_value_forward *magic)
4032 #if defined WITH_EMODULES && defined HAVE_EMODULES
4034 * As with defsubr(), this will only be called in a dumped Emacs when
4035 * we are adding variables from a dynamically loaded module. That means
4036 * we can't use purespace. Take that into account.
4039 sym = Fintern(build_string(symbol_name), Qnil);
4042 sym = Fintern(make_string_nocopy((Bufbyte *)symbol_name,
4043 strlen(symbol_name)), Qnil);
4044 XSYMBOL(sym)->value = (Lisp_Object)(const void*)magic;
4048 void vars_of_symbols(void)
4050 DEFVAR_LISP("obarray", &Vobarray /*
4051 Symbol table for use by `intern' and `read'.
4052 It is a vector whose length ought to be prime for best results.
4053 The vector's contents don't make sense if examined from Lisp programs;
4054 to find all the symbols in an obarray, use `mapatoms'.
4056 /* obarray has been initialized long before */