1 /* "intern" and friends -- moved here from lread.c and data.c
2 Copyright (C) 1985-1989, 1992-1994 Free Software Foundation, Inc.
3 Copyright (C) 1995 Ben Wing.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
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 */
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;
79 static Lisp_Object maybe_call_magic_handler (Lisp_Object sym,
82 static Lisp_Object fetch_value_maybe_past_magic (Lisp_Object sym,
83 Lisp_Object follow_past_lisp_magic);
84 static Lisp_Object *value_slot_past_magic (Lisp_Object sym);
85 static Lisp_Object follow_varalias_pointers (Lisp_Object symbol,
86 Lisp_Object follow_past_lisp_magic);
90 mark_symbol (Lisp_Object obj)
92 Lisp_Symbol *sym = XSYMBOL (obj);
95 mark_object (sym->value);
96 mark_object (sym->function);
97 XSETSTRING (pname, sym->name);
99 if (!symbol_next (sym))
103 mark_object (sym->plist);
104 /* Mark the rest of the symbols in the obarray hash-chain */
105 sym = symbol_next (sym);
106 XSETSYMBOL (obj, sym);
111 static const struct lrecord_description symbol_description[] = {
112 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, next) },
113 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, name) },
114 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, value) },
115 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, function) },
116 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, plist) },
120 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
121 mark_symbol, print_symbol, 0, 0, 0,
122 symbol_description, Lisp_Symbol);
125 /**********************************************************************/
127 /**********************************************************************/
129 /* #### using a vector here is way bogus. Use a hash table instead. */
131 Lisp_Object Vobarray;
133 static Lisp_Object initial_obarray;
135 /* oblookup stores the bucket number here, for the sake of Funintern. */
137 static int oblookup_last_bucket_number;
140 check_obarray (Lisp_Object obarray)
142 while (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
144 /* If Vobarray is now invalid, force it to be valid. */
145 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
147 obarray = wrong_type_argument (Qvectorp, obarray);
153 intern (CONST char *str)
155 Bytecount len = strlen (str);
156 CONST Bufbyte *buf = (CONST Bufbyte *) str;
157 Lisp_Object obarray = Vobarray;
159 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
160 obarray = check_obarray (obarray);
163 Lisp_Object tem = oblookup (obarray, buf, len);
168 return Fintern (make_string (buf, len), obarray);
171 DEFUN ("intern", Fintern, 1, 2, 0, /*
172 Return the canonical symbol whose name is STRING.
173 If there is none, one is created by this function and returned.
174 A second optional argument specifies the obarray to use;
175 it defaults to the value of `obarray'.
179 Lisp_Object object, *ptr;
183 if (NILP (obarray)) obarray = Vobarray;
184 obarray = check_obarray (obarray);
186 CHECK_STRING (string);
188 len = XSTRING_LENGTH (string);
189 object = oblookup (obarray, XSTRING_DATA (string), len);
194 ptr = &XVECTOR_DATA (obarray)[XINT (object)];
196 object = Fmake_symbol (string);
197 symbol = XSYMBOL (object);
200 symbol_next (symbol) = XSYMBOL (*ptr);
202 symbol_next (symbol) = 0;
205 if (string_byte (symbol_name (symbol), 0) == ':' && EQ (obarray, Vobarray))
207 /* The LISP way is to put keywords in their own package, but we
208 don't have packages, so we do something simpler. Someday,
209 maybe we'll have packages and then this will be reworked.
211 symbol_value (symbol) = object;
217 DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /*
218 Return the canonical symbol named NAME, or nil if none exists.
219 NAME may be a string or a symbol. If it is a symbol, that exact
220 symbol is searched for.
221 A second optional argument specifies the obarray to use;
222 it defaults to the value of `obarray'.
226 /* #### Bug! (intern-soft "nil") returns nil. Perhaps we should
227 add a DEFAULT-IF-NOT-FOUND arg, like in get. */
231 if (NILP (obarray)) obarray = Vobarray;
232 obarray = check_obarray (obarray);
237 string = XSTRING (name);
240 string = symbol_name (XSYMBOL (name));
242 tem = oblookup (obarray, string_data (string), string_length (string));
243 if (INTP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
249 DEFUN ("unintern", Funintern, 1, 2, 0, /*
250 Delete the symbol named NAME, if any, from OBARRAY.
251 The value is t if a symbol was found and deleted, nil otherwise.
252 NAME may be a string or a symbol. If it is a symbol, that symbol
253 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
254 OBARRAY defaults to the value of the variable `obarray'
262 if (NILP (obarray)) obarray = Vobarray;
263 obarray = check_obarray (obarray);
266 string = symbol_name (XSYMBOL (name));
270 string = XSTRING (name);
273 tem = oblookup (obarray, string_data (string), string_length (string));
276 /* If arg was a symbol, don't delete anything but that symbol itself. */
277 if (SYMBOLP (name) && !EQ (name, tem))
280 hash = oblookup_last_bucket_number;
282 if (EQ (XVECTOR_DATA (obarray)[hash], tem))
284 if (XSYMBOL (tem)->next)
285 XSETSYMBOL (XVECTOR_DATA (obarray)[hash], XSYMBOL (tem)->next);
287 XVECTOR_DATA (obarray)[hash] = Qzero;
291 Lisp_Object tail, following;
293 for (tail = XVECTOR_DATA (obarray)[hash];
294 XSYMBOL (tail)->next;
297 XSETSYMBOL (following, XSYMBOL (tail)->next);
298 if (EQ (following, tem))
300 XSYMBOL (tail)->next = XSYMBOL (following)->next;
308 /* Return the symbol in OBARRAY whose names matches the string
309 of SIZE characters at PTR. If there is no such symbol in OBARRAY,
310 return the index into OBARRAY that the string hashes to.
312 Also store the bucket number in oblookup_last_bucket_number. */
315 oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size)
321 if (!VECTORP (obarray) ||
322 (obsize = XVECTOR_LENGTH (obarray)) == 0)
324 obarray = check_obarray (obarray);
325 obsize = XVECTOR_LENGTH (obarray);
327 hash = hash_string (ptr, size) % obsize;
328 oblookup_last_bucket_number = hash;
329 bucket = XVECTOR_DATA (obarray)[hash];
332 else if (!SYMBOLP (bucket))
333 error ("Bad data in guts of obarray"); /* Like CADR error message */
335 for (tail = XSYMBOL (bucket); ;)
337 if (string_length (tail->name) == size &&
338 !memcmp (string_data (tail->name), ptr, size))
340 XSETSYMBOL (bucket, tail);
343 tail = symbol_next (tail);
347 return make_int (hash);
350 #if 0 /* Emacs 19.34 */
352 hash_string (CONST Bufbyte *ptr, Bytecount len)
354 CONST Bufbyte *p = ptr;
355 CONST Bufbyte *end = p + len;
362 if (c >= 0140) c -= 40;
363 hash = ((hash<<3) + (hash>>28) + c);
365 return hash & 07777777777;
369 /* derived from hashpjw, Dragon Book P436. */
371 hash_string (CONST Bufbyte *ptr, Bytecount len)
378 hash = (hash << 4) + *ptr++;
379 g = hash & 0xf0000000;
381 hash = (hash ^ (g >> 24)) ^ g;
383 return hash & 07777777777;
386 /* Map FN over OBARRAY. The mapping is stopped when FN returns a
389 map_obarray (Lisp_Object obarray,
390 int (*fn) (Lisp_Object, void *), void *arg)
394 CHECK_VECTOR (obarray);
395 for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--)
397 Lisp_Object tail = XVECTOR_DATA (obarray)[i];
402 if ((*fn) (tail, arg))
404 next = symbol_next (XSYMBOL (tail));
407 XSETSYMBOL (tail, next);
413 mapatoms_1 (Lisp_Object sym, void *arg)
415 call1 (*(Lisp_Object *)arg, sym);
419 DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /*
420 Call FUNCTION on every symbol in OBARRAY.
421 OBARRAY defaults to the value of `obarray'.
427 obarray = check_obarray (obarray);
429 map_obarray (obarray, mapatoms_1, &function);
434 /**********************************************************************/
436 /**********************************************************************/
438 struct appropos_mapper_closure
441 Lisp_Object predicate;
442 Lisp_Object accumulation;
446 apropos_mapper (Lisp_Object symbol, void *arg)
448 struct appropos_mapper_closure *closure =
449 (struct appropos_mapper_closure *) arg;
450 Bytecount match = fast_lisp_string_match (closure->regexp,
451 Fsymbol_name (symbol));
454 (NILP (closure->predicate) ||
455 !NILP (call1 (closure->predicate, symbol))))
456 closure->accumulation = Fcons (symbol, closure->accumulation);
461 DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /*
462 Show all symbols whose names contain match for REGEXP.
463 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL)
464 is done for each symbol and a symbol is mentioned only if that
466 Return list of symbols found.
470 struct appropos_mapper_closure closure;
472 CHECK_STRING (regexp);
474 closure.regexp = regexp;
475 closure.predicate = predicate;
476 closure.accumulation = Qnil;
477 map_obarray (Vobarray, apropos_mapper, &closure);
478 closure.accumulation = Fsort (closure.accumulation, Qstring_lessp);
479 return closure.accumulation;
483 /* Extract and set components of symbols */
485 static void set_up_buffer_local_cache (Lisp_Object sym,
486 struct symbol_value_buffer_local *bfwd,
488 Lisp_Object new_alist_el,
491 DEFUN ("boundp", Fboundp, 1, 1, 0, /*
492 Return t if SYMBOL's value is not void.
496 CHECK_SYMBOL (symbol);
497 return UNBOUNDP (find_symbol_value (symbol)) ? Qnil : Qt;
500 DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /*
501 Return t if SYMBOL has a global (non-bound) value.
502 This is for the byte-compiler; you really shouldn't be using this.
506 CHECK_SYMBOL (symbol);
507 return UNBOUNDP (top_level_value (symbol)) ? Qnil : Qt;
510 DEFUN ("fboundp", Ffboundp, 1, 1, 0, /*
511 Return t if SYMBOL's function definition is not void.
515 CHECK_SYMBOL (symbol);
516 return UNBOUNDP (XSYMBOL (symbol)->function) ? Qnil : Qt;
519 /* Return non-zero if SYM's value or function (the current contents of
520 which should be passed in as VAL) is constant, i.e. unsettable. */
523 symbol_is_constant (Lisp_Object sym, Lisp_Object val)
525 /* #### - I wonder if it would be better to just have a new magic value
526 type and make nil, t, and all keywords have that same magic
527 constant_symbol value. This test is awfully specific about what is
528 constant and what isn't. --Stig */
529 if (EQ (sym, Qnil) ||
533 if (SYMBOL_VALUE_MAGIC_P (val))
534 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
536 case SYMVAL_CONST_OBJECT_FORWARD:
537 case SYMVAL_CONST_SPECIFIER_FORWARD:
538 case SYMVAL_CONST_FIXNUM_FORWARD:
539 case SYMVAL_CONST_BOOLEAN_FORWARD:
540 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
541 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
543 default: break; /* Warning suppression */
546 /* We don't return true for keywords here because they are handled
547 specially by reject_constant_symbols(). */
551 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
552 non-zero) to NEWVAL. Make sure this is allowed.
553 FOLLOW_PAST_LISP_MAGIC specifies whether we delve past
554 symbol-value-lisp-magic objects. */
557 reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p,
558 Lisp_Object follow_past_lisp_magic)
561 (function_p ? XSYMBOL (sym)->function
562 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
564 if (SYMBOL_VALUE_MAGIC_P (val) &&
565 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
566 signal_simple_error ("Use `set-specifier' to change a specifier's value",
569 if (symbol_is_constant (sym, val)
570 || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)))
571 signal_error (Qsetting_constant,
572 UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
575 /* Verify that it's ok to make SYM buffer-local. This rejects
576 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC
577 specifies whether we delve into symbol-value-lisp-magic objects.
578 (Should be a symbol indicating what action is being taken; that way,
579 we don't delve if there's a handler for that action, but do otherwise.) */
582 verify_ok_for_buffer_local (Lisp_Object sym,
583 Lisp_Object follow_past_lisp_magic)
585 Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic);
587 if (symbol_is_constant (sym, val))
589 if (SYMBOL_VALUE_MAGIC_P (val))
590 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
592 case SYMVAL_DEFAULT_BUFFER_FORWARD:
593 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
594 /* #### It's theoretically possible for it to be reasonable
595 to have both console-local and buffer-local variables,
596 but I don't want to consider that right now. */
597 case SYMVAL_SELECTED_CONSOLE_FORWARD:
599 default: break; /* Warning suppression */
605 signal_error (Qerror,
606 list2 (build_string ("Symbol may not be buffer-local"), sym));
609 DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /*
610 Make SYMBOL's value be void.
614 Fset (symbol, Qunbound);
618 DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /*
619 Make SYMBOL's function definition be void.
623 CHECK_SYMBOL (symbol);
624 reject_constant_symbols (symbol, Qunbound, 1, Qt);
625 XSYMBOL (symbol)->function = Qunbound;
629 DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /*
630 Return SYMBOL's function definition. Error if that is void.
634 CHECK_SYMBOL (symbol);
635 if (UNBOUNDP (XSYMBOL (symbol)->function))
636 signal_void_function_error (symbol);
637 return XSYMBOL (symbol)->function;
640 DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /*
641 Return SYMBOL's property list.
645 CHECK_SYMBOL (symbol);
646 return XSYMBOL (symbol)->plist;
649 DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /*
650 Return SYMBOL's name, a string.
656 CHECK_SYMBOL (symbol);
657 XSETSTRING (name, XSYMBOL (symbol)->name);
661 DEFUN ("fset", Ffset, 2, 2, 0, /*
662 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
666 /* This function can GC */
667 CHECK_SYMBOL (symbol);
668 reject_constant_symbols (symbol, newdef, 1, Qt);
669 if (!NILP (Vautoload_queue) && !UNBOUNDP (XSYMBOL (symbol)->function))
670 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
672 XSYMBOL (symbol)->function = newdef;
673 /* Handle automatic advice activation */
674 if (CONSP (XSYMBOL (symbol)->plist) &&
675 !NILP (Fget (symbol, Qad_advice_info, Qnil)))
677 call2 (Qad_activate, symbol, Qnil);
678 newdef = XSYMBOL (symbol)->function;
684 DEFUN ("define-function", Fdefine_function, 2, 2, 0, /*
685 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
686 Associates the function with the current load file, if any.
690 /* This function can GC */
691 Ffset (symbol, newdef);
692 LOADHIST_ATTACH (symbol);
697 DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
698 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
702 CHECK_SYMBOL (symbol);
703 #if 0 /* Inserted for debugging 6/28/1997 -slb */
704 /* Somebody is setting a property list of integer 0, who? */
705 /* Not this way apparently. */
706 if (EQ(newplist, Qzero)) abort();
709 XSYMBOL (symbol)->plist = newplist;
714 /**********************************************************************/
716 /**********************************************************************/
718 /* If the contents of the value cell of a symbol is one of the following
719 three types of objects, then the symbol is "magic" in that setting
720 and retrieving its value doesn't just set or retrieve the raw
721 contents of the value cell. None of these objects can escape to
722 the user level, so there is no loss of generality.
724 If a symbol is "unbound", then the contents of its value cell is
725 Qunbound. Despite appearances, this is *not* a symbol, but is a
726 symbol-value-forward object. This is so that printing it results
727 in "INTERNAL OBJECT (XEmacs bug?)", in case it leaks to Lisp, somehow.
729 Logically all of the following objects are "symbol-value-magic"
730 objects, and there are some games played w.r.t. this (#### this
731 should be cleaned up). SYMBOL_VALUE_MAGIC_P is true for all of
732 the object types. XSYMBOL_VALUE_MAGIC_TYPE returns the type of
733 symbol-value-magic object. There are more than three types
734 returned by this macro: in particular, symbol-value-forward
735 has eight subtypes, and symbol-value-buffer-local has two. See
738 1. symbol-value-forward
740 symbol-value-forward is used for variables whose actual contents
741 are stored in a C variable of some sort, and for Qunbound. The
742 lcheader.next field (which is only used to chain together free
743 lcrecords) holds a pointer to the actual C variable. Included
744 in this type are "buffer-local" variables that are actually
745 stored in the buffer object itself; in this case, the "pointer"
746 is an offset into the struct buffer structure.
748 The subtypes are as follows:
750 SYMVAL_OBJECT_FORWARD:
751 (declare with DEFVAR_LISP)
752 The value of this variable is stored in a C variable of type
753 "Lisp_Object". Setting this variable sets the C variable.
754 Accessing this variable retrieves a value from the C variable.
755 These variables can be buffer-local -- in this case, the
756 raw symbol-value field gets converted into a
757 symbol-value-buffer-local, whose "current_value" slot contains
758 the symbol-value-forward. (See below.)
760 SYMVAL_FIXNUM_FORWARD:
761 SYMVAL_BOOLEAN_FORWARD:
762 (declare with DEFVAR_INT or DEFVAR_BOOL)
763 Similar to SYMVAL_OBJECT_FORWARD except that the C variable
764 is of type "int" and is an integer or boolean, respectively.
766 SYMVAL_CONST_OBJECT_FORWARD:
767 SYMVAL_CONST_FIXNUM_FORWARD:
768 SYMVAL_CONST_BOOLEAN_FORWARD:
769 (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
771 Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
772 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
775 SYMVAL_CONST_SPECIFIER_FORWARD:
776 (declare with DEFVAR_SPECIFIER)
777 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that the error
778 message you get when attempting to set the value says to use
779 `set-specifier' instead.
781 SYMVAL_CURRENT_BUFFER_FORWARD:
782 (declare with DEFVAR_BUFFER_LOCAL)
783 This is used for built-in buffer-local variables -- i.e.
784 Lisp variables whose value is stored in the "struct buffer".
785 Variables of this sort always forward into C "Lisp_Object"
786 fields (although there's no reason in principle that other
787 types for ints and booleans couldn't be added). Note that
788 some of these variables are automatically local in each
789 buffer, while some are only local when they become set
790 (similar to `make-variable-buffer-local'). In these latter
791 cases, of course, the default value shows through in all
792 buffers in which the variable doesn't have a local value.
793 This is implemented by making sure the "struct buffer" field
794 always contains the correct value (whether it's local or
795 a default) and maintaining a mask in the "struct buffer"
796 indicating which fields are local. When `set-default' is
797 called on a variable that's not always local to all buffers,
798 it loops through each buffer and sets the corresponding
799 field in each buffer without a local value for the field,
800 according to the mask.
802 Calling `make-local-variable' on a variable of this sort
803 only has the effect of maybe changing the current buffer's mask.
804 Calling `make-variable-buffer-local' on a variable of this
805 sort has no effect at all.
807 SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
808 (declare with DEFVAR_CONST_BUFFER_LOCAL)
809 Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
812 SYMVAL_DEFAULT_BUFFER_FORWARD:
813 (declare with DEFVAR_BUFFER_DEFAULTS)
814 This is used for the Lisp variables that contain the
815 default values of built-in buffer-local variables. Setting
816 or referencing one of these variables forwards into a slot
817 in the special struct buffer Vbuffer_defaults.
819 SYMVAL_UNBOUND_MARKER:
820 This is used for only one object, Qunbound.
822 SYMVAL_SELECTED_CONSOLE_FORWARD:
823 (declare with DEFVAR_CONSOLE_LOCAL)
824 This is used for built-in console-local variables -- i.e.
825 Lisp variables whose value is stored in the "struct console".
826 These work just like built-in buffer-local variables.
827 However, calling `make-local-variable' or
828 `make-variable-buffer-local' on one of these variables
829 is currently disallowed because that would entail having
830 both console-local and buffer-local variables, which is
831 trickier to implement.
833 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
834 (declare with DEFVAR_CONST_CONSOLE_LOCAL)
835 Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
838 SYMVAL_DEFAULT_CONSOLE_FORWARD:
839 (declare with DEFVAR_CONSOLE_DEFAULTS)
840 This is used for the Lisp variables that contain the
841 default values of built-in console-local variables. Setting
842 or referencing one of these variables forwards into a slot
843 in the special struct console Vconsole_defaults.
846 2. symbol-value-buffer-local
848 symbol-value-buffer-local is used for variables that have had
849 `make-local-variable' or `make-variable-buffer-local' applied
850 to them. This object contains an alist mapping buffers to
851 values. In addition, the object contains a "current value",
852 which is the value in some buffer. Whenever you access the
853 variable with `symbol-value' or set it with `set' or `setq',
854 things are switched around so that the "current value"
855 refers to the current buffer, if it wasn't already. This
856 way, repeated references to a variable in the same buffer
857 are almost as efficient as if the variable weren't buffer
858 local. Note that the alist may not be up-to-date w.r.t.
859 the buffer whose value is current, as the "current value"
860 cache is normally only flushed into the alist when the
861 buffer it refers to changes.
863 Note also that it is possible for `make-local-variable'
864 or `make-variable-buffer-local' to be called on a variable
865 that forwards into a C variable (i.e. a variable whose
866 value cell is a symbol-value-forward). In this case,
867 the value cell becomes a symbol-value-buffer-local (as
868 always), and the symbol-value-forward moves into
869 the "current value" cell in this object. Also, in
870 this case the "current value" *always* refers to the
871 current buffer, so that the values of the C variable
872 always is the correct value for the current buffer.
873 set_buffer_internal() automatically updates the current-value
874 cells of all buffer-local variables that forward into C
875 variables. (There is a list of all buffer-local variables
876 that is maintained for this and other purposes.)
878 Note that only certain types of `symbol-value-forward' objects
879 can find their way into the "current value" cell of a
880 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
881 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
882 SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot
883 be buffer-local because they are unsettable;
884 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
885 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
886 does not have much of an effect (it's already buffer-local); and
887 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
888 that's not currently implemented.
891 3. symbol-value-varalias
893 A symbol-value-varalias object is used for variables that
894 are aliases for other variables. This object contains
895 the symbol that this variable is aliased to.
896 symbol-value-varalias objects cannot occur anywhere within
897 a symbol-value-buffer-local object, and most of the
898 low-level functions below do not accept them; you need
899 to call follow_varalias_pointers to get the actual
900 symbol to operate on. */
903 mark_symbol_value_buffer_local (Lisp_Object obj)
905 struct symbol_value_buffer_local *bfwd;
907 #ifdef ERROR_CHECK_TYPECHECK
908 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
909 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
912 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
913 mark_object (bfwd->default_value);
914 mark_object (bfwd->current_value);
915 mark_object (bfwd->current_buffer);
916 return bfwd->current_alist_element;
920 mark_symbol_value_lisp_magic (Lisp_Object obj)
922 struct symbol_value_lisp_magic *bfwd;
925 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
927 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
928 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
930 mark_object (bfwd->handler[i]);
931 mark_object (bfwd->harg[i]);
933 return bfwd->shadowed;
937 mark_symbol_value_varalias (Lisp_Object obj)
939 struct symbol_value_varalias *bfwd;
941 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
943 bfwd = XSYMBOL_VALUE_VARALIAS (obj);
944 mark_object (bfwd->shadowed);
945 return bfwd->aliasee;
948 /* Should never, ever be called. (except by an external debugger) */
950 print_symbol_value_magic (Lisp_Object obj,
951 Lisp_Object printcharfun, int escapeflag)
954 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s type %d) 0x%lx>",
955 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
956 XSYMBOL_VALUE_MAGIC_TYPE (obj),
958 write_c_string (buf, printcharfun);
961 static const struct lrecord_description symbol_value_forward_description[] = {
965 static const struct lrecord_description symbol_value_buffer_local_description[] = {
966 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, default_value) },
967 { XD_LO_RESET_NIL, offsetof (struct symbol_value_buffer_local, current_value), 3 },
971 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
972 { XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 },
976 static const struct lrecord_description symbol_value_varalias_description[] = {
977 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, aliasee) },
978 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, shadowed) },
982 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
983 symbol_value_forward,
984 this_one_is_unmarkable,
985 print_symbol_value_magic, 0, 0, 0,
986 symbol_value_forward_description,
987 struct symbol_value_forward);
989 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
990 symbol_value_buffer_local,
991 mark_symbol_value_buffer_local,
992 print_symbol_value_magic, 0, 0, 0,
993 symbol_value_buffer_local_description,
994 struct symbol_value_buffer_local);
996 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
997 symbol_value_lisp_magic,
998 mark_symbol_value_lisp_magic,
999 print_symbol_value_magic, 0, 0, 0,
1000 symbol_value_lisp_magic_description,
1001 struct symbol_value_lisp_magic);
1003 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
1004 symbol_value_varalias,
1005 mark_symbol_value_varalias,
1006 print_symbol_value_magic, 0, 0, 0,
1007 symbol_value_varalias_description,
1008 struct symbol_value_varalias);
1011 /* Getting and setting values of symbols */
1013 /* Given the raw contents of a symbol value cell, return the Lisp value of
1014 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
1015 symbol-value-lisp-magic, or symbol-value-varalias.
1017 BUFFER specifies a buffer, and is used for built-in buffer-local
1018 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
1019 Note that such variables are never encapsulated in a
1020 symbol-value-buffer-local structure.
1022 CONSOLE specifies a console, and is used for built-in console-local
1023 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
1024 Note that such variables are (currently) never encapsulated in a
1025 symbol-value-buffer-local structure.
1029 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
1030 struct console *console)
1032 CONST struct symbol_value_forward *fwd;
1034 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1037 fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1038 switch (fwd->magic.type)
1040 case SYMVAL_FIXNUM_FORWARD:
1041 case SYMVAL_CONST_FIXNUM_FORWARD:
1042 return make_int (*((int *)symbol_value_forward_forward (fwd)));
1044 case SYMVAL_BOOLEAN_FORWARD:
1045 case SYMVAL_CONST_BOOLEAN_FORWARD:
1046 return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
1048 case SYMVAL_OBJECT_FORWARD:
1049 case SYMVAL_CONST_OBJECT_FORWARD:
1050 case SYMVAL_CONST_SPECIFIER_FORWARD:
1051 return *((Lisp_Object *)symbol_value_forward_forward (fwd));
1053 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1054 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1055 + ((char *)symbol_value_forward_forward (fwd)
1056 - (char *)&buffer_local_flags))));
1059 case SYMVAL_CURRENT_BUFFER_FORWARD:
1060 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1062 return (*((Lisp_Object *)((char *)buffer
1063 + ((char *)symbol_value_forward_forward (fwd)
1064 - (char *)&buffer_local_flags))));
1066 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1067 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1068 + ((char *)symbol_value_forward_forward (fwd)
1069 - (char *)&console_local_flags))));
1071 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1072 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1074 return (*((Lisp_Object *)((char *)console
1075 + ((char *)symbol_value_forward_forward (fwd)
1076 - (char *)&console_local_flags))));
1078 case SYMVAL_UNBOUND_MARKER:
1084 return Qnil; /* suppress compiler warning */
1087 /* Set the value of default-buffer-local variable SYM to VALUE. */
1090 set_default_buffer_slot_variable (Lisp_Object sym,
1093 /* Handle variables like case-fold-search that have special slots in
1094 the buffer. Make them work apparently like buffer_local variables.
1096 /* At this point, the value cell may not contain a symbol-value-varalias
1097 or symbol-value-buffer-local, and if there's a handler, we should
1098 have already called it. */
1099 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1100 CONST struct symbol_value_forward *fwd
1101 = XSYMBOL_VALUE_FORWARD (valcontents);
1102 int offset = ((char *) symbol_value_forward_forward (fwd)
1103 - (char *) &buffer_local_flags);
1104 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1105 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1106 int flags) = symbol_value_forward_magicfun (fwd);
1108 *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
1111 if (mask > 0) /* Not always per-buffer */
1115 /* Set value in each buffer which hasn't shadowed the default */
1116 LIST_LOOP_2 (elt, Vbuffer_alist)
1118 struct buffer *b = XBUFFER (XCDR (elt));
1119 if (!(b->local_var_flags & mask))
1122 magicfun (sym, &value, make_buffer (b), 0);
1123 *((Lisp_Object *) (offset + (char *) b)) = value;
1129 /* Set the value of default-console-local variable SYM to VALUE. */
1132 set_default_console_slot_variable (Lisp_Object sym,
1135 /* Handle variables like case-fold-search that have special slots in
1136 the console. Make them work apparently like console_local variables.
1138 /* At this point, the value cell may not contain a symbol-value-varalias
1139 or symbol-value-buffer-local, and if there's a handler, we should
1140 have already called it. */
1141 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1142 CONST struct symbol_value_forward *fwd
1143 = XSYMBOL_VALUE_FORWARD (valcontents);
1144 int offset = ((char *) symbol_value_forward_forward (fwd)
1145 - (char *) &console_local_flags);
1146 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1147 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1148 int flags) = symbol_value_forward_magicfun (fwd);
1150 *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
1153 if (mask > 0) /* Not always per-console */
1155 Lisp_Object console;
1157 /* Set value in each console which hasn't shadowed the default */
1158 LIST_LOOP_2 (console, Vconsole_list)
1160 struct console *d = XCONSOLE (console);
1161 if (!(d->local_var_flags & mask))
1164 magicfun (sym, &value, console, 0);
1165 *((Lisp_Object *) (offset + (char *) d)) = value;
1171 /* Store NEWVAL into SYM.
1173 SYM's value slot may *not* be types (5) or (6) above,
1174 i.e. no symbol-value-varalias objects. (You should have
1175 forwarded past all of these.)
1177 SYM should not be an unsettable symbol or a symbol with
1178 a magic `set-value' handler (unless you want to explicitly
1179 ignore this handler).
1181 OVALUE is the current value of SYM, but forwarded past any
1182 symbol-value-buffer-local and symbol-value-lisp-magic objects.
1183 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1184 the contents of its current-value cell.) NEWVAL may only be
1185 a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
1186 this function will only modify its current-value cell, which should
1187 already be set up to point to the current buffer.
1191 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
1194 if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
1196 Lisp_Object *store_pointer = value_slot_past_magic (sym);
1198 if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
1200 &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
1202 assert (UNBOUNDP (*store_pointer)
1203 || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1204 *store_pointer = newval;
1208 CONST struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue);
1209 int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
1210 Lisp_Object in_object, int flags)
1211 = symbol_value_forward_magicfun (fwd);
1213 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue))
1215 case SYMVAL_FIXNUM_FORWARD:
1218 magicfun (sym, &newval, Qnil, 0);
1219 *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
1222 case SYMVAL_BOOLEAN_FORWARD:
1224 magicfun (sym, &newval, Qnil, 0);
1225 *((int *) symbol_value_forward_forward (fwd))
1229 case SYMVAL_OBJECT_FORWARD:
1231 magicfun (sym, &newval, Qnil, 0);
1232 *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
1235 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1236 set_default_buffer_slot_variable (sym, newval);
1239 case SYMVAL_CURRENT_BUFFER_FORWARD:
1241 magicfun (sym, &newval, make_buffer (current_buffer), 0);
1242 *((Lisp_Object *) ((char *) current_buffer
1243 + ((char *) symbol_value_forward_forward (fwd)
1244 - (char *) &buffer_local_flags)))
1248 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1249 set_default_console_slot_variable (sym, newval);
1252 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1254 magicfun (sym, &newval, Vselected_console, 0);
1255 *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console)
1256 + ((char *) symbol_value_forward_forward (fwd)
1257 - (char *) &console_local_flags)))
1267 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1268 BFWD, locate and return a pointer to the element in BUFFER's
1269 local_var_alist for SYMBOL. The return value will be Qnil if
1270 BUFFER does not have its own value for SYMBOL (i.e. the default
1271 value is seen in that buffer).
1275 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
1276 struct symbol_value_buffer_local *bfwd)
1278 if (!NILP (bfwd->current_buffer) &&
1279 XBUFFER (bfwd->current_buffer) == buffer)
1280 /* This is just an optimization of the below. */
1281 return bfwd->current_alist_element;
1283 return assq_no_quit (symbol, buffer->local_var_alist);
1286 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1287 symbol-value-buffer-local of a per-buffer variable -- i.e. the
1288 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1289 slot -- may be out of date.]
1291 Write out any cached value in buffer-local variable SYMBOL's
1292 buffer-local structure, which is passed in as BFWD.
1296 write_out_buffer_local_cache (Lisp_Object symbol,
1297 struct symbol_value_buffer_local *bfwd)
1299 if (!NILP (bfwd->current_buffer))
1301 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1302 uses it, and that type cannot be inside a symbol-value-buffer-local */
1303 Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0);
1304 if (NILP (bfwd->current_alist_element))
1305 /* current_value may be updated more recently than default_value */
1306 bfwd->default_value = cval;
1308 Fsetcdr (bfwd->current_alist_element, cval);
1312 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1313 Set up BFWD's cache for validity in buffer BUF. This assumes that
1314 the cache is currently in a consistent state (this can include
1315 not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1317 If the cache is already set up for BUF, this function does nothing
1320 Otherwise, if SYM forwards out to a C variable, this also forwards
1321 SYM's value in BUF out to the variable. Therefore, you generally
1322 only want to call this when BUF is, or is about to become, the
1325 (Otherwise, you can just retrieve the value without changing the
1326 cache, at the expense of slower retrieval.)
1330 set_up_buffer_local_cache (Lisp_Object sym,
1331 struct symbol_value_buffer_local *bfwd,
1333 Lisp_Object new_alist_el,
1336 Lisp_Object new_val;
1338 if (!NILP (bfwd->current_buffer)
1339 && buf == XBUFFER (bfwd->current_buffer))
1340 /* Cache is already set up. */
1343 /* Flush out the old cache. */
1344 write_out_buffer_local_cache (sym, bfwd);
1346 /* Retrieve the new alist element and new value. */
1347 if (NILP (new_alist_el)
1349 new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1351 if (NILP (new_alist_el))
1352 new_val = bfwd->default_value;
1354 new_val = Fcdr (new_alist_el);
1356 bfwd->current_alist_element = new_alist_el;
1357 XSETBUFFER (bfwd->current_buffer, buf);
1359 /* Now store the value into the current-value slot.
1360 We don't simply write it there, because the current-value
1361 slot might be a forwarding pointer, in which case we need
1362 to instead write the value into the C variable.
1364 We might also want to call a magic function.
1366 So instead, we call this function. */
1367 store_symval_forwarding (sym, bfwd->current_value, new_val);
1372 kill_buffer_local_variables (struct buffer *buf)
1374 Lisp_Object prev = Qnil;
1377 /* Any which are supposed to be permanent,
1378 make local again, with the same values they had. */
1380 for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
1382 Lisp_Object sym = XCAR (XCAR (alist));
1383 struct symbol_value_buffer_local *bfwd;
1384 /* Variables with a symbol-value-varalias should not be here
1385 (we should have forwarded past them) and there must be a
1386 symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
1387 just forward past it; if the variable has a handler, it was
1389 Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
1391 assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
1392 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
1394 if (!NILP (Fget (sym, Qpermanent_local, Qnil)))
1395 /* prev points to the last alist element that is still
1396 staying around, so *only* update it now. This didn't
1397 used to be the case; this bug has been around since
1398 mly's rewrite two years ago! */
1402 /* Really truly kill it. */
1404 XCDR (prev) = XCDR (alist);
1406 buf->local_var_alist = XCDR (alist);
1408 /* We just effectively changed the value for this variable
1411 /* (1) If the cache is caching BUF, invalidate the cache. */
1412 if (!NILP (bfwd->current_buffer) &&
1413 buf == XBUFFER (bfwd->current_buffer))
1414 bfwd->current_buffer = Qnil;
1416 /* (2) If we changed the value in current_buffer and this
1417 variable forwards to a C variable, we need to change the
1418 value of the C variable. set_up_buffer_local_cache()
1419 will do this. It doesn't hurt to do it whenever
1420 BUF == current_buffer, so just go ahead and do that. */
1421 if (buf == current_buffer)
1422 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
1428 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1429 struct console *con, int swap_it_in,
1430 Lisp_Object symcons, int set_it_p)
1432 Lisp_Object valcontents;
1435 valcontents = XSYMBOL (sym)->value;
1438 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1441 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1443 case SYMVAL_LISP_MAGIC:
1445 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1449 case SYMVAL_VARALIAS:
1450 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1452 /* presto change-o! */
1455 case SYMVAL_BUFFER_LOCAL:
1456 case SYMVAL_SOME_BUFFER_LOCAL:
1458 struct symbol_value_buffer_local *bfwd
1459 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1463 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1464 valcontents = bfwd->current_value;
1468 if (!NILP (bfwd->current_buffer) &&
1469 buf == XBUFFER (bfwd->current_buffer))
1470 valcontents = bfwd->current_value;
1471 else if (NILP (symcons))
1474 valcontents = assq_no_quit (sym, buf->local_var_alist);
1475 if (NILP (valcontents))
1476 valcontents = bfwd->default_value;
1478 valcontents = XCDR (valcontents);
1481 valcontents = XCDR (symcons);
1489 return do_symval_forwarding (valcontents, buf, con);
1493 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1494 bound. Note that it must not be possible to QUIT within this
1498 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
1505 buf = current_buffer;
1508 CHECK_BUFFER (buffer);
1509 buf = XBUFFER (buffer);
1512 return find_symbol_value_1 (sym, buf,
1513 /* If it bombs out at startup due to a
1514 Lisp error, this may be nil. */
1515 CONSOLEP (Vselected_console)
1516 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
1520 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1525 console = Vselected_console;
1527 CHECK_CONSOLE (console);
1529 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1533 /* Return the current value of SYM. The difference between this function
1534 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1535 this updates the CURRENT_VALUE slot of buffer-local variables to
1536 point to the current buffer, while symbol_value_in_buffer doesn't. */
1539 find_symbol_value (Lisp_Object sym)
1541 /* WARNING: This function can be called when current_buffer is 0
1542 and Vselected_console is Qnil, early in initialization. */
1543 struct console *con;
1544 Lisp_Object valcontents;
1548 valcontents = XSYMBOL (sym)->value;
1549 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1552 if (CONSOLEP (Vselected_console))
1553 con = XCONSOLE (Vselected_console);
1556 /* This can also get called while we're preparing to shutdown.
1557 #### What should really happen in that case? Should we
1558 actually fix things so we can't get here in that case? */
1560 assert (!initialized || preparing_for_armageddon);
1565 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
1568 /* This is an optimized function for quick lookup of buffer local symbols
1569 by avoiding O(n) search. This will work when either:
1570 a) We have already found the symbol e.g. by traversing local_var_alist.
1572 b) We know that the symbol will not be found in the current buffer's
1573 list of local variables.
1574 In the former case, find_it_p is 1 and symbol_cons is the element from
1575 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1578 This function is called from set_buffer_internal which does both of these
1582 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1584 /* WARNING: This function can be called when current_buffer is 0
1585 and Vselected_console is Qnil, early in initialization. */
1586 struct console *con;
1587 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1590 if (CONSOLEP (Vselected_console))
1591 con = XCONSOLE (Vselected_console);
1594 /* This can also get called while we're preparing to shutdown.
1595 #### What should really happen in that case? Should we
1596 actually fix things so we can't get here in that case? */
1598 assert (!initialized || preparing_for_armageddon);
1603 return find_symbol_value_1 (sym, current_buffer, con, 1,
1604 find_it_p ? symbol_cons : Qnil,
1608 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1609 Return SYMBOL's value. Error if that is void.
1613 Lisp_Object val = find_symbol_value (symbol);
1616 return Fsignal (Qvoid_variable, list1 (symbol));
1621 DEFUN ("set", Fset, 2, 2, 0, /*
1622 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1626 REGISTER Lisp_Object valcontents;
1628 /* remember, we're called by Fmakunbound() as well */
1630 CHECK_SYMBOL (symbol);
1633 sym = XSYMBOL (symbol);
1634 valcontents = sym->value;
1636 if (EQ (symbol, Qnil) ||
1638 SYMBOL_IS_KEYWORD (symbol))
1639 reject_constant_symbols (symbol, newval, 0,
1640 UNBOUNDP (newval) ? Qmakunbound : Qset);
1642 if (!SYMBOL_VALUE_MAGIC_P (valcontents) || UNBOUNDP (valcontents))
1644 sym->value = newval;
1648 reject_constant_symbols (symbol, newval, 0,
1649 UNBOUNDP (newval) ? Qmakunbound : Qset);
1651 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1653 case SYMVAL_LISP_MAGIC:
1655 if (UNBOUNDP (newval))
1657 maybe_call_magic_handler (symbol, Qmakunbound, 0);
1658 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = Qunbound;
1662 maybe_call_magic_handler (symbol, Qset, 1, newval);
1663 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = newval;
1667 case SYMVAL_VARALIAS:
1668 symbol = follow_varalias_pointers (symbol,
1670 ? Qmakunbound : Qset);
1671 /* presto change-o! */
1674 case SYMVAL_FIXNUM_FORWARD:
1675 case SYMVAL_BOOLEAN_FORWARD:
1676 case SYMVAL_OBJECT_FORWARD:
1677 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1678 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1679 if (UNBOUNDP (newval))
1680 signal_error (Qerror,
1681 list2 (build_string ("Cannot makunbound"), symbol));
1684 /* case SYMVAL_UNBOUND_MARKER: break; */
1686 case SYMVAL_CURRENT_BUFFER_FORWARD:
1688 CONST struct symbol_value_forward *fwd
1689 = XSYMBOL_VALUE_FORWARD (valcontents);
1690 int mask = XINT (*((Lisp_Object *)
1691 symbol_value_forward_forward (fwd)));
1693 /* Setting this variable makes it buffer-local */
1694 current_buffer->local_var_flags |= mask;
1698 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1700 CONST struct symbol_value_forward *fwd
1701 = XSYMBOL_VALUE_FORWARD (valcontents);
1702 int mask = XINT (*((Lisp_Object *)
1703 symbol_value_forward_forward (fwd)));
1705 /* Setting this variable makes it console-local */
1706 XCONSOLE (Vselected_console)->local_var_flags |= mask;
1710 case SYMVAL_BUFFER_LOCAL:
1711 case SYMVAL_SOME_BUFFER_LOCAL:
1713 /* If we want to examine or set the value and
1714 CURRENT-BUFFER is current, we just examine or set
1715 CURRENT-VALUE. If CURRENT-BUFFER is not current, we
1716 store the current CURRENT-VALUE value into
1717 CURRENT-ALIST- ELEMENT, then find the appropriate alist
1718 element for the buffer now current and set up
1719 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
1720 of that element, and store into CURRENT-BUFFER.
1722 If we are setting the variable and the current buffer does
1723 not have an alist entry for this variable, an alist entry is
1726 Note that CURRENT-VALUE can be a forwarding pointer.
1727 Each time it is examined or set, forwarding must be
1729 struct symbol_value_buffer_local *bfwd
1730 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1731 int some_buffer_local_p =
1732 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
1733 /* What value are we caching right now? */
1734 Lisp_Object aelt = bfwd->current_alist_element;
1736 if (!NILP (bfwd->current_buffer) &&
1737 current_buffer == XBUFFER (bfwd->current_buffer)
1738 && ((some_buffer_local_p)
1739 ? 1 /* doesn't automatically become local */
1740 : !NILP (aelt) /* already local */
1743 /* Cache is valid */
1744 valcontents = bfwd->current_value;
1748 /* If the current buffer is not the buffer whose binding is
1749 currently cached, or if it's a SYMVAL_BUFFER_LOCAL and
1750 we're looking at the default value, the cache is invalid; we
1751 need to write it out, and find the new CURRENT-ALIST-ELEMENT
1754 /* Write out the cached value for the old buffer; copy it
1755 back to its alist element. This works if the current
1756 buffer only sees the default value, too. */
1757 write_out_buffer_local_cache (symbol, bfwd);
1759 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1760 aelt = buffer_local_alist_element (current_buffer, symbol, bfwd);
1763 /* This buffer is still seeing the default value. */
1764 if (!some_buffer_local_p)
1766 /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a
1767 new assoc for a local value and set
1768 CURRENT-ALIST-ELEMENT to point to that. */
1770 do_symval_forwarding (bfwd->current_value,
1772 XCONSOLE (Vselected_console));
1773 aelt = Fcons (symbol, aelt);
1774 current_buffer->local_var_alist
1775 = Fcons (aelt, current_buffer->local_var_alist);
1779 /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
1780 we're currently seeing the default value. */
1784 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1785 bfwd->current_alist_element = aelt;
1786 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
1787 XSETBUFFER (bfwd->current_buffer, current_buffer);
1788 valcontents = bfwd->current_value;
1795 store_symval_forwarding (symbol, valcontents, newval);
1801 /* Access or set a buffer-local symbol's default value. */
1803 /* Return the default value of SYM, but don't check for voidness.
1804 Return Qunbound if it is void. */
1807 default_value (Lisp_Object sym)
1809 Lisp_Object valcontents;
1814 valcontents = XSYMBOL (sym)->value;
1817 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1820 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1822 case SYMVAL_LISP_MAGIC:
1824 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1828 case SYMVAL_VARALIAS:
1829 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1830 /* presto change-o! */
1833 case SYMVAL_UNBOUND_MARKER:
1836 case SYMVAL_CURRENT_BUFFER_FORWARD:
1838 CONST struct symbol_value_forward *fwd
1839 = XSYMBOL_VALUE_FORWARD (valcontents);
1840 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1841 + ((char *)symbol_value_forward_forward (fwd)
1842 - (char *)&buffer_local_flags))));
1845 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1847 CONST struct symbol_value_forward *fwd
1848 = XSYMBOL_VALUE_FORWARD (valcontents);
1849 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1850 + ((char *)symbol_value_forward_forward (fwd)
1851 - (char *)&console_local_flags))));
1854 case SYMVAL_BUFFER_LOCAL:
1855 case SYMVAL_SOME_BUFFER_LOCAL:
1857 struct symbol_value_buffer_local *bfwd =
1858 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1860 /* Handle user-created local variables. */
1861 /* If var is set up for a buffer that lacks a local value for it,
1862 the current value is nominally the default value.
1863 But the current value slot may be more up to date, since
1864 ordinary setq stores just that slot. So use that. */
1865 if (NILP (bfwd->current_alist_element))
1866 return do_symval_forwarding (bfwd->current_value, current_buffer,
1867 XCONSOLE (Vselected_console));
1869 return bfwd->default_value;
1872 /* For other variables, get the current value. */
1873 return do_symval_forwarding (valcontents, current_buffer,
1874 XCONSOLE (Vselected_console));
1877 RETURN_NOT_REACHED (Qnil) /* suppress compiler warning */
1880 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /*
1881 Return t if SYMBOL has a non-void default value.
1882 This is the value that is seen in buffers that do not have their own values
1887 return UNBOUNDP (default_value (symbol)) ? Qnil : Qt;
1890 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /*
1891 Return SYMBOL's default value.
1892 This is the value that is seen in buffers that do not have their own values
1893 for this variable. The default value is meaningful for variables with
1894 local bindings in certain buffers.
1898 Lisp_Object value = default_value (symbol);
1900 return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (symbol)) : value;
1903 DEFUN ("set-default", Fset_default, 2, 2, 0, /*
1904 Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.
1905 The default value is seen in buffers that do not have their own values
1910 Lisp_Object valcontents;
1912 CHECK_SYMBOL (symbol);
1915 valcontents = XSYMBOL (symbol)->value;
1918 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1919 return Fset (symbol, value);
1921 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1923 case SYMVAL_LISP_MAGIC:
1924 RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (symbol, Qset_default, 1,
1926 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1930 case SYMVAL_VARALIAS:
1931 symbol = follow_varalias_pointers (symbol, Qset_default);
1932 /* presto change-o! */
1935 case SYMVAL_CURRENT_BUFFER_FORWARD:
1936 set_default_buffer_slot_variable (symbol, value);
1939 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1940 set_default_console_slot_variable (symbol, value);
1943 case SYMVAL_BUFFER_LOCAL:
1944 case SYMVAL_SOME_BUFFER_LOCAL:
1946 /* Store new value into the DEFAULT-VALUE slot */
1947 struct symbol_value_buffer_local *bfwd
1948 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1950 bfwd->default_value = value;
1951 /* If current-buffer doesn't shadow default_value,
1952 * we must set the CURRENT-VALUE slot too */
1953 if (NILP (bfwd->current_alist_element))
1954 store_symval_forwarding (symbol, bfwd->current_value, value);
1959 return Fset (symbol, value);
1963 DEFUN ("setq-default", Fsetq_default, 0, UNEVALLED, 0, /*
1964 Set the default value of variable SYMBOL to VALUE.
1965 SYMBOL, the variable name, is literal (not evaluated);
1966 VALUE is an expression and it is evaluated.
1967 The default value of a variable is seen in buffers
1968 that do not have their own values for the variable.
1970 More generally, you can use multiple variables and values, as in
1971 (setq-default SYMBOL VALUE SYMBOL VALUE...)
1972 This sets each SYMBOL's default value to the corresponding VALUE.
1973 The VALUE for the Nth SYMBOL can refer to the new default values
1974 of previous SYMBOLs.
1978 /* This function can GC */
1979 Lisp_Object symbol, tail, val = Qnil;
1981 struct gcpro gcpro1;
1983 GET_LIST_LENGTH (args, nargs);
1985 if (nargs & 1) /* Odd number of arguments? */
1986 Fsignal (Qwrong_number_of_arguments,
1987 list2 (Qsetq_default, make_int (nargs)));
1991 PROPERTY_LIST_LOOP (tail, symbol, val, args)
1994 Fset_default (symbol, val);
2001 /* Lisp functions for creating and removing buffer-local variables. */
2003 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1,
2004 "vMake Variable Buffer Local: ", /*
2005 Make VARIABLE have a separate value for each buffer.
2006 At any time, the value for the current buffer is in effect.
2007 There is also a default value which is seen in any buffer which has not yet
2009 Using `set' or `setq' to set the variable causes it to have a separate value
2010 for the current buffer if it was previously using the default value.
2011 The function `default-value' gets the default value and `set-default'
2016 Lisp_Object valcontents;
2018 CHECK_SYMBOL (variable);
2021 verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
2023 valcontents = XSYMBOL (variable)->value;
2026 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2028 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2030 case SYMVAL_LISP_MAGIC:
2031 if (!UNBOUNDP (maybe_call_magic_handler
2032 (variable, Qmake_variable_buffer_local, 0)))
2034 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2038 case SYMVAL_VARALIAS:
2039 variable = follow_varalias_pointers (variable,
2040 Qmake_variable_buffer_local);
2041 /* presto change-o! */
2044 case SYMVAL_FIXNUM_FORWARD:
2045 case SYMVAL_BOOLEAN_FORWARD:
2046 case SYMVAL_OBJECT_FORWARD:
2047 case SYMVAL_UNBOUND_MARKER:
2050 case SYMVAL_CURRENT_BUFFER_FORWARD:
2051 case SYMVAL_BUFFER_LOCAL:
2052 /* Already per-each-buffer */
2055 case SYMVAL_SOME_BUFFER_LOCAL:
2057 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
2058 SYMVAL_BUFFER_LOCAL;
2067 struct symbol_value_buffer_local *bfwd
2068 = alloc_lcrecord_type (struct symbol_value_buffer_local,
2069 &lrecord_symbol_value_buffer_local);
2071 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2073 bfwd->default_value = find_symbol_value (variable);
2074 bfwd->current_value = valcontents;
2075 bfwd->current_alist_element = Qnil;
2076 bfwd->current_buffer = Fcurrent_buffer ();
2077 XSETSYMBOL_VALUE_MAGIC (foo, bfwd);
2078 *value_slot_past_magic (variable) = foo;
2079 #if 1 /* #### Yuck! FSFmacs bug-compatibility*/
2080 /* This sets the default-value of any make-variable-buffer-local to nil.
2081 That just sucks. User can just use setq-default to effect that,
2082 but there's no way to do makunbound-default to undo this lossage. */
2083 if (UNBOUNDP (valcontents))
2084 bfwd->default_value = Qnil;
2086 #if 0 /* #### Yuck! */
2087 /* This sets the value to nil in this buffer.
2088 User could use (setq variable nil) to do this.
2089 It isn't as egregious to do this automatically
2090 as it is to do so to the default-value, but it's
2091 still really dubious. */
2092 if (UNBOUNDP (valcontents))
2093 Fset (variable, Qnil);
2099 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1,
2100 "vMake Local Variable: ", /*
2101 Make VARIABLE have a separate value in the current buffer.
2102 Other buffers will continue to share a common default value.
2103 \(The buffer-local value of VARIABLE starts out as the same value
2104 VARIABLE previously had. If VARIABLE was void, it remains void.)
2105 See also `make-variable-buffer-local'.
2107 If the variable is already arranged to become local when set,
2108 this function causes a local value to exist for this buffer,
2109 just as setting the variable would do.
2111 Do not use `make-local-variable' to make a hook variable buffer-local.
2112 Use `make-local-hook' instead.
2116 Lisp_Object valcontents;
2117 struct symbol_value_buffer_local *bfwd;
2119 CHECK_SYMBOL (variable);
2122 verify_ok_for_buffer_local (variable, Qmake_local_variable);
2124 valcontents = XSYMBOL (variable)->value;
2127 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2129 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2131 case SYMVAL_LISP_MAGIC:
2132 if (!UNBOUNDP (maybe_call_magic_handler
2133 (variable, Qmake_local_variable, 0)))
2135 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2139 case SYMVAL_VARALIAS:
2140 variable = follow_varalias_pointers (variable, Qmake_local_variable);
2141 /* presto change-o! */
2144 case SYMVAL_FIXNUM_FORWARD:
2145 case SYMVAL_BOOLEAN_FORWARD:
2146 case SYMVAL_OBJECT_FORWARD:
2147 case SYMVAL_UNBOUND_MARKER:
2150 case SYMVAL_BUFFER_LOCAL:
2151 case SYMVAL_CURRENT_BUFFER_FORWARD:
2153 /* Make sure the symbol has a local value in this particular
2154 buffer, by setting it to the same value it already has. */
2155 Fset (variable, find_symbol_value (variable));
2159 case SYMVAL_SOME_BUFFER_LOCAL:
2161 if (!NILP (buffer_local_alist_element (current_buffer,
2163 (XSYMBOL_VALUE_BUFFER_LOCAL
2165 goto already_local_to_current_buffer;
2167 goto already_local_to_some_other_buffer;
2175 /* Make sure variable is set up to hold per-buffer values */
2176 bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
2177 &lrecord_symbol_value_buffer_local);
2178 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2180 bfwd->current_buffer = Qnil;
2181 bfwd->current_alist_element = Qnil;
2182 bfwd->current_value = valcontents;
2183 /* passing 0 is OK because this should never be a
2184 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2186 bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
2189 if (UNBOUNDP (bfwd->default_value))
2190 bfwd->default_value = Qnil; /* Yuck! */
2193 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
2194 *value_slot_past_magic (variable) = valcontents;
2196 already_local_to_some_other_buffer:
2198 /* Make sure this buffer has its own value of variable */
2199 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2201 if (UNBOUNDP (bfwd->default_value))
2203 /* If default value is unbound, set local value to nil. */
2204 XSETBUFFER (bfwd->current_buffer, current_buffer);
2205 bfwd->current_alist_element = Fcons (variable, Qnil);
2206 current_buffer->local_var_alist =
2207 Fcons (bfwd->current_alist_element, current_buffer->local_var_alist);
2208 store_symval_forwarding (variable, bfwd->current_value, Qnil);
2212 current_buffer->local_var_alist
2213 = Fcons (Fcons (variable, bfwd->default_value),
2214 current_buffer->local_var_alist);
2216 /* Make sure symbol does not think it is set up for this buffer;
2217 force it to look once again for this buffer's value */
2218 if (!NILP (bfwd->current_buffer) &&
2219 current_buffer == XBUFFER (bfwd->current_buffer))
2220 bfwd->current_buffer = Qnil;
2222 already_local_to_current_buffer:
2224 /* If the symbol forwards into a C variable, then swap in the
2225 variable for this buffer immediately. If C code modifies the
2226 variable before we swap in, then that new value will clobber the
2227 default value the next time we swap. */
2228 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2229 if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value))
2231 switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
2233 case SYMVAL_FIXNUM_FORWARD:
2234 case SYMVAL_BOOLEAN_FORWARD:
2235 case SYMVAL_OBJECT_FORWARD:
2236 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2237 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2240 case SYMVAL_UNBOUND_MARKER:
2241 case SYMVAL_CURRENT_BUFFER_FORWARD:
2252 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1,
2253 "vKill Local Variable: ", /*
2254 Make VARIABLE no longer have a separate value in the current buffer.
2255 From now on the default value will apply in this buffer.
2259 Lisp_Object valcontents;
2261 CHECK_SYMBOL (variable);
2264 valcontents = XSYMBOL (variable)->value;
2267 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2270 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2272 case SYMVAL_LISP_MAGIC:
2273 if (!UNBOUNDP (maybe_call_magic_handler
2274 (variable, Qkill_local_variable, 0)))
2276 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2280 case SYMVAL_VARALIAS:
2281 variable = follow_varalias_pointers (variable, Qkill_local_variable);
2282 /* presto change-o! */
2285 case SYMVAL_CURRENT_BUFFER_FORWARD:
2287 CONST struct symbol_value_forward *fwd
2288 = XSYMBOL_VALUE_FORWARD (valcontents);
2289 int offset = ((char *) symbol_value_forward_forward (fwd)
2290 - (char *) &buffer_local_flags);
2292 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2296 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2297 Lisp_Object in_object, int flags) =
2298 symbol_value_forward_magicfun (fwd);
2299 Lisp_Object oldval = * (Lisp_Object *)
2300 (offset + (char *) XBUFFER (Vbuffer_defaults));
2302 (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
2303 *(Lisp_Object *) (offset + (char *) current_buffer)
2305 current_buffer->local_var_flags &= ~mask;
2310 case SYMVAL_BUFFER_LOCAL:
2311 case SYMVAL_SOME_BUFFER_LOCAL:
2313 /* Get rid of this buffer's alist element, if any */
2314 struct symbol_value_buffer_local *bfwd
2315 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2316 Lisp_Object alist = current_buffer->local_var_alist;
2317 Lisp_Object alist_element
2318 = buffer_local_alist_element (current_buffer, variable, bfwd);
2320 if (!NILP (alist_element))
2321 current_buffer->local_var_alist = Fdelq (alist_element, alist);
2323 /* Make sure symbol does not think it is set up for this buffer;
2324 force it to look once again for this buffer's value */
2325 if (!NILP (bfwd->current_buffer) &&
2326 current_buffer == XBUFFER (bfwd->current_buffer))
2327 bfwd->current_buffer = Qnil;
2329 /* We just changed the value in the current_buffer. If this
2330 variable forwards to a C variable, we need to change the
2331 value of the C variable. set_up_buffer_local_cache()
2332 will do this. It doesn't hurt to do it always,
2333 so just go ahead and do that. */
2334 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2341 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2345 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2346 "vKill Console Local Variable: ", /*
2347 Make VARIABLE no longer have a separate value in the selected console.
2348 From now on the default value will apply in this console.
2352 Lisp_Object valcontents;
2354 CHECK_SYMBOL (variable);
2357 valcontents = XSYMBOL (variable)->value;
2360 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2363 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2365 case SYMVAL_LISP_MAGIC:
2366 if (!UNBOUNDP (maybe_call_magic_handler
2367 (variable, Qkill_console_local_variable, 0)))
2369 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2373 case SYMVAL_VARALIAS:
2374 variable = follow_varalias_pointers (variable,
2375 Qkill_console_local_variable);
2376 /* presto change-o! */
2379 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2381 CONST struct symbol_value_forward *fwd
2382 = XSYMBOL_VALUE_FORWARD (valcontents);
2383 int offset = ((char *) symbol_value_forward_forward (fwd)
2384 - (char *) &console_local_flags);
2386 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2390 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2391 Lisp_Object in_object, int flags) =
2392 symbol_value_forward_magicfun (fwd);
2393 Lisp_Object oldval = * (Lisp_Object *)
2394 (offset + (char *) XCONSOLE (Vconsole_defaults));
2396 magicfun (variable, &oldval, Vselected_console, 0);
2397 *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
2399 XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
2409 /* Used by specbind to determine what effects it might have. Returns:
2410 * 0 if symbol isn't buffer-local, and wouldn't be after it is set
2411 * <0 if symbol isn't presently buffer-local, but set would make it so
2412 * >0 if symbol is presently buffer-local
2415 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
2417 Lisp_Object valcontents;
2420 valcontents = XSYMBOL (symbol)->value;
2423 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2425 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2427 case SYMVAL_LISP_MAGIC:
2429 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2433 case SYMVAL_VARALIAS:
2434 symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
2435 /* presto change-o! */
2438 case SYMVAL_CURRENT_BUFFER_FORWARD:
2440 CONST struct symbol_value_forward *fwd
2441 = XSYMBOL_VALUE_FORWARD (valcontents);
2442 int mask = XINT (*((Lisp_Object *)
2443 symbol_value_forward_forward (fwd)));
2444 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
2445 /* Already buffer-local */
2448 /* Would be buffer-local after set */
2451 case SYMVAL_BUFFER_LOCAL:
2452 case SYMVAL_SOME_BUFFER_LOCAL:
2454 struct symbol_value_buffer_local *bfwd
2455 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2457 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
2460 /* Automatically becomes local when set */
2461 return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
2471 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2472 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2474 (symbol, buffer, unbound_value))
2477 CHECK_SYMBOL (symbol);
2478 CHECK_BUFFER (buffer);
2479 value = symbol_value_in_buffer (symbol, buffer);
2480 return UNBOUNDP (value) ? unbound_value : value;
2483 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2484 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2486 (symbol, console, unbound_value))
2489 CHECK_SYMBOL (symbol);
2490 CHECK_CONSOLE (console);
2491 value = symbol_value_in_console (symbol, console);
2492 return UNBOUNDP (value) ? unbound_value : value;
2495 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
2496 If SYMBOL is a built-in variable, return info about this; else return nil.
2497 The returned info will be a symbol, one of
2499 `object' A simple built-in variable.
2500 `const-object' Same, but cannot be set.
2501 `integer' A built-in integer variable.
2502 `const-integer' Same, but cannot be set.
2503 `boolean' A built-in boolean variable.
2504 `const-boolean' Same, but cannot be set.
2505 `const-specifier' Always contains a specifier; e.g. `has-modeline-p'.
2506 `current-buffer' A built-in buffer-local variable.
2507 `const-current-buffer' Same, but cannot be set.
2508 `default-buffer' Forwards to the default value of a built-in
2509 buffer-local variable.
2510 `selected-console' A built-in console-local variable.
2511 `const-selected-console' Same, but cannot be set.
2512 `default-console' Forwards to the default value of a built-in
2513 console-local variable.
2517 REGISTER Lisp_Object valcontents;
2519 CHECK_SYMBOL (symbol);
2522 valcontents = XSYMBOL (symbol)->value;
2525 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2528 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2530 case SYMVAL_LISP_MAGIC:
2531 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2535 case SYMVAL_VARALIAS:
2536 symbol = follow_varalias_pointers (symbol, Qt);
2537 /* presto change-o! */
2540 case SYMVAL_BUFFER_LOCAL:
2541 case SYMVAL_SOME_BUFFER_LOCAL:
2543 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value;
2547 case SYMVAL_FIXNUM_FORWARD: return Qinteger;
2548 case SYMVAL_CONST_FIXNUM_FORWARD: return Qconst_integer;
2549 case SYMVAL_BOOLEAN_FORWARD: return Qboolean;
2550 case SYMVAL_CONST_BOOLEAN_FORWARD: return Qconst_boolean;
2551 case SYMVAL_OBJECT_FORWARD: return Qobject;
2552 case SYMVAL_CONST_OBJECT_FORWARD: return Qconst_object;
2553 case SYMVAL_CONST_SPECIFIER_FORWARD: return Qconst_specifier;
2554 case SYMVAL_DEFAULT_BUFFER_FORWARD: return Qdefault_buffer;
2555 case SYMVAL_CURRENT_BUFFER_FORWARD: return Qcurrent_buffer;
2556 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: return Qconst_current_buffer;
2557 case SYMVAL_DEFAULT_CONSOLE_FORWARD: return Qdefault_console;
2558 case SYMVAL_SELECTED_CONSOLE_FORWARD: return Qselected_console;
2559 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: return Qconst_selected_console;
2560 case SYMVAL_UNBOUND_MARKER: return Qnil;
2563 abort (); return Qnil;
2568 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
2569 Return t if SYMBOL's value is local to BUFFER.
2570 If optional third arg AFTER-SET is true, return t if SYMBOL would be
2571 buffer-local after it is set, regardless of whether it is so presently.
2572 A nil value for BUFFER is *not* the same as (current-buffer), but means
2573 "no buffer". Specifically:
2575 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
2576 the variable is one of the special built-in variables that is always
2577 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
2578 `buffer-undo-list', and others.)
2580 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
2581 the variable has had `make-variable-buffer-local' applied to it.
2583 (symbol, buffer, after_set))
2587 CHECK_SYMBOL (symbol);
2590 buffer = get_buffer (buffer, 1);
2591 local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
2595 local_info = symbol_value_buffer_local_info (symbol, 0);
2598 if (NILP (after_set))
2599 return local_info > 0 ? Qt : Qnil;
2601 return local_info != 0 ? Qt : Qnil;
2606 I've gone ahead and partially implemented this because it's
2607 super-useful for dealing with the compatibility problems in supporting
2608 the old pointer-shape variables, and preventing people from `setq'ing
2609 the new variables. Any other way of handling this problem is way
2610 ugly, likely to be slow, and generally not something I want to waste
2611 my time worrying about.
2613 The interface and/or function name is sure to change before this
2614 gets into its final form. I currently like the way everything is
2615 set up and it has all the features I want it to have, except for
2616 one: I really want to be able to have multiple nested handlers,
2617 to implement an `advice'-like capability. This would allow,
2618 for example, a clean way of implementing `debug-if-set' or
2619 `debug-if-referenced' and such.
2621 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
2622 ************************************************************
2623 **Only** the `set-value', `make-unbound', and `make-local'
2624 handler types are currently implemented. Implementing the
2625 get-value and bound-predicate handlers is somewhat tricky
2626 because there are lots of subfunctions (e.g. find_symbol_value()).
2627 find_symbol_value(), in fact, is called from outside of
2628 this module. You'd have to have it do this:
2630 -- check for a `bound-predicate' handler, call that if so;
2631 if it returns nil, return Qunbound
2632 -- check for a `get-value' handler and call it and return
2635 It gets even trickier when you have to deal with
2636 sub-subfunctions like find_symbol_value_1(), and esp.
2637 when you have to properly handle variable aliases, which
2638 can lead to lots of tricky situations. So I've just
2639 punted on this, since the interface isn't officially
2640 exported and we can get by with just a `set-value'
2643 Actions in unimplemented handler types will correctly
2644 ignore any handlers, and will not fuck anything up or
2647 WARNING WARNING: If you do go and implement another
2648 type of handler, make *sure* to change
2649 would_be_magic_handled() so it knows about this,
2650 or dire things could result.
2651 ************************************************************
2652 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
2654 Real documentation is as follows.
2656 Set a magic handler for VARIABLE.
2657 This allows you to specify arbitrary behavior that results from
2658 accessing or setting a variable. For example, retrieving the
2659 variable's value might actually retrieve the first element off of
2660 a list stored in another variable, and setting the variable's value
2661 might add an element to the front of that list. (This is how the
2662 obsolete variable `unread-command-event' is implemented.)
2664 In general it is NOT good programming practice to use magic variables
2665 in a new package that you are designing. If you feel the need to
2666 do this, it's almost certainly a sign that you should be using a
2667 function instead of a variable. This facility is provided to allow
2668 a package to support obsolete variables and provide compatibility
2669 with similar packages with different variable names and semantics.
2670 By using magic handlers, you can cleanly provide obsoleteness and
2671 compatibility support and separate this support from the core
2672 routines in a package.
2674 VARIABLE should be a symbol naming the variable for which the
2675 magic behavior is provided. HANDLER-TYPE is a symbol specifying
2676 which behavior is being controlled, and HANDLER is the function
2677 that will be called to control this behavior. HARG is a
2678 value that will be passed to HANDLER but is otherwise
2679 uninterpreted. KEEP-EXISTING specifies what to do with existing
2680 handlers of the same type; nil means "erase them all", t means
2681 "keep them but insert at the beginning", the list (t) means
2682 "keep them but insert at the end", a function means "keep
2683 them but insert before the specified function", a list containing
2684 a function means "keep them but insert after the specified
2687 You can specify magic behavior for any type of variable at all,
2688 and for any handler types that are unspecified, the standard
2689 behavior applies. This allows you, for example, to use
2690 `defvaralias' in conjunction with this function. (For that
2691 matter, `defvaralias' could be implemented using this function.)
2693 The behaviors that can be specified in HANDLER-TYPE are
2695 get-value (SYM ARGS FUN HARG HANDLERS)
2696 This means that one of the functions `symbol-value',
2697 `default-value', `symbol-value-in-buffer', or
2698 `symbol-value-in-console' was called on SYM.
2700 set-value (SYM ARGS FUN HARG HANDLERS)
2701 This means that one of the functions `set' or `set-default'
2704 bound-predicate (SYM ARGS FUN HARG HANDLERS)
2705 This means that one of the functions `boundp', `globally-boundp',
2706 or `default-boundp' was called on SYM.
2708 make-unbound (SYM ARGS FUN HARG HANDLERS)
2709 This means that the function `makunbound' was called on SYM.
2711 local-predicate (SYM ARGS FUN HARG HANDLERS)
2712 This means that the function `local-variable-p' was called
2715 make-local (SYM ARGS FUN HARG HANDLERS)
2716 This means that one of the functions `make-local-variable',
2717 `make-variable-buffer-local', `kill-local-variable',
2718 or `kill-console-local-variable' was called on SYM.
2720 The meanings of the arguments are as follows:
2722 SYM is the symbol on which the function was called, and is always
2723 the first argument to the function.
2725 ARGS are the remaining arguments in the original call (i.e. all
2726 but the first). In the case of `set-value' in particular,
2727 the first element of ARGS is the value to which the variable
2728 is being set. In some cases, ARGS is sanitized from what was
2729 actually given. For example, whenever `nil' is passed to an
2730 argument and it means `current-buffer', the current buffer is
2731 substituted instead.
2733 FUN is a symbol indicating which function is being called.
2734 For many of the functions, you can determine the corresponding
2735 function of a different class using
2736 `symbol-function-corresponding-function'.
2738 HARG is the argument that was given in the call
2739 to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
2741 HANDLERS is a structure containing the remaining handlers
2742 for the variable; to call one of them, use
2743 `chain-to-symbol-value-handler'.
2745 NOTE: You may *not* modify the list in ARGS, and if you want to
2746 keep it around after the handler function exits, you must make
2747 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
2750 static enum lisp_magic_handler
2751 decode_magic_handler_type (Lisp_Object symbol)
2753 if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE;
2754 if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE;
2755 if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE;
2756 if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND;
2757 if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE;
2758 if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL;
2760 signal_simple_error ("Unrecognized symbol value handler type", symbol);
2762 return MAGIC_HANDLER_MAX;
2765 static enum lisp_magic_handler
2766 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
2768 if (EQ (funsym, Qsymbol_value)
2769 || EQ (funsym, Qdefault_value)
2770 || EQ (funsym, Qsymbol_value_in_buffer)
2771 || EQ (funsym, Qsymbol_value_in_console))
2772 return MAGIC_HANDLER_GET_VALUE;
2774 if (EQ (funsym, Qset)
2775 || EQ (funsym, Qset_default))
2776 return MAGIC_HANDLER_SET_VALUE;
2778 if (EQ (funsym, Qboundp)
2779 || EQ (funsym, Qglobally_boundp)
2780 || EQ (funsym, Qdefault_boundp))
2781 return MAGIC_HANDLER_BOUND_PREDICATE;
2783 if (EQ (funsym, Qmakunbound))
2784 return MAGIC_HANDLER_MAKE_UNBOUND;
2786 if (EQ (funsym, Qlocal_variable_p))
2787 return MAGIC_HANDLER_LOCAL_PREDICATE;
2789 if (EQ (funsym, Qmake_variable_buffer_local)
2790 || EQ (funsym, Qmake_local_variable))
2791 return MAGIC_HANDLER_MAKE_LOCAL;
2793 if (abort_if_not_found)
2795 signal_simple_error ("Unrecognized symbol-value function", funsym);
2796 return MAGIC_HANDLER_MAX;
2800 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
2802 /* does not take into account variable aliasing. */
2803 Lisp_Object valcontents = XSYMBOL (sym)->value;
2804 enum lisp_magic_handler slot;
2806 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2808 slot = handler_type_from_function_symbol (funsym, 1);
2809 if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND
2810 && slot != MAGIC_HANDLER_MAKE_LOCAL)
2811 /* #### temporary kludge because we haven't implemented
2812 lisp-magic variables completely */
2814 return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
2818 fetch_value_maybe_past_magic (Lisp_Object sym,
2819 Lisp_Object follow_past_lisp_magic)
2821 Lisp_Object value = XSYMBOL (sym)->value;
2822 if (SYMBOL_VALUE_LISP_MAGIC_P (value)
2823 && (EQ (follow_past_lisp_magic, Qt)
2824 || (!NILP (follow_past_lisp_magic)
2825 && !would_be_magic_handled (sym, follow_past_lisp_magic))))
2826 value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed;
2830 static Lisp_Object *
2831 value_slot_past_magic (Lisp_Object sym)
2833 Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
2835 if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
2836 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
2837 return store_pointer;
2841 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
2844 Lisp_Object args[20]; /* should be enough ... */
2846 enum lisp_magic_handler htype;
2847 Lisp_Object legerdemain;
2848 struct symbol_value_lisp_magic *bfwd;
2850 assert (nargs >= 0 && nargs < countof (args));
2851 legerdemain = XSYMBOL (sym)->value;
2852 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2853 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2855 va_start (vargs, nargs);
2856 for (i = 0; i < nargs; i++)
2857 args[i] = va_arg (vargs, Lisp_Object);
2860 htype = handler_type_from_function_symbol (funsym, 1);
2861 if (NILP (bfwd->handler[htype]))
2863 /* #### should be reusing the arglist, not always consing anew.
2864 Repeated handler invocations should not cause repeated consing.
2865 Doesn't matter for now, because this is just a quick implementation
2866 for obsolescence support. */
2867 return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym,
2868 bfwd->harg[htype], Qnil);
2871 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
2873 Don't you dare use this.
2874 If you do, suffer the wrath of Ben, who is likely to rename
2875 this function (or change the semantics of its arguments) without
2876 pity, thereby invalidating your code.
2878 (variable, handler_type, handler, harg, keep_existing))
2880 Lisp_Object valcontents;
2881 struct symbol_value_lisp_magic *bfwd;
2882 enum lisp_magic_handler htype;
2885 /* #### WARNING, only some handler types are implemented. See above.
2886 Actions of other types will ignore a handler if it's there.
2888 #### Also, `chain-to-symbol-value-handler' and
2889 `symbol-function-corresponding-function' are not implemented. */
2890 CHECK_SYMBOL (variable);
2891 CHECK_SYMBOL (handler_type);
2892 htype = decode_magic_handler_type (handler_type);
2893 valcontents = XSYMBOL (variable)->value;
2894 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2896 bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
2897 &lrecord_symbol_value_lisp_magic);
2898 bfwd->magic.type = SYMVAL_LISP_MAGIC;
2899 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2901 bfwd->handler[i] = Qnil;
2902 bfwd->harg[i] = Qnil;
2904 bfwd->shadowed = valcontents;
2905 XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
2908 bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
2909 bfwd->handler[htype] = handler;
2910 bfwd->harg[htype] = harg;
2912 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2913 if (!NILP (bfwd->handler[i]))
2916 if (i == MAGIC_HANDLER_MAX)
2917 /* there are no remaining handlers, so remove the structure. */
2918 XSYMBOL (variable)->value = bfwd->shadowed;
2924 /* functions for working with variable aliases. */
2926 /* Follow the chain of variable aliases for SYMBOL. Return the
2927 resulting symbol, whose value cell is guaranteed not to be a
2928 symbol-value-varalias.
2930 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
2931 If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
2932 never follow; stop right there. Otherwise FUNSYM should be a
2933 recognized symbol-value function symbol; this means, follow
2934 unless there is a special handler for the named function.
2936 OK, there is at least one reason why it's necessary for
2937 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
2938 can always be sure to catch cyclic variable aliasing. If we never
2939 follow past Lisp magic, then if the following is done:
2942 add some magic behavior to a, but not a "get-value" handler
2945 then an attempt to retrieve a's or b's value would cause infinite
2946 looping in `symbol-value'.
2948 We (of course) can't always follow past Lisp magic, because then
2949 we make any variable that is lisp-magic -> varalias behave as if
2950 the lisp-magic is not present at all.
2954 follow_varalias_pointers (Lisp_Object symbol,
2955 Lisp_Object follow_past_lisp_magic)
2957 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
2958 Lisp_Object tortoise, hare, val;
2961 /* quick out just in case */
2962 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value))
2965 /* Compare implementation of indirect_function(). */
2966 for (hare = tortoise = symbol, count = 0;
2967 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic),
2968 SYMBOL_VALUE_VARALIAS_P (val);
2969 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)),
2972 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue;
2975 tortoise = symbol_value_varalias_aliasee
2976 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic
2977 (tortoise, follow_past_lisp_magic)));
2978 if (EQ (hare, tortoise))
2979 return Fsignal (Qcyclic_variable_indirection, list1 (symbol));
2985 DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
2986 Define a variable as an alias for another variable.
2987 Thenceforth, any operations performed on VARIABLE will actually be
2988 performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
2989 If ALIAS is nil, remove any aliases for VARIABLE.
2990 ALIAS can itself be aliased, and the chain of variable aliases
2991 will be followed appropriately.
2992 If VARIABLE already has a value, this value will be shadowed
2993 until the alias is removed, at which point it will be restored.
2994 Currently VARIABLE cannot be a built-in variable, a variable that
2995 has a buffer-local value in any buffer, or the symbols nil or t.
2996 \(ALIAS, however, can be any type of variable.)
3000 struct symbol_value_varalias *bfwd;
3001 Lisp_Object valcontents;
3003 CHECK_SYMBOL (variable);
3004 reject_constant_symbols (variable, Qunbound, 0, Qt);
3006 valcontents = XSYMBOL (variable)->value;
3010 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3012 XSYMBOL (variable)->value =
3013 symbol_value_varalias_shadowed
3014 (XSYMBOL_VALUE_VARALIAS (valcontents));
3019 CHECK_SYMBOL (alias);
3020 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3023 XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
3027 if (SYMBOL_VALUE_MAGIC_P (valcontents)
3028 && !UNBOUNDP (valcontents))
3029 signal_simple_error ("Variable is magic and cannot be aliased", variable);
3030 reject_constant_symbols (variable, Qunbound, 0, Qt);
3032 bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
3033 &lrecord_symbol_value_varalias);
3034 bfwd->magic.type = SYMVAL_VARALIAS;
3035 bfwd->aliasee = alias;
3036 bfwd->shadowed = valcontents;
3038 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
3039 XSYMBOL (variable)->value = valcontents;
3043 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
3044 If VARIABLE is aliased to another variable, return that variable.
3045 VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
3046 Variable aliases are created with `defvaralias'. See also
3047 `indirect-variable'.
3049 (variable, follow_past_lisp_magic))
3051 Lisp_Object valcontents;
3053 CHECK_SYMBOL (variable);
3054 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3056 CHECK_SYMBOL (follow_past_lisp_magic);
3057 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3060 valcontents = fetch_value_maybe_past_magic (variable,
3061 follow_past_lisp_magic);
3063 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3064 return symbol_value_varalias_aliasee
3065 (XSYMBOL_VALUE_VARALIAS (valcontents));
3070 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /*
3071 Return the variable at the end of OBJECT's variable-alias chain.
3072 If OBJECT is a symbol, follow all variable aliases and return
3073 the final (non-aliased) symbol. Variable aliases are created with
3074 the function `defvaralias'.
3075 If OBJECT is not a symbol, just return it.
3076 Signal a cyclic-variable-indirection error if there is a loop in the
3077 variable chain of symbols.
3079 (object, follow_past_lisp_magic))
3081 if (!SYMBOLP (object))
3083 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3085 CHECK_SYMBOL (follow_past_lisp_magic);
3086 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3088 return follow_varalias_pointers (object, follow_past_lisp_magic);
3092 /************************************************************************/
3093 /* initialization */
3094 /************************************************************************/
3096 /* A dumped XEmacs image has a lot more than 1511 symbols. Last
3097 estimate was that there were actually around 6300. So let's try
3098 making this bigger and see if we get better hashing behavior. */
3099 #define OBARRAY_SIZE 16411
3104 #ifndef Qnull_pointer
3105 Lisp_Object Qnull_pointer;
3108 /* some losing systems can't have static vars at function scope... */
3109 static struct symbol_value_magic guts_of_unbound_marker =
3110 { { symbol_value_forward_lheader_initializer, 0, 69},
3111 SYMVAL_UNBOUND_MARKER };
3114 init_symbols_once_early (void)
3116 reinit_symbols_once_early ();
3118 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3119 called the first time. */
3120 Qnil = Fmake_symbol (make_string_nocopy ((CONST Bufbyte *) "nil", 3));
3121 XSYMBOL (Qnil)->name->plist = Qnil;
3122 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
3123 XSYMBOL (Qnil)->plist = Qnil;
3125 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3126 initial_obarray = Vobarray;
3127 staticpro (&initial_obarray);
3128 /* Intern nil in the obarray */
3130 int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
3131 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3135 /* Required to get around a GCC syntax error on certain
3137 struct symbol_value_magic *tem = &guts_of_unbound_marker;
3139 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3141 if ((CONST void *) XPNTR (Qunbound) !=
3142 (CONST void *)&guts_of_unbound_marker)
3144 /* This might happen on DATA_SEG_BITS machines. */
3146 /* Can't represent a pointer to constant C data using a Lisp_Object.
3147 So heap-allocate it. */
3148 struct symbol_value_magic *urk = xnew (struct symbol_value_magic);
3149 memcpy (urk, &guts_of_unbound_marker, sizeof (*urk));
3150 XSETSYMBOL_VALUE_MAGIC (Qunbound, urk);
3153 XSYMBOL (Qnil)->function = Qunbound;
3155 defsymbol (&Qt, "t");
3156 XSYMBOL (Qt)->value = Qt; /* Veritas aetera */
3160 pdump_wire (&Qunbound);
3161 pdump_wire (&Vquit_flag);
3165 reinit_symbols_once_early (void)
3168 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3171 #ifndef Qnull_pointer
3172 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3173 so the following is actually a no-op. */
3174 XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
3179 defsymbol_nodump (Lisp_Object *location, CONST char *name)
3181 *location = Fintern (make_string_nocopy ((CONST Bufbyte *) name,
3184 staticpro_nodump (location);
3188 defsymbol (Lisp_Object *location, CONST char *name)
3190 *location = Fintern (make_string_nocopy ((CONST Bufbyte *) name,
3193 staticpro (location);
3197 defkeyword (Lisp_Object *location, CONST char *name)
3199 defsymbol (location, name);
3200 Fset (*location, *location);
3204 /* Check that nobody spazzed writing a DEFUN. */
3206 check_sane_subr (Lisp_Subr *subr, Lisp_Object sym)
3208 assert (subr->min_args >= 0);
3209 assert (subr->min_args <= SUBR_MAX_ARGS);
3211 if (subr->max_args != MANY &&
3212 subr->max_args != UNEVALLED)
3214 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3215 assert (subr->max_args <= SUBR_MAX_ARGS);
3216 assert (subr->min_args <= subr->max_args);
3219 assert (UNBOUNDP (XSYMBOL (sym)->function));
3222 #define check_sane_subr(subr, sym) /* nothing */
3227 * If we are not in a pure undumped Emacs, we need to make a duplicate of
3228 * the subr. This is because the only time this function will be called
3229 * in a running Emacs is when a dynamically loaded module is adding a
3230 * subr, and we need to make sure that the subr is in allocated, Lisp-
3231 * accessible memory. The address assigned to the static subr struct
3232 * in the shared object will be a trampoline address, so we need to create
3233 * a copy here to ensure that a real address is used.
3235 * Once we have copied everything across, we re-use the original static
3236 * structure to store a pointer to the newly allocated one. This will be
3237 * used in emodules.c by emodules_doc_subr() to find a pointer to the
3238 * allocated object so that we can set its doc string propperly.
3240 * NOTE: We dont actually use the DOC pointer here any more, but we did
3241 * in an earlier implementation of module support. There is no harm in
3242 * setting it here in case we ever need it in future implementations.
3243 * subr->doc will point to the new subr structure that was allocated.
3244 * Code can then get this value from the statis subr structure and use
3247 * FIXME: Should newsubr be staticpro()'ed? I dont think so but I need
3250 #define check_module_subr() \
3252 if (initialized) { \
3253 Lisp_Subr *newsubr = (Lisp_Subr *) xmalloc (sizeof (Lisp_Subr)); \
3254 memcpy (newsubr, subr, sizeof (Lisp_Subr)); \
3255 subr->doc = (CONST char *)newsubr; \
3259 #else /* ! HAVE_SHLIB */
3260 #define check_module_subr()
3264 defsubr (Lisp_Subr *subr)
3266 Lisp_Object sym = intern (subr_name (subr));
3269 check_sane_subr (subr, sym);
3270 check_module_subr ();
3272 XSETSUBR (fun, subr);
3273 XSYMBOL (sym)->function = fun;
3276 /* Define a lisp macro using a Lisp_Subr. */
3278 defsubr_macro (Lisp_Subr *subr)
3280 Lisp_Object sym = intern (subr_name (subr));
3283 check_sane_subr (subr, sym);
3284 check_module_subr();
3286 XSETSUBR (fun, subr);
3287 XSYMBOL (sym)->function = Fcons (Qmacro, fun);
3291 deferror (Lisp_Object *symbol, CONST char *name, CONST char *messuhhj,
3292 Lisp_Object inherits_from)
3295 defsymbol (symbol, name);
3297 assert (SYMBOLP (inherits_from));
3298 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3299 Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3300 /* NOT build_translated_string (). This function is called at load time
3301 and the string needs to get translated at run time. (This happens
3302 in the function (display-error) in cmdloop.el.) */
3303 Fput (*symbol, Qerror_message, build_string (messuhhj));
3307 syms_of_symbols (void)
3309 defsymbol (&Qvariable_documentation, "variable-documentation");
3310 defsymbol (&Qvariable_domain, "variable-domain"); /* I18N3 */
3311 defsymbol (&Qad_advice_info, "ad-advice-info");
3312 defsymbol (&Qad_activate, "ad-activate");
3314 defsymbol (&Qget_value, "get-value");
3315 defsymbol (&Qset_value, "set-value");
3316 defsymbol (&Qbound_predicate, "bound-predicate");
3317 defsymbol (&Qmake_unbound, "make-unbound");
3318 defsymbol (&Qlocal_predicate, "local-predicate");
3319 defsymbol (&Qmake_local, "make-local");
3321 defsymbol (&Qboundp, "boundp");
3322 defsymbol (&Qglobally_boundp, "globally-boundp");
3323 defsymbol (&Qmakunbound, "makunbound");
3324 defsymbol (&Qsymbol_value, "symbol-value");
3325 defsymbol (&Qset, "set");
3326 defsymbol (&Qsetq_default, "setq-default");
3327 defsymbol (&Qdefault_boundp, "default-boundp");
3328 defsymbol (&Qdefault_value, "default-value");
3329 defsymbol (&Qset_default, "set-default");
3330 defsymbol (&Qmake_variable_buffer_local, "make-variable-buffer-local");
3331 defsymbol (&Qmake_local_variable, "make-local-variable");
3332 defsymbol (&Qkill_local_variable, "kill-local-variable");
3333 defsymbol (&Qkill_console_local_variable, "kill-console-local-variable");
3334 defsymbol (&Qsymbol_value_in_buffer, "symbol-value-in-buffer");
3335 defsymbol (&Qsymbol_value_in_console, "symbol-value-in-console");
3336 defsymbol (&Qlocal_variable_p, "local-variable-p");
3338 defsymbol (&Qconst_integer, "const-integer");
3339 defsymbol (&Qconst_boolean, "const-boolean");
3340 defsymbol (&Qconst_object, "const-object");
3341 defsymbol (&Qconst_specifier, "const-specifier");
3342 defsymbol (&Qdefault_buffer, "default-buffer");
3343 defsymbol (&Qcurrent_buffer, "current-buffer");
3344 defsymbol (&Qconst_current_buffer, "const-current-buffer");
3345 defsymbol (&Qdefault_console, "default-console");
3346 defsymbol (&Qselected_console, "selected-console");
3347 defsymbol (&Qconst_selected_console, "const-selected-console");
3350 DEFSUBR (Fintern_soft);
3351 DEFSUBR (Funintern);
3352 DEFSUBR (Fmapatoms);
3353 DEFSUBR (Fapropos_internal);
3355 DEFSUBR (Fsymbol_function);
3356 DEFSUBR (Fsymbol_plist);
3357 DEFSUBR (Fsymbol_name);
3358 DEFSUBR (Fmakunbound);
3359 DEFSUBR (Ffmakunbound);
3361 DEFSUBR (Fglobally_boundp);
3364 DEFSUBR (Fdefine_function);
3365 Ffset (intern ("defalias"), intern ("define-function"));
3366 DEFSUBR (Fsetplist);
3367 DEFSUBR (Fsymbol_value_in_buffer);
3368 DEFSUBR (Fsymbol_value_in_console);
3369 DEFSUBR (Fbuilt_in_variable_type);
3370 DEFSUBR (Fsymbol_value);
3372 DEFSUBR (Fdefault_boundp);
3373 DEFSUBR (Fdefault_value);
3374 DEFSUBR (Fset_default);
3375 DEFSUBR (Fsetq_default);
3376 DEFSUBR (Fmake_variable_buffer_local);
3377 DEFSUBR (Fmake_local_variable);
3378 DEFSUBR (Fkill_local_variable);
3379 DEFSUBR (Fkill_console_local_variable);
3380 DEFSUBR (Flocal_variable_p);
3381 DEFSUBR (Fdefvaralias);
3382 DEFSUBR (Fvariable_alias);
3383 DEFSUBR (Findirect_variable);
3384 DEFSUBR (Fdontusethis_set_symbol_value_handler);
3387 /* Create and initialize a Lisp variable whose value is forwarded to C data */
3389 defvar_magic (CONST char *symbol_name, CONST struct symbol_value_forward *magic)
3391 Lisp_Object sym, kludge;
3393 /* Check that `magic' points somewhere we can represent as a Lisp pointer */
3394 XSETOBJ (kludge, Lisp_Type_Record, magic);
3395 if ((void *)magic != (void*) XPNTR (kludge))
3397 /* This might happen on DATA_SEG_BITS machines. */
3399 /* Copy it to somewhere which is representable. */
3400 struct symbol_value_forward *p = xnew (struct symbol_value_forward);
3401 memcpy (p, magic, sizeof *magic);
3405 #if defined(HAVE_SHLIB)
3407 * As with defsubr(), this will only be called in a dumped Emacs when
3408 * we are adding variables from a dynamically loaded module. That means
3409 * we can't use purespace. Take that into account.
3412 sym = Fintern (build_string (symbol_name), Qnil);
3415 sym = Fintern (make_string_nocopy ((CONST Bufbyte *) symbol_name,
3416 strlen (symbol_name)), Qnil);
3418 XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic);
3422 vars_of_symbols (void)
3424 DEFVAR_LISP ("obarray", &Vobarray /*
3425 Symbol table for use by `intern' and `read'.
3426 It is a vector whose length ought to be prime for best results.
3427 The vector's contents don't make sense if examined from Lisp programs;
3428 to find all the symbols in an obarray, use `mapatoms'.
3430 /* obarray has been initialized long before */