1 /* "intern" and friends -- moved here from lread.c and data.c
2 Copyright (C) 1985-1989, 1992-1994 Free Software Foundation, Inc.
3 Copyright (C) 1995, 2000 Ben Wing.
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 /* Symbol plists are directly accessible, so we need to protect against
121 invalid property list structure */
124 symbol_getprop (Lisp_Object symbol, Lisp_Object property)
126 return external_plist_get (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME);
130 symbol_putprop (Lisp_Object symbol, Lisp_Object property, Lisp_Object value)
132 external_plist_put (&XSYMBOL (symbol)->plist, property, value, 0, ERROR_ME);
137 symbol_remprop (Lisp_Object symbol, Lisp_Object property)
139 return external_remprop (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME);
142 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("symbol", symbol,
143 mark_symbol, print_symbol,
144 0, 0, 0, symbol_description,
152 /**********************************************************************/
154 /**********************************************************************/
156 /* #### using a vector here is way bogus. Use a hash table instead. */
158 Lisp_Object Vobarray;
160 static Lisp_Object initial_obarray;
162 /* oblookup stores the bucket number here, for the sake of Funintern. */
164 static int oblookup_last_bucket_number;
167 check_obarray (Lisp_Object obarray)
169 while (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
171 /* If Vobarray is now invalid, force it to be valid. */
172 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
174 obarray = wrong_type_argument (Qvectorp, obarray);
180 intern (const char *str)
182 Bytecount len = strlen (str);
183 const Bufbyte *buf = (const Bufbyte *) str;
184 Lisp_Object obarray = Vobarray;
186 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
187 obarray = check_obarray (obarray);
190 Lisp_Object tem = oblookup (obarray, buf, len);
195 return Fintern (make_string (buf, len), obarray);
198 DEFUN ("intern", Fintern, 1, 2, 0, /*
199 Return the canonical symbol whose name is STRING.
200 If there is none, one is created by this function and returned.
201 Optional second argument OBARRAY specifies the obarray to use;
202 it defaults to the value of the variable `obarray'.
206 Lisp_Object object, *ptr;
210 if (NILP (obarray)) obarray = Vobarray;
211 obarray = check_obarray (obarray);
213 CHECK_STRING (string);
215 len = XSTRING_LENGTH (string);
216 object = oblookup (obarray, XSTRING_DATA (string), len);
221 ptr = &XVECTOR_DATA (obarray)[XINT (object)];
223 object = Fmake_symbol (string);
224 symbol = XSYMBOL (object);
227 symbol_next (symbol) = XSYMBOL (*ptr);
229 symbol_next (symbol) = 0;
232 if (string_byte (symbol_name (symbol), 0) == ':' && EQ (obarray, Vobarray))
234 /* The LISP way is to put keywords in their own package, but we
235 don't have packages, so we do something simpler. Someday,
236 maybe we'll have packages and then this will be reworked.
238 symbol_value (symbol) = object;
244 DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /*
245 Return the canonical symbol named NAME, or nil if none exists.
246 NAME may be a string or a symbol. If it is a symbol, that exact
247 symbol is searched for.
248 Optional second argument OBARRAY specifies the obarray to use;
249 it defaults to the value of the variable `obarray'.
253 /* #### Bug! (intern-soft "nil") returns nil. Perhaps we should
254 add a DEFAULT-IF-NOT-FOUND arg, like in get. */
258 if (NILP (obarray)) obarray = Vobarray;
259 obarray = check_obarray (obarray);
264 string = XSTRING (name);
267 string = symbol_name (XSYMBOL (name));
269 tem = oblookup (obarray, string_data (string), string_length (string));
270 if (INTP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
276 DEFUN ("unintern", Funintern, 1, 2, 0, /*
277 Delete the symbol named NAME, if any, from OBARRAY.
278 The value is t if a symbol was found and deleted, nil otherwise.
279 NAME may be a string or a symbol. If it is a symbol, that symbol
280 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
281 OBARRAY defaults to the value of the variable `obarray'.
289 if (NILP (obarray)) obarray = Vobarray;
290 obarray = check_obarray (obarray);
293 string = symbol_name (XSYMBOL (name));
297 string = XSTRING (name);
300 tem = oblookup (obarray, string_data (string), string_length (string));
303 /* If arg was a symbol, don't delete anything but that symbol itself. */
304 if (SYMBOLP (name) && !EQ (name, tem))
307 hash = oblookup_last_bucket_number;
309 if (EQ (XVECTOR_DATA (obarray)[hash], tem))
311 if (XSYMBOL (tem)->next)
312 XSETSYMBOL (XVECTOR_DATA (obarray)[hash], XSYMBOL (tem)->next);
314 XVECTOR_DATA (obarray)[hash] = Qzero;
318 Lisp_Object tail, following;
320 for (tail = XVECTOR_DATA (obarray)[hash];
321 XSYMBOL (tail)->next;
324 XSETSYMBOL (following, XSYMBOL (tail)->next);
325 if (EQ (following, tem))
327 XSYMBOL (tail)->next = XSYMBOL (following)->next;
335 /* Return the symbol in OBARRAY whose names matches the string
336 of SIZE characters at PTR. If there is no such symbol in OBARRAY,
337 return the index into OBARRAY that the string hashes to.
339 Also store the bucket number in oblookup_last_bucket_number. */
342 oblookup (Lisp_Object obarray, const Bufbyte *ptr, Bytecount size)
348 if (!VECTORP (obarray) ||
349 (obsize = XVECTOR_LENGTH (obarray)) == 0)
351 obarray = check_obarray (obarray);
352 obsize = XVECTOR_LENGTH (obarray);
354 hash = hash_string (ptr, size) % obsize;
355 oblookup_last_bucket_number = hash;
356 bucket = XVECTOR_DATA (obarray)[hash];
359 else if (!SYMBOLP (bucket))
360 error ("Bad data in guts of obarray"); /* Like CADR error message */
362 for (tail = XSYMBOL (bucket); ;)
364 if (string_length (tail->name) == size &&
365 !memcmp (string_data (tail->name), ptr, size))
367 XSETSYMBOL (bucket, tail);
370 tail = symbol_next (tail);
374 return make_int (hash);
377 #if 0 /* Emacs 19.34 */
379 hash_string (const Bufbyte *ptr, Bytecount len)
381 const Bufbyte *p = ptr;
382 const Bufbyte *end = p + len;
389 if (c >= 0140) c -= 40;
390 hash = ((hash<<3) + (hash>>28) + c);
392 return hash & 07777777777;
396 /* derived from hashpjw, Dragon Book P436. */
398 hash_string (const Bufbyte *ptr, Bytecount len)
405 hash = (hash << 4) + *ptr++;
406 g = hash & 0xf0000000;
408 hash = (hash ^ (g >> 24)) ^ g;
410 return hash & 07777777777;
413 /* Map FN over OBARRAY. The mapping is stopped when FN returns a
416 map_obarray (Lisp_Object obarray,
417 int (*fn) (Lisp_Object, void *), void *arg)
421 CHECK_VECTOR (obarray);
422 for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--)
424 Lisp_Object tail = XVECTOR_DATA (obarray)[i];
429 if ((*fn) (tail, arg))
431 next = symbol_next (XSYMBOL (tail));
434 XSETSYMBOL (tail, next);
440 mapatoms_1 (Lisp_Object sym, void *arg)
442 call1 (*(Lisp_Object *)arg, sym);
446 DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /*
447 Call FUNCTION on every symbol in OBARRAY.
448 OBARRAY defaults to the value of `obarray'.
456 obarray = check_obarray (obarray);
459 map_obarray (obarray, mapatoms_1, &function);
465 /**********************************************************************/
467 /**********************************************************************/
469 struct appropos_mapper_closure
472 Lisp_Object predicate;
473 Lisp_Object accumulation;
477 apropos_mapper (Lisp_Object symbol, void *arg)
479 struct appropos_mapper_closure *closure =
480 (struct appropos_mapper_closure *) arg;
481 Bytecount match = fast_lisp_string_match (closure->regexp,
482 Fsymbol_name (symbol));
485 (NILP (closure->predicate) ||
486 !NILP (call1 (closure->predicate, symbol))))
487 closure->accumulation = Fcons (symbol, closure->accumulation);
492 DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /*
493 Return a list of all symbols whose names contain match for REGEXP.
494 If optional 2nd arg PREDICATE is non-nil, only symbols for which
495 \(funcall PREDICATE SYMBOL) returns non-nil are returned.
499 struct appropos_mapper_closure closure;
502 CHECK_STRING (regexp);
504 closure.regexp = regexp;
505 closure.predicate = predicate;
506 closure.accumulation = Qnil;
507 GCPRO1 (closure.accumulation);
508 map_obarray (Vobarray, apropos_mapper, &closure);
509 closure.accumulation = Fsort (closure.accumulation, Qstring_lessp);
511 return closure.accumulation;
515 /* Extract and set components of symbols */
517 static void set_up_buffer_local_cache (Lisp_Object sym,
518 struct symbol_value_buffer_local *bfwd,
520 Lisp_Object new_alist_el,
523 DEFUN ("boundp", Fboundp, 1, 1, 0, /*
524 Return t if SYMBOL's value is not void.
528 CHECK_SYMBOL (symbol);
529 return UNBOUNDP (find_symbol_value (symbol)) ? Qnil : Qt;
532 DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /*
533 Return t if SYMBOL has a global (non-bound) value.
534 This is for the byte-compiler; you really shouldn't be using this.
538 CHECK_SYMBOL (symbol);
539 return UNBOUNDP (top_level_value (symbol)) ? Qnil : Qt;
542 DEFUN ("fboundp", Ffboundp, 1, 1, 0, /*
543 Return t if SYMBOL's function definition is not void.
547 CHECK_SYMBOL (symbol);
548 return UNBOUNDP (XSYMBOL (symbol)->function) ? Qnil : Qt;
551 /* Return non-zero if SYM's value or function (the current contents of
552 which should be passed in as VAL) is constant, i.e. unsettable. */
555 symbol_is_constant (Lisp_Object sym, Lisp_Object val)
557 /* #### - I wonder if it would be better to just have a new magic value
558 type and make nil, t, and all keywords have that same magic
559 constant_symbol value. This test is awfully specific about what is
560 constant and what isn't. --Stig */
561 if (EQ (sym, Qnil) ||
565 if (SYMBOL_VALUE_MAGIC_P (val))
566 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
568 case SYMVAL_CONST_OBJECT_FORWARD:
569 case SYMVAL_CONST_SPECIFIER_FORWARD:
570 case SYMVAL_CONST_FIXNUM_FORWARD:
571 case SYMVAL_CONST_BOOLEAN_FORWARD:
572 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
573 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
575 default: break; /* Warning suppression */
578 /* We don't return true for keywords here because they are handled
579 specially by reject_constant_symbols(). */
583 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
584 non-zero) to NEWVAL. Make sure this is allowed.
585 FOLLOW_PAST_LISP_MAGIC specifies whether we delve past
586 symbol-value-lisp-magic objects. */
589 reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p,
590 Lisp_Object follow_past_lisp_magic)
593 (function_p ? XSYMBOL (sym)->function
594 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
596 if (SYMBOL_VALUE_MAGIC_P (val) &&
597 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
598 signal_simple_error ("Use `set-specifier' to change a specifier's value",
601 if (symbol_is_constant (sym, val)
602 || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)))
603 signal_error (Qsetting_constant,
604 UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
607 /* Verify that it's ok to make SYM buffer-local. This rejects
608 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC
609 specifies whether we delve into symbol-value-lisp-magic objects.
610 (Should be a symbol indicating what action is being taken; that way,
611 we don't delve if there's a handler for that action, but do otherwise.) */
614 verify_ok_for_buffer_local (Lisp_Object sym,
615 Lisp_Object follow_past_lisp_magic)
617 Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic);
619 if (symbol_is_constant (sym, val))
621 if (SYMBOL_VALUE_MAGIC_P (val))
622 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
624 case SYMVAL_DEFAULT_BUFFER_FORWARD:
625 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
626 /* #### It's theoretically possible for it to be reasonable
627 to have both console-local and buffer-local variables,
628 but I don't want to consider that right now. */
629 case SYMVAL_SELECTED_CONSOLE_FORWARD:
631 default: break; /* Warning suppression */
637 signal_error (Qerror,
638 list2 (build_string ("Symbol may not be buffer-local"), sym));
641 DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /*
642 Make SYMBOL's value be void.
646 Fset (symbol, Qunbound);
650 DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /*
651 Make SYMBOL's function definition be void.
655 CHECK_SYMBOL (symbol);
656 reject_constant_symbols (symbol, Qunbound, 1, Qt);
657 XSYMBOL (symbol)->function = Qunbound;
661 DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /*
662 Return SYMBOL's function definition. Error if that is void.
666 CHECK_SYMBOL (symbol);
667 if (UNBOUNDP (XSYMBOL (symbol)->function))
668 signal_void_function_error (symbol);
669 return XSYMBOL (symbol)->function;
672 DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /*
673 Return SYMBOL's property list.
677 CHECK_SYMBOL (symbol);
678 return XSYMBOL (symbol)->plist;
681 DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /*
682 Return SYMBOL's name, a string.
688 CHECK_SYMBOL (symbol);
689 XSETSTRING (name, XSYMBOL (symbol)->name);
693 DEFUN ("fset", Ffset, 2, 2, 0, /*
694 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
698 /* This function can GC */
699 CHECK_SYMBOL (symbol);
700 reject_constant_symbols (symbol, newdef, 1, Qt);
701 if (!NILP (Vautoload_queue) && !UNBOUNDP (XSYMBOL (symbol)->function))
702 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
704 XSYMBOL (symbol)->function = newdef;
705 /* Handle automatic advice activation */
706 if (CONSP (XSYMBOL (symbol)->plist) &&
707 !NILP (Fget (symbol, Qad_advice_info, Qnil)))
709 call2 (Qad_activate, symbol, Qnil);
710 newdef = XSYMBOL (symbol)->function;
716 DEFUN ("define-function", Fdefine_function, 2, 2, 0, /*
717 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
718 Associates the function with the current load file, if any.
722 /* This function can GC */
723 Ffset (symbol, newdef);
724 LOADHIST_ATTACH (symbol);
729 DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
730 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
734 CHECK_SYMBOL (symbol);
735 #if 0 /* Inserted for debugging 6/28/1997 -slb */
736 /* Somebody is setting a property list of integer 0, who? */
737 /* Not this way apparently. */
738 if (EQ(newplist, Qzero)) abort();
741 XSYMBOL (symbol)->plist = newplist;
746 /**********************************************************************/
748 /**********************************************************************/
750 /* If the contents of the value cell of a symbol is one of the following
751 three types of objects, then the symbol is "magic" in that setting
752 and retrieving its value doesn't just set or retrieve the raw
753 contents of the value cell. None of these objects can escape to
754 the user level, so there is no loss of generality.
756 If a symbol is "unbound", then the contents of its value cell is
757 Qunbound. Despite appearances, this is *not* a symbol, but is a
758 symbol-value-forward object. This is so that printing it results
759 in "INTERNAL OBJECT (XEmacs bug?)", in case it leaks to Lisp, somehow.
761 Logically all of the following objects are "symbol-value-magic"
762 objects, and there are some games played w.r.t. this (#### this
763 should be cleaned up). SYMBOL_VALUE_MAGIC_P is true for all of
764 the object types. XSYMBOL_VALUE_MAGIC_TYPE returns the type of
765 symbol-value-magic object. There are more than three types
766 returned by this macro: in particular, symbol-value-forward
767 has eight subtypes, and symbol-value-buffer-local has two. See
770 1. symbol-value-forward
772 symbol-value-forward is used for variables whose actual contents
773 are stored in a C variable of some sort, and for Qunbound. The
774 lcheader.next field (which is only used to chain together free
775 lcrecords) holds a pointer to the actual C variable. Included
776 in this type are "buffer-local" variables that are actually
777 stored in the buffer object itself; in this case, the "pointer"
778 is an offset into the struct buffer structure.
780 The subtypes are as follows:
782 SYMVAL_OBJECT_FORWARD:
783 (declare with DEFVAR_LISP)
784 The value of this variable is stored in a C variable of type
785 "Lisp_Object". Setting this variable sets the C variable.
786 Accessing this variable retrieves a value from the C variable.
787 These variables can be buffer-local -- in this case, the
788 raw symbol-value field gets converted into a
789 symbol-value-buffer-local, whose "current_value" slot contains
790 the symbol-value-forward. (See below.)
792 SYMVAL_FIXNUM_FORWARD:
793 (declare with DEFVAR_INT)
794 Similar to SYMVAL_OBJECT_FORWARD except that the C variable
795 is of type "Fixnum", a typedef for "EMACS_INT", and the corresponding
796 lisp variable is always the corresponding integer.
798 SYMVAL_BOOLEAN_FORWARD:
799 (declare with DEFVAR_BOOL)
800 Similar to SYMVAL_OBJECT_FORWARD except that the C variable
801 is of type "int" and is a boolean.
803 SYMVAL_CONST_OBJECT_FORWARD:
804 SYMVAL_CONST_FIXNUM_FORWARD:
805 SYMVAL_CONST_BOOLEAN_FORWARD:
806 (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
808 Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
809 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
812 SYMVAL_CONST_SPECIFIER_FORWARD:
813 (declare with DEFVAR_SPECIFIER)
814 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that the error
815 message you get when attempting to set the value says to use
816 `set-specifier' instead.
818 SYMVAL_CURRENT_BUFFER_FORWARD:
819 (declare with DEFVAR_BUFFER_LOCAL)
820 This is used for built-in buffer-local variables -- i.e.
821 Lisp variables whose value is stored in the "struct buffer".
822 Variables of this sort always forward into C "Lisp_Object"
823 fields (although there's no reason in principle that other
824 types for ints and booleans couldn't be added). Note that
825 some of these variables are automatically local in each
826 buffer, while some are only local when they become set
827 (similar to `make-variable-buffer-local'). In these latter
828 cases, of course, the default value shows through in all
829 buffers in which the variable doesn't have a local value.
830 This is implemented by making sure the "struct buffer" field
831 always contains the correct value (whether it's local or
832 a default) and maintaining a mask in the "struct buffer"
833 indicating which fields are local. When `set-default' is
834 called on a variable that's not always local to all buffers,
835 it loops through each buffer and sets the corresponding
836 field in each buffer without a local value for the field,
837 according to the mask.
839 Calling `make-local-variable' on a variable of this sort
840 only has the effect of maybe changing the current buffer's mask.
841 Calling `make-variable-buffer-local' on a variable of this
842 sort has no effect at all.
844 SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
845 (declare with DEFVAR_CONST_BUFFER_LOCAL)
846 Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
849 SYMVAL_DEFAULT_BUFFER_FORWARD:
850 (declare with DEFVAR_BUFFER_DEFAULTS)
851 This is used for the Lisp variables that contain the
852 default values of built-in buffer-local variables. Setting
853 or referencing one of these variables forwards into a slot
854 in the special struct buffer Vbuffer_defaults.
856 SYMVAL_UNBOUND_MARKER:
857 This is used for only one object, Qunbound.
859 SYMVAL_SELECTED_CONSOLE_FORWARD:
860 (declare with DEFVAR_CONSOLE_LOCAL)
861 This is used for built-in console-local variables -- i.e.
862 Lisp variables whose value is stored in the "struct console".
863 These work just like built-in buffer-local variables.
864 However, calling `make-local-variable' or
865 `make-variable-buffer-local' on one of these variables
866 is currently disallowed because that would entail having
867 both console-local and buffer-local variables, which is
868 trickier to implement.
870 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
871 (declare with DEFVAR_CONST_CONSOLE_LOCAL)
872 Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
875 SYMVAL_DEFAULT_CONSOLE_FORWARD:
876 (declare with DEFVAR_CONSOLE_DEFAULTS)
877 This is used for the Lisp variables that contain the
878 default values of built-in console-local variables. Setting
879 or referencing one of these variables forwards into a slot
880 in the special struct console Vconsole_defaults.
883 2. symbol-value-buffer-local
885 symbol-value-buffer-local is used for variables that have had
886 `make-local-variable' or `make-variable-buffer-local' applied
887 to them. This object contains an alist mapping buffers to
888 values. In addition, the object contains a "current value",
889 which is the value in some buffer. Whenever you access the
890 variable with `symbol-value' or set it with `set' or `setq',
891 things are switched around so that the "current value"
892 refers to the current buffer, if it wasn't already. This
893 way, repeated references to a variable in the same buffer
894 are almost as efficient as if the variable weren't buffer
895 local. Note that the alist may not be up-to-date w.r.t.
896 the buffer whose value is current, as the "current value"
897 cache is normally only flushed into the alist when the
898 buffer it refers to changes.
900 Note also that it is possible for `make-local-variable'
901 or `make-variable-buffer-local' to be called on a variable
902 that forwards into a C variable (i.e. a variable whose
903 value cell is a symbol-value-forward). In this case,
904 the value cell becomes a symbol-value-buffer-local (as
905 always), and the symbol-value-forward moves into
906 the "current value" cell in this object. Also, in
907 this case the "current value" *always* refers to the
908 current buffer, so that the values of the C variable
909 always is the correct value for the current buffer.
910 set_buffer_internal() automatically updates the current-value
911 cells of all buffer-local variables that forward into C
912 variables. (There is a list of all buffer-local variables
913 that is maintained for this and other purposes.)
915 Note that only certain types of `symbol-value-forward' objects
916 can find their way into the "current value" cell of a
917 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
918 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
919 SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot
920 be buffer-local because they are unsettable;
921 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
922 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
923 does not have much of an effect (it's already buffer-local); and
924 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
925 that's not currently implemented.
928 3. symbol-value-varalias
930 A symbol-value-varalias object is used for variables that
931 are aliases for other variables. This object contains
932 the symbol that this variable is aliased to.
933 symbol-value-varalias objects cannot occur anywhere within
934 a symbol-value-buffer-local object, and most of the
935 low-level functions below do not accept them; you need
936 to call follow_varalias_pointers to get the actual
937 symbol to operate on. */
940 mark_symbol_value_buffer_local (Lisp_Object obj)
942 struct symbol_value_buffer_local *bfwd;
944 #ifdef ERROR_CHECK_TYPECHECK
945 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
946 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
949 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
950 mark_object (bfwd->default_value);
951 mark_object (bfwd->current_value);
952 mark_object (bfwd->current_buffer);
953 return bfwd->current_alist_element;
957 mark_symbol_value_lisp_magic (Lisp_Object obj)
959 struct symbol_value_lisp_magic *bfwd;
962 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
964 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
965 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
967 mark_object (bfwd->handler[i]);
968 mark_object (bfwd->harg[i]);
970 return bfwd->shadowed;
974 mark_symbol_value_varalias (Lisp_Object obj)
976 struct symbol_value_varalias *bfwd;
978 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
980 bfwd = XSYMBOL_VALUE_VARALIAS (obj);
981 mark_object (bfwd->shadowed);
982 return bfwd->aliasee;
985 /* Should never, ever be called. (except by an external debugger) */
987 print_symbol_value_magic (Lisp_Object obj,
988 Lisp_Object printcharfun, int escapeflag)
991 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s type %d) 0x%lx>",
992 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
993 XSYMBOL_VALUE_MAGIC_TYPE (obj),
995 write_c_string (buf, printcharfun);
998 static const struct lrecord_description symbol_value_forward_description[] = {
1002 static const struct lrecord_description symbol_value_buffer_local_description[] = {
1003 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, default_value) },
1004 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_value) },
1005 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_buffer) },
1006 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_alist_element) },
1010 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
1011 { XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 },
1015 static const struct lrecord_description symbol_value_varalias_description[] = {
1016 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, aliasee) },
1017 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, shadowed) },
1021 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
1022 symbol_value_forward,
1024 print_symbol_value_magic, 0, 0, 0,
1025 symbol_value_forward_description,
1026 struct symbol_value_forward);
1028 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
1029 symbol_value_buffer_local,
1030 mark_symbol_value_buffer_local,
1031 print_symbol_value_magic, 0, 0, 0,
1032 symbol_value_buffer_local_description,
1033 struct symbol_value_buffer_local);
1035 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
1036 symbol_value_lisp_magic,
1037 mark_symbol_value_lisp_magic,
1038 print_symbol_value_magic, 0, 0, 0,
1039 symbol_value_lisp_magic_description,
1040 struct symbol_value_lisp_magic);
1042 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
1043 symbol_value_varalias,
1044 mark_symbol_value_varalias,
1045 print_symbol_value_magic, 0, 0, 0,
1046 symbol_value_varalias_description,
1047 struct symbol_value_varalias);
1050 /* Getting and setting values of symbols */
1052 /* Given the raw contents of a symbol value cell, return the Lisp value of
1053 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
1054 symbol-value-lisp-magic, or symbol-value-varalias.
1056 BUFFER specifies a buffer, and is used for built-in buffer-local
1057 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
1058 Note that such variables are never encapsulated in a
1059 symbol-value-buffer-local structure.
1061 CONSOLE specifies a console, and is used for built-in console-local
1062 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
1063 Note that such variables are (currently) never encapsulated in a
1064 symbol-value-buffer-local structure.
1068 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
1069 struct console *console)
1071 const struct symbol_value_forward *fwd;
1073 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1076 fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1077 switch (fwd->magic.type)
1079 case SYMVAL_FIXNUM_FORWARD:
1080 case SYMVAL_CONST_FIXNUM_FORWARD:
1081 return make_int (*((Fixnum *)symbol_value_forward_forward (fwd)));
1083 case SYMVAL_BOOLEAN_FORWARD:
1084 case SYMVAL_CONST_BOOLEAN_FORWARD:
1085 return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
1087 case SYMVAL_OBJECT_FORWARD:
1088 case SYMVAL_CONST_OBJECT_FORWARD:
1089 case SYMVAL_CONST_SPECIFIER_FORWARD:
1090 return *((Lisp_Object *)symbol_value_forward_forward (fwd));
1092 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1093 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1094 + ((char *)symbol_value_forward_forward (fwd)
1095 - (char *)&buffer_local_flags))));
1098 case SYMVAL_CURRENT_BUFFER_FORWARD:
1099 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1101 return (*((Lisp_Object *)((char *)buffer
1102 + ((char *)symbol_value_forward_forward (fwd)
1103 - (char *)&buffer_local_flags))));
1105 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1106 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1107 + ((char *)symbol_value_forward_forward (fwd)
1108 - (char *)&console_local_flags))));
1110 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1111 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1113 return (*((Lisp_Object *)((char *)console
1114 + ((char *)symbol_value_forward_forward (fwd)
1115 - (char *)&console_local_flags))));
1117 case SYMVAL_UNBOUND_MARKER:
1123 return Qnil; /* suppress compiler warning */
1126 /* Set the value of default-buffer-local variable SYM to VALUE. */
1129 set_default_buffer_slot_variable (Lisp_Object sym,
1132 /* Handle variables like case-fold-search that have special slots in
1133 the buffer. Make them work apparently like buffer_local variables.
1135 /* At this point, the value cell may not contain a symbol-value-varalias
1136 or symbol-value-buffer-local, and if there's a handler, we should
1137 have already called it. */
1138 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1139 const struct symbol_value_forward *fwd
1140 = XSYMBOL_VALUE_FORWARD (valcontents);
1141 int offset = ((char *) symbol_value_forward_forward (fwd)
1142 - (char *) &buffer_local_flags);
1143 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1144 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1145 int flags) = symbol_value_forward_magicfun (fwd);
1147 *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
1150 if (mask > 0) /* Not always per-buffer */
1152 /* Set value in each buffer which hasn't shadowed the default */
1153 LIST_LOOP_2 (elt, Vbuffer_alist)
1155 struct buffer *b = XBUFFER (XCDR (elt));
1156 if (!(b->local_var_flags & mask))
1159 magicfun (sym, &value, make_buffer (b), 0);
1160 *((Lisp_Object *) (offset + (char *) b)) = value;
1166 /* Set the value of default-console-local variable SYM to VALUE. */
1169 set_default_console_slot_variable (Lisp_Object sym,
1172 /* Handle variables like case-fold-search that have special slots in
1173 the console. Make them work apparently like console_local variables.
1175 /* At this point, the value cell may not contain a symbol-value-varalias
1176 or symbol-value-buffer-local, and if there's a handler, we should
1177 have already called it. */
1178 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1179 const struct symbol_value_forward *fwd
1180 = XSYMBOL_VALUE_FORWARD (valcontents);
1181 int offset = ((char *) symbol_value_forward_forward (fwd)
1182 - (char *) &console_local_flags);
1183 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1184 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1185 int flags) = symbol_value_forward_magicfun (fwd);
1187 *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
1190 if (mask > 0) /* Not always per-console */
1192 /* Set value in each console which hasn't shadowed the default */
1193 LIST_LOOP_2 (console, Vconsole_list)
1195 struct console *d = XCONSOLE (console);
1196 if (!(d->local_var_flags & mask))
1199 magicfun (sym, &value, console, 0);
1200 *((Lisp_Object *) (offset + (char *) d)) = value;
1206 /* Store NEWVAL into SYM.
1208 SYM's value slot may *not* be types (5) or (6) above,
1209 i.e. no symbol-value-varalias objects. (You should have
1210 forwarded past all of these.)
1212 SYM should not be an unsettable symbol or a symbol with
1213 a magic `set-value' handler (unless you want to explicitly
1214 ignore this handler).
1216 OVALUE is the current value of SYM, but forwarded past any
1217 symbol-value-buffer-local and symbol-value-lisp-magic objects.
1218 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1219 the contents of its current-value cell.) NEWVAL may only be
1220 a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
1221 this function will only modify its current-value cell, which should
1222 already be set up to point to the current buffer.
1226 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
1229 if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
1231 Lisp_Object *store_pointer = value_slot_past_magic (sym);
1233 if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
1235 &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
1237 assert (UNBOUNDP (*store_pointer)
1238 || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1239 *store_pointer = newval;
1243 const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue);
1244 int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
1245 Lisp_Object in_object, int flags)
1246 = symbol_value_forward_magicfun (fwd);
1248 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue))
1250 case SYMVAL_FIXNUM_FORWARD:
1253 magicfun (sym, &newval, Qnil, 0);
1254 *((Fixnum *) symbol_value_forward_forward (fwd)) = XINT (newval);
1257 case SYMVAL_BOOLEAN_FORWARD:
1259 magicfun (sym, &newval, Qnil, 0);
1260 *((int *) symbol_value_forward_forward (fwd))
1264 case SYMVAL_OBJECT_FORWARD:
1266 magicfun (sym, &newval, Qnil, 0);
1267 *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
1270 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1271 set_default_buffer_slot_variable (sym, newval);
1274 case SYMVAL_CURRENT_BUFFER_FORWARD:
1276 magicfun (sym, &newval, make_buffer (current_buffer), 0);
1277 *((Lisp_Object *) ((char *) current_buffer
1278 + ((char *) symbol_value_forward_forward (fwd)
1279 - (char *) &buffer_local_flags)))
1283 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1284 set_default_console_slot_variable (sym, newval);
1287 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1289 magicfun (sym, &newval, Vselected_console, 0);
1290 *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console)
1291 + ((char *) symbol_value_forward_forward (fwd)
1292 - (char *) &console_local_flags)))
1302 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1303 BFWD, locate and return a pointer to the element in BUFFER's
1304 local_var_alist for SYMBOL. The return value will be Qnil if
1305 BUFFER does not have its own value for SYMBOL (i.e. the default
1306 value is seen in that buffer).
1310 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
1311 struct symbol_value_buffer_local *bfwd)
1313 if (!NILP (bfwd->current_buffer) &&
1314 XBUFFER (bfwd->current_buffer) == buffer)
1315 /* This is just an optimization of the below. */
1316 return bfwd->current_alist_element;
1318 return assq_no_quit (symbol, buffer->local_var_alist);
1321 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1322 symbol-value-buffer-local of a per-buffer variable -- i.e. the
1323 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1324 slot -- may be out of date.]
1326 Write out any cached value in buffer-local variable SYMBOL's
1327 buffer-local structure, which is passed in as BFWD.
1331 write_out_buffer_local_cache (Lisp_Object symbol,
1332 struct symbol_value_buffer_local *bfwd)
1334 if (!NILP (bfwd->current_buffer))
1336 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1337 uses it, and that type cannot be inside a symbol-value-buffer-local */
1338 Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0);
1339 if (NILP (bfwd->current_alist_element))
1340 /* current_value may be updated more recently than default_value */
1341 bfwd->default_value = cval;
1343 Fsetcdr (bfwd->current_alist_element, cval);
1347 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1348 Set up BFWD's cache for validity in buffer BUF. This assumes that
1349 the cache is currently in a consistent state (this can include
1350 not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1352 If the cache is already set up for BUF, this function does nothing
1355 Otherwise, if SYM forwards out to a C variable, this also forwards
1356 SYM's value in BUF out to the variable. Therefore, you generally
1357 only want to call this when BUF is, or is about to become, the
1360 (Otherwise, you can just retrieve the value without changing the
1361 cache, at the expense of slower retrieval.)
1365 set_up_buffer_local_cache (Lisp_Object sym,
1366 struct symbol_value_buffer_local *bfwd,
1368 Lisp_Object new_alist_el,
1371 Lisp_Object new_val;
1373 if (!NILP (bfwd->current_buffer)
1374 && buf == XBUFFER (bfwd->current_buffer))
1375 /* Cache is already set up. */
1378 /* Flush out the old cache. */
1379 write_out_buffer_local_cache (sym, bfwd);
1381 /* Retrieve the new alist element and new value. */
1382 if (NILP (new_alist_el)
1384 new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1386 if (NILP (new_alist_el))
1387 new_val = bfwd->default_value;
1389 new_val = Fcdr (new_alist_el);
1391 bfwd->current_alist_element = new_alist_el;
1392 XSETBUFFER (bfwd->current_buffer, buf);
1394 /* Now store the value into the current-value slot.
1395 We don't simply write it there, because the current-value
1396 slot might be a forwarding pointer, in which case we need
1397 to instead write the value into the C variable.
1399 We might also want to call a magic function.
1401 So instead, we call this function. */
1402 store_symval_forwarding (sym, bfwd->current_value, new_val);
1406 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1407 Flush the cache. BFWD->CURRENT_BUFFER will be nil after this operation.
1411 flush_buffer_local_cache (Lisp_Object sym,
1412 struct symbol_value_buffer_local *bfwd)
1414 if (NILP (bfwd->current_buffer))
1415 /* Cache is already flushed. */
1418 /* Flush out the old cache. */
1419 write_out_buffer_local_cache (sym, bfwd);
1421 bfwd->current_alist_element = Qnil;
1422 bfwd->current_buffer = Qnil;
1424 /* Now store default the value into the current-value slot.
1425 We don't simply write it there, because the current-value
1426 slot might be a forwarding pointer, in which case we need
1427 to instead write the value into the C variable.
1429 We might also want to call a magic function.
1431 So instead, we call this function. */
1432 store_symval_forwarding (sym, bfwd->current_value, bfwd->default_value);
1435 /* Flush all the buffer-local variable caches. Whoever has a
1436 non-interned buffer-local variable will be spanked. Whoever has a
1437 magic variable that interns or uninterns symbols... I don't even
1438 want to think about it.
1442 flush_all_buffer_local_cache (void)
1444 Lisp_Object *syms = XVECTOR_DATA (Vobarray);
1445 long count = XVECTOR_LENGTH (Vobarray);
1448 for (i=0; i<count; i++)
1450 Lisp_Object sym = syms[i];
1457 assert (SYMBOLP (sym));
1458 value = fetch_value_maybe_past_magic (sym, Qt);
1459 if (SYMBOL_VALUE_BUFFER_LOCAL_P (value))
1460 flush_buffer_local_cache (sym, XSYMBOL_VALUE_BUFFER_LOCAL (value));
1462 next = symbol_next (XSYMBOL (sym));
1465 XSETSYMBOL (sym, next);
1472 kill_buffer_local_variables (struct buffer *buf)
1474 Lisp_Object prev = Qnil;
1477 /* Any which are supposed to be permanent,
1478 make local again, with the same values they had. */
1480 for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
1482 Lisp_Object sym = XCAR (XCAR (alist));
1483 struct symbol_value_buffer_local *bfwd;
1484 /* Variables with a symbol-value-varalias should not be here
1485 (we should have forwarded past them) and there must be a
1486 symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
1487 just forward past it; if the variable has a handler, it was
1489 Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
1491 assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
1492 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
1494 if (!NILP (Fget (sym, Qpermanent_local, Qnil)))
1495 /* prev points to the last alist element that is still
1496 staying around, so *only* update it now. This didn't
1497 used to be the case; this bug has been around since
1498 mly's rewrite two years ago! */
1502 /* Really truly kill it. */
1504 XCDR (prev) = XCDR (alist);
1506 buf->local_var_alist = XCDR (alist);
1508 /* We just effectively changed the value for this variable
1511 /* (1) If the cache is caching BUF, invalidate the cache. */
1512 if (!NILP (bfwd->current_buffer) &&
1513 buf == XBUFFER (bfwd->current_buffer))
1514 bfwd->current_buffer = Qnil;
1516 /* (2) If we changed the value in current_buffer and this
1517 variable forwards to a C variable, we need to change the
1518 value of the C variable. set_up_buffer_local_cache()
1519 will do this. It doesn't hurt to do it whenever
1520 BUF == current_buffer, so just go ahead and do that. */
1521 if (buf == current_buffer)
1522 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
1528 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1529 struct console *con, int swap_it_in,
1530 Lisp_Object symcons, int set_it_p)
1532 Lisp_Object valcontents;
1535 valcontents = XSYMBOL (sym)->value;
1538 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1541 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1543 case SYMVAL_LISP_MAGIC:
1545 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1549 case SYMVAL_VARALIAS:
1550 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1552 /* presto change-o! */
1555 case SYMVAL_BUFFER_LOCAL:
1556 case SYMVAL_SOME_BUFFER_LOCAL:
1558 struct symbol_value_buffer_local *bfwd
1559 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1563 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1564 valcontents = bfwd->current_value;
1568 if (!NILP (bfwd->current_buffer) &&
1569 buf == XBUFFER (bfwd->current_buffer))
1570 valcontents = bfwd->current_value;
1571 else if (NILP (symcons))
1574 valcontents = assq_no_quit (sym, buf->local_var_alist);
1575 if (NILP (valcontents))
1576 valcontents = bfwd->default_value;
1578 valcontents = XCDR (valcontents);
1581 valcontents = XCDR (symcons);
1589 return do_symval_forwarding (valcontents, buf, con);
1593 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1594 bound. Note that it must not be possible to QUIT within this
1598 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
1605 buf = current_buffer;
1608 CHECK_BUFFER (buffer);
1609 buf = XBUFFER (buffer);
1612 return find_symbol_value_1 (sym, buf,
1613 /* If it bombs out at startup due to a
1614 Lisp error, this may be nil. */
1615 CONSOLEP (Vselected_console)
1616 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
1620 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1625 console = Vselected_console;
1627 CHECK_CONSOLE (console);
1629 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1633 /* Return the current value of SYM. The difference between this function
1634 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1635 this updates the CURRENT_VALUE slot of buffer-local variables to
1636 point to the current buffer, while symbol_value_in_buffer doesn't. */
1639 find_symbol_value (Lisp_Object sym)
1641 /* WARNING: This function can be called when current_buffer is 0
1642 and Vselected_console is Qnil, early in initialization. */
1643 struct console *con;
1644 Lisp_Object valcontents;
1648 valcontents = XSYMBOL (sym)->value;
1649 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1652 if (CONSOLEP (Vselected_console))
1653 con = XCONSOLE (Vselected_console);
1656 /* This can also get called while we're preparing to shutdown.
1657 #### What should really happen in that case? Should we
1658 actually fix things so we can't get here in that case? */
1660 assert (!initialized || preparing_for_armageddon);
1665 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
1668 /* This is an optimized function for quick lookup of buffer local symbols
1669 by avoiding O(n) search. This will work when either:
1670 a) We have already found the symbol e.g. by traversing local_var_alist.
1672 b) We know that the symbol will not be found in the current buffer's
1673 list of local variables.
1674 In the former case, find_it_p is 1 and symbol_cons is the element from
1675 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1678 This function is called from set_buffer_internal which does both of these
1682 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1684 /* WARNING: This function can be called when current_buffer is 0
1685 and Vselected_console is Qnil, early in initialization. */
1686 struct console *con;
1687 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1690 if (CONSOLEP (Vselected_console))
1691 con = XCONSOLE (Vselected_console);
1694 /* This can also get called while we're preparing to shutdown.
1695 #### What should really happen in that case? Should we
1696 actually fix things so we can't get here in that case? */
1698 assert (!initialized || preparing_for_armageddon);
1703 return find_symbol_value_1 (sym, current_buffer, con, 1,
1704 find_it_p ? symbol_cons : Qnil,
1708 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1709 Return SYMBOL's value. Error if that is void.
1713 Lisp_Object val = find_symbol_value (symbol);
1716 return Fsignal (Qvoid_variable, list1 (symbol));
1721 DEFUN ("set", Fset, 2, 2, 0, /*
1722 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1726 REGISTER Lisp_Object valcontents;
1728 /* remember, we're called by Fmakunbound() as well */
1730 CHECK_SYMBOL (symbol);
1733 sym = XSYMBOL (symbol);
1734 valcontents = sym->value;
1736 if (EQ (symbol, Qnil) ||
1738 SYMBOL_IS_KEYWORD (symbol))
1739 reject_constant_symbols (symbol, newval, 0,
1740 UNBOUNDP (newval) ? Qmakunbound : Qset);
1742 if (!SYMBOL_VALUE_MAGIC_P (valcontents) || UNBOUNDP (valcontents))
1744 sym->value = newval;
1748 reject_constant_symbols (symbol, newval, 0,
1749 UNBOUNDP (newval) ? Qmakunbound : Qset);
1751 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1753 case SYMVAL_LISP_MAGIC:
1755 if (UNBOUNDP (newval))
1757 maybe_call_magic_handler (symbol, Qmakunbound, 0);
1758 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = Qunbound;
1762 maybe_call_magic_handler (symbol, Qset, 1, newval);
1763 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = newval;
1767 case SYMVAL_VARALIAS:
1768 symbol = follow_varalias_pointers (symbol,
1770 ? Qmakunbound : Qset);
1771 /* presto change-o! */
1774 case SYMVAL_FIXNUM_FORWARD:
1775 case SYMVAL_BOOLEAN_FORWARD:
1776 case SYMVAL_OBJECT_FORWARD:
1777 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1778 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1779 if (UNBOUNDP (newval))
1780 signal_error (Qerror,
1781 list2 (build_string ("Cannot makunbound"), symbol));
1784 /* case SYMVAL_UNBOUND_MARKER: break; */
1786 case SYMVAL_CURRENT_BUFFER_FORWARD:
1788 const struct symbol_value_forward *fwd
1789 = XSYMBOL_VALUE_FORWARD (valcontents);
1790 int mask = XINT (*((Lisp_Object *)
1791 symbol_value_forward_forward (fwd)));
1793 /* Setting this variable makes it buffer-local */
1794 current_buffer->local_var_flags |= mask;
1798 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1800 const struct symbol_value_forward *fwd
1801 = XSYMBOL_VALUE_FORWARD (valcontents);
1802 int mask = XINT (*((Lisp_Object *)
1803 symbol_value_forward_forward (fwd)));
1805 /* Setting this variable makes it console-local */
1806 XCONSOLE (Vselected_console)->local_var_flags |= mask;
1810 case SYMVAL_BUFFER_LOCAL:
1811 case SYMVAL_SOME_BUFFER_LOCAL:
1813 /* If we want to examine or set the value and
1814 CURRENT-BUFFER is current, we just examine or set
1815 CURRENT-VALUE. If CURRENT-BUFFER is not current, we
1816 store the current CURRENT-VALUE value into
1817 CURRENT-ALIST- ELEMENT, then find the appropriate alist
1818 element for the buffer now current and set up
1819 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
1820 of that element, and store into CURRENT-BUFFER.
1822 If we are setting the variable and the current buffer does
1823 not have an alist entry for this variable, an alist entry is
1826 Note that CURRENT-VALUE can be a forwarding pointer.
1827 Each time it is examined or set, forwarding must be
1829 struct symbol_value_buffer_local *bfwd
1830 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1831 int some_buffer_local_p =
1832 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
1833 /* What value are we caching right now? */
1834 Lisp_Object aelt = bfwd->current_alist_element;
1836 if (!NILP (bfwd->current_buffer) &&
1837 current_buffer == XBUFFER (bfwd->current_buffer)
1838 && ((some_buffer_local_p)
1839 ? 1 /* doesn't automatically become local */
1840 : !NILP (aelt) /* already local */
1843 /* Cache is valid */
1844 valcontents = bfwd->current_value;
1848 /* If the current buffer is not the buffer whose binding is
1849 currently cached, or if it's a SYMVAL_BUFFER_LOCAL and
1850 we're looking at the default value, the cache is invalid; we
1851 need to write it out, and find the new CURRENT-ALIST-ELEMENT
1854 /* Write out the cached value for the old buffer; copy it
1855 back to its alist element. This works if the current
1856 buffer only sees the default value, too. */
1857 write_out_buffer_local_cache (symbol, bfwd);
1859 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1860 aelt = buffer_local_alist_element (current_buffer, symbol, bfwd);
1863 /* This buffer is still seeing the default value. */
1864 if (!some_buffer_local_p)
1866 /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a
1867 new assoc for a local value and set
1868 CURRENT-ALIST-ELEMENT to point to that. */
1870 do_symval_forwarding (bfwd->current_value,
1872 XCONSOLE (Vselected_console));
1873 aelt = Fcons (symbol, aelt);
1874 current_buffer->local_var_alist
1875 = Fcons (aelt, current_buffer->local_var_alist);
1879 /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
1880 we're currently seeing the default value. */
1884 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1885 bfwd->current_alist_element = aelt;
1886 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
1887 XSETBUFFER (bfwd->current_buffer, current_buffer);
1888 valcontents = bfwd->current_value;
1895 store_symval_forwarding (symbol, valcontents, newval);
1901 /* Access or set a buffer-local symbol's default value. */
1903 /* Return the default value of SYM, but don't check for voidness.
1904 Return Qunbound if it is void. */
1907 default_value (Lisp_Object sym)
1909 Lisp_Object valcontents;
1914 valcontents = XSYMBOL (sym)->value;
1917 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1920 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1922 case SYMVAL_LISP_MAGIC:
1924 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1928 case SYMVAL_VARALIAS:
1929 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1930 /* presto change-o! */
1933 case SYMVAL_UNBOUND_MARKER:
1936 case SYMVAL_CURRENT_BUFFER_FORWARD:
1938 const struct symbol_value_forward *fwd
1939 = XSYMBOL_VALUE_FORWARD (valcontents);
1940 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1941 + ((char *)symbol_value_forward_forward (fwd)
1942 - (char *)&buffer_local_flags))));
1945 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1947 const struct symbol_value_forward *fwd
1948 = XSYMBOL_VALUE_FORWARD (valcontents);
1949 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1950 + ((char *)symbol_value_forward_forward (fwd)
1951 - (char *)&console_local_flags))));
1954 case SYMVAL_BUFFER_LOCAL:
1955 case SYMVAL_SOME_BUFFER_LOCAL:
1957 struct symbol_value_buffer_local *bfwd =
1958 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1960 /* Handle user-created local variables. */
1961 /* If var is set up for a buffer that lacks a local value for it,
1962 the current value is nominally the default value.
1963 But the current value slot may be more up to date, since
1964 ordinary setq stores just that slot. So use that. */
1965 if (NILP (bfwd->current_alist_element))
1966 return do_symval_forwarding (bfwd->current_value, current_buffer,
1967 XCONSOLE (Vselected_console));
1969 return bfwd->default_value;
1972 /* For other variables, get the current value. */
1973 return do_symval_forwarding (valcontents, current_buffer,
1974 XCONSOLE (Vselected_console));
1977 RETURN_NOT_REACHED (Qnil) /* suppress compiler warning */
1980 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /*
1981 Return t if SYMBOL has a non-void default value.
1982 This is the value that is seen in buffers that do not have their own values
1987 return UNBOUNDP (default_value (symbol)) ? Qnil : Qt;
1990 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /*
1991 Return SYMBOL's default value.
1992 This is the value that is seen in buffers that do not have their own values
1993 for this variable. The default value is meaningful for variables with
1994 local bindings in certain buffers.
1998 Lisp_Object value = default_value (symbol);
2000 return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (symbol)) : value;
2003 DEFUN ("set-default", Fset_default, 2, 2, 0, /*
2004 Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated.
2005 The default value is seen in buffers that do not have their own values
2010 Lisp_Object valcontents;
2012 CHECK_SYMBOL (symbol);
2015 valcontents = XSYMBOL (symbol)->value;
2018 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2019 return Fset (symbol, value);
2021 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2023 case SYMVAL_LISP_MAGIC:
2024 RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (symbol, Qset_default, 1,
2026 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2030 case SYMVAL_VARALIAS:
2031 symbol = follow_varalias_pointers (symbol, Qset_default);
2032 /* presto change-o! */
2035 case SYMVAL_CURRENT_BUFFER_FORWARD:
2036 set_default_buffer_slot_variable (symbol, value);
2039 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2040 set_default_console_slot_variable (symbol, value);
2043 case SYMVAL_BUFFER_LOCAL:
2044 case SYMVAL_SOME_BUFFER_LOCAL:
2046 /* Store new value into the DEFAULT-VALUE slot */
2047 struct symbol_value_buffer_local *bfwd
2048 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2050 bfwd->default_value = value;
2051 /* If current-buffer doesn't shadow default_value,
2052 * we must set the CURRENT-VALUE slot too */
2053 if (NILP (bfwd->current_alist_element))
2054 store_symval_forwarding (symbol, bfwd->current_value, value);
2059 return Fset (symbol, value);
2063 DEFUN ("setq-default", Fsetq_default, 0, UNEVALLED, 0, /*
2064 Set the default value of variable SYMBOL to VALUE.
2065 SYMBOL, the variable name, is literal (not evaluated);
2066 VALUE is an expression and it is evaluated.
2067 The default value of a variable is seen in buffers
2068 that do not have their own values for the variable.
2070 More generally, you can use multiple variables and values, as in
2071 (setq-default SYMBOL VALUE SYMBOL VALUE...)
2072 This sets each SYMBOL's default value to the corresponding VALUE.
2073 The VALUE for the Nth SYMBOL can refer to the new default values
2074 of previous SYMBOLs.
2078 /* This function can GC */
2079 Lisp_Object symbol, tail, val = Qnil;
2081 struct gcpro gcpro1;
2083 GET_LIST_LENGTH (args, nargs);
2085 if (nargs & 1) /* Odd number of arguments? */
2086 Fsignal (Qwrong_number_of_arguments,
2087 list2 (Qsetq_default, make_int (nargs)));
2091 PROPERTY_LIST_LOOP (tail, symbol, val, args)
2094 Fset_default (symbol, val);
2101 /* Lisp functions for creating and removing buffer-local variables. */
2103 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1,
2104 "vMake Variable Buffer Local: ", /*
2105 Make VARIABLE have a separate value for each buffer.
2106 At any time, the value for the current buffer is in effect.
2107 There is also a default value which is seen in any buffer which has not yet
2109 Using `set' or `setq' to set the variable causes it to have a separate value
2110 for the current buffer if it was previously using the default value.
2111 The function `default-value' gets the default value and `set-default'
2116 Lisp_Object valcontents;
2118 CHECK_SYMBOL (variable);
2121 verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
2123 valcontents = XSYMBOL (variable)->value;
2126 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2128 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2130 case SYMVAL_LISP_MAGIC:
2131 if (!UNBOUNDP (maybe_call_magic_handler
2132 (variable, Qmake_variable_buffer_local, 0)))
2134 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2138 case SYMVAL_VARALIAS:
2139 variable = follow_varalias_pointers (variable,
2140 Qmake_variable_buffer_local);
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_CURRENT_BUFFER_FORWARD:
2151 case SYMVAL_BUFFER_LOCAL:
2152 /* Already per-each-buffer */
2155 case SYMVAL_SOME_BUFFER_LOCAL:
2157 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
2158 SYMVAL_BUFFER_LOCAL;
2167 struct symbol_value_buffer_local *bfwd
2168 = alloc_lcrecord_type (struct symbol_value_buffer_local,
2169 &lrecord_symbol_value_buffer_local);
2171 zero_lcrecord (&bfwd->magic);
2172 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2174 bfwd->default_value = find_symbol_value (variable);
2175 bfwd->current_value = valcontents;
2176 bfwd->current_alist_element = Qnil;
2177 bfwd->current_buffer = Fcurrent_buffer ();
2178 XSETSYMBOL_VALUE_MAGIC (foo, bfwd);
2179 *value_slot_past_magic (variable) = foo;
2180 #if 1 /* #### Yuck! FSFmacs bug-compatibility*/
2181 /* This sets the default-value of any make-variable-buffer-local to nil.
2182 That just sucks. User can just use setq-default to effect that,
2183 but there's no way to do makunbound-default to undo this lossage. */
2184 if (UNBOUNDP (valcontents))
2185 bfwd->default_value = Qnil;
2187 #if 0 /* #### Yuck! */
2188 /* This sets the value to nil in this buffer.
2189 User could use (setq variable nil) to do this.
2190 It isn't as egregious to do this automatically
2191 as it is to do so to the default-value, but it's
2192 still really dubious. */
2193 if (UNBOUNDP (valcontents))
2194 Fset (variable, Qnil);
2200 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1,
2201 "vMake Local Variable: ", /*
2202 Make VARIABLE have a separate value in the current buffer.
2203 Other buffers will continue to share a common default value.
2204 \(The buffer-local value of VARIABLE starts out as the same value
2205 VARIABLE previously had. If VARIABLE was void, it remains void.)
2206 See also `make-variable-buffer-local'.
2208 If the variable is already arranged to become local when set,
2209 this function causes a local value to exist for this buffer,
2210 just as setting the variable would do.
2212 Do not use `make-local-variable' to make a hook variable buffer-local.
2213 Use `make-local-hook' instead.
2217 Lisp_Object valcontents;
2218 struct symbol_value_buffer_local *bfwd;
2220 CHECK_SYMBOL (variable);
2223 verify_ok_for_buffer_local (variable, Qmake_local_variable);
2225 valcontents = XSYMBOL (variable)->value;
2228 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2230 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2232 case SYMVAL_LISP_MAGIC:
2233 if (!UNBOUNDP (maybe_call_magic_handler
2234 (variable, Qmake_local_variable, 0)))
2236 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2240 case SYMVAL_VARALIAS:
2241 variable = follow_varalias_pointers (variable, Qmake_local_variable);
2242 /* presto change-o! */
2245 case SYMVAL_FIXNUM_FORWARD:
2246 case SYMVAL_BOOLEAN_FORWARD:
2247 case SYMVAL_OBJECT_FORWARD:
2248 case SYMVAL_UNBOUND_MARKER:
2251 case SYMVAL_BUFFER_LOCAL:
2252 case SYMVAL_CURRENT_BUFFER_FORWARD:
2254 /* Make sure the symbol has a local value in this particular
2255 buffer, by setting it to the same value it already has. */
2256 Fset (variable, find_symbol_value (variable));
2260 case SYMVAL_SOME_BUFFER_LOCAL:
2262 if (!NILP (buffer_local_alist_element (current_buffer,
2264 (XSYMBOL_VALUE_BUFFER_LOCAL
2266 goto already_local_to_current_buffer;
2268 goto already_local_to_some_other_buffer;
2276 /* Make sure variable is set up to hold per-buffer values */
2277 bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
2278 &lrecord_symbol_value_buffer_local);
2279 zero_lcrecord (&bfwd->magic);
2280 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2282 bfwd->current_buffer = Qnil;
2283 bfwd->current_alist_element = Qnil;
2284 bfwd->current_value = valcontents;
2285 /* passing 0 is OK because this should never be a
2286 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2288 bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
2291 if (UNBOUNDP (bfwd->default_value))
2292 bfwd->default_value = Qnil; /* Yuck! */
2295 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
2296 *value_slot_past_magic (variable) = valcontents;
2298 already_local_to_some_other_buffer:
2300 /* Make sure this buffer has its own value of variable */
2301 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2303 if (UNBOUNDP (bfwd->default_value))
2305 /* If default value is unbound, set local value to nil. */
2306 XSETBUFFER (bfwd->current_buffer, current_buffer);
2307 bfwd->current_alist_element = Fcons (variable, Qnil);
2308 current_buffer->local_var_alist =
2309 Fcons (bfwd->current_alist_element, current_buffer->local_var_alist);
2310 store_symval_forwarding (variable, bfwd->current_value, Qnil);
2314 current_buffer->local_var_alist
2315 = Fcons (Fcons (variable, bfwd->default_value),
2316 current_buffer->local_var_alist);
2318 /* Make sure symbol does not think it is set up for this buffer;
2319 force it to look once again for this buffer's value */
2320 if (!NILP (bfwd->current_buffer) &&
2321 current_buffer == XBUFFER (bfwd->current_buffer))
2322 bfwd->current_buffer = Qnil;
2324 already_local_to_current_buffer:
2326 /* If the symbol forwards into a C variable, then swap in the
2327 variable for this buffer immediately. If C code modifies the
2328 variable before we swap in, then that new value will clobber the
2329 default value the next time we swap. */
2330 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2331 if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value))
2333 switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
2335 case SYMVAL_FIXNUM_FORWARD:
2336 case SYMVAL_BOOLEAN_FORWARD:
2337 case SYMVAL_OBJECT_FORWARD:
2338 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2339 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2342 case SYMVAL_UNBOUND_MARKER:
2343 case SYMVAL_CURRENT_BUFFER_FORWARD:
2354 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1,
2355 "vKill Local Variable: ", /*
2356 Make VARIABLE no longer have a separate value in the current buffer.
2357 From now on the default value will apply in this buffer.
2361 Lisp_Object valcontents;
2363 CHECK_SYMBOL (variable);
2366 valcontents = XSYMBOL (variable)->value;
2369 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2372 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2374 case SYMVAL_LISP_MAGIC:
2375 if (!UNBOUNDP (maybe_call_magic_handler
2376 (variable, Qkill_local_variable, 0)))
2378 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2382 case SYMVAL_VARALIAS:
2383 variable = follow_varalias_pointers (variable, Qkill_local_variable);
2384 /* presto change-o! */
2387 case SYMVAL_CURRENT_BUFFER_FORWARD:
2389 const struct symbol_value_forward *fwd
2390 = XSYMBOL_VALUE_FORWARD (valcontents);
2391 int offset = ((char *) symbol_value_forward_forward (fwd)
2392 - (char *) &buffer_local_flags);
2394 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2398 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2399 Lisp_Object in_object, int flags) =
2400 symbol_value_forward_magicfun (fwd);
2401 Lisp_Object oldval = * (Lisp_Object *)
2402 (offset + (char *) XBUFFER (Vbuffer_defaults));
2404 (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
2405 *(Lisp_Object *) (offset + (char *) current_buffer)
2407 current_buffer->local_var_flags &= ~mask;
2412 case SYMVAL_BUFFER_LOCAL:
2413 case SYMVAL_SOME_BUFFER_LOCAL:
2415 /* Get rid of this buffer's alist element, if any */
2416 struct symbol_value_buffer_local *bfwd
2417 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2418 Lisp_Object alist = current_buffer->local_var_alist;
2419 Lisp_Object alist_element
2420 = buffer_local_alist_element (current_buffer, variable, bfwd);
2422 if (!NILP (alist_element))
2423 current_buffer->local_var_alist = Fdelq (alist_element, alist);
2425 /* Make sure symbol does not think it is set up for this buffer;
2426 force it to look once again for this buffer's value */
2427 if (!NILP (bfwd->current_buffer) &&
2428 current_buffer == XBUFFER (bfwd->current_buffer))
2429 bfwd->current_buffer = Qnil;
2431 /* We just changed the value in the current_buffer. If this
2432 variable forwards to a C variable, we need to change the
2433 value of the C variable. set_up_buffer_local_cache()
2434 will do this. It doesn't hurt to do it always,
2435 so just go ahead and do that. */
2436 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2443 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2447 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2448 "vKill Console Local Variable: ", /*
2449 Make VARIABLE no longer have a separate value in the selected console.
2450 From now on the default value will apply in this console.
2454 Lisp_Object valcontents;
2456 CHECK_SYMBOL (variable);
2459 valcontents = XSYMBOL (variable)->value;
2462 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2465 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2467 case SYMVAL_LISP_MAGIC:
2468 if (!UNBOUNDP (maybe_call_magic_handler
2469 (variable, Qkill_console_local_variable, 0)))
2471 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2475 case SYMVAL_VARALIAS:
2476 variable = follow_varalias_pointers (variable,
2477 Qkill_console_local_variable);
2478 /* presto change-o! */
2481 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2483 const struct symbol_value_forward *fwd
2484 = XSYMBOL_VALUE_FORWARD (valcontents);
2485 int offset = ((char *) symbol_value_forward_forward (fwd)
2486 - (char *) &console_local_flags);
2488 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2492 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2493 Lisp_Object in_object, int flags) =
2494 symbol_value_forward_magicfun (fwd);
2495 Lisp_Object oldval = * (Lisp_Object *)
2496 (offset + (char *) XCONSOLE (Vconsole_defaults));
2498 magicfun (variable, &oldval, Vselected_console, 0);
2499 *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
2501 XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
2511 /* Used by specbind to determine what effects it might have. Returns:
2512 * 0 if symbol isn't buffer-local, and wouldn't be after it is set
2513 * <0 if symbol isn't presently buffer-local, but set would make it so
2514 * >0 if symbol is presently buffer-local
2517 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
2519 Lisp_Object valcontents;
2522 valcontents = XSYMBOL (symbol)->value;
2525 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2527 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2529 case SYMVAL_LISP_MAGIC:
2531 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2535 case SYMVAL_VARALIAS:
2536 symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
2537 /* presto change-o! */
2540 case SYMVAL_CURRENT_BUFFER_FORWARD:
2542 const struct symbol_value_forward *fwd
2543 = XSYMBOL_VALUE_FORWARD (valcontents);
2544 int mask = XINT (*((Lisp_Object *)
2545 symbol_value_forward_forward (fwd)));
2546 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
2547 /* Already buffer-local */
2550 /* Would be buffer-local after set */
2553 case SYMVAL_BUFFER_LOCAL:
2554 case SYMVAL_SOME_BUFFER_LOCAL:
2556 struct symbol_value_buffer_local *bfwd
2557 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2559 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
2562 /* Automatically becomes local when set */
2563 return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
2573 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2574 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2576 (symbol, buffer, unbound_value))
2579 CHECK_SYMBOL (symbol);
2580 CHECK_BUFFER (buffer);
2581 value = symbol_value_in_buffer (symbol, buffer);
2582 return UNBOUNDP (value) ? unbound_value : value;
2585 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2586 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2588 (symbol, console, unbound_value))
2591 CHECK_SYMBOL (symbol);
2592 CHECK_CONSOLE (console);
2593 value = symbol_value_in_console (symbol, console);
2594 return UNBOUNDP (value) ? unbound_value : value;
2597 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
2598 If SYMBOL is a built-in variable, return info about this; else return nil.
2599 The returned info will be a symbol, one of
2601 `object' A simple built-in variable.
2602 `const-object' Same, but cannot be set.
2603 `integer' A built-in integer variable.
2604 `const-integer' Same, but cannot be set.
2605 `boolean' A built-in boolean variable.
2606 `const-boolean' Same, but cannot be set.
2607 `const-specifier' Always contains a specifier; e.g. `has-modeline-p'.
2608 `current-buffer' A built-in buffer-local variable.
2609 `const-current-buffer' Same, but cannot be set.
2610 `default-buffer' Forwards to the default value of a built-in
2611 buffer-local variable.
2612 `selected-console' A built-in console-local variable.
2613 `const-selected-console' Same, but cannot be set.
2614 `default-console' Forwards to the default value of a built-in
2615 console-local variable.
2619 REGISTER Lisp_Object valcontents;
2621 CHECK_SYMBOL (symbol);
2624 valcontents = XSYMBOL (symbol)->value;
2627 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2630 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2632 case SYMVAL_LISP_MAGIC:
2633 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2637 case SYMVAL_VARALIAS:
2638 symbol = follow_varalias_pointers (symbol, Qt);
2639 /* presto change-o! */
2642 case SYMVAL_BUFFER_LOCAL:
2643 case SYMVAL_SOME_BUFFER_LOCAL:
2645 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value;
2649 case SYMVAL_FIXNUM_FORWARD: return Qinteger;
2650 case SYMVAL_CONST_FIXNUM_FORWARD: return Qconst_integer;
2651 case SYMVAL_BOOLEAN_FORWARD: return Qboolean;
2652 case SYMVAL_CONST_BOOLEAN_FORWARD: return Qconst_boolean;
2653 case SYMVAL_OBJECT_FORWARD: return Qobject;
2654 case SYMVAL_CONST_OBJECT_FORWARD: return Qconst_object;
2655 case SYMVAL_CONST_SPECIFIER_FORWARD: return Qconst_specifier;
2656 case SYMVAL_DEFAULT_BUFFER_FORWARD: return Qdefault_buffer;
2657 case SYMVAL_CURRENT_BUFFER_FORWARD: return Qcurrent_buffer;
2658 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: return Qconst_current_buffer;
2659 case SYMVAL_DEFAULT_CONSOLE_FORWARD: return Qdefault_console;
2660 case SYMVAL_SELECTED_CONSOLE_FORWARD: return Qselected_console;
2661 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: return Qconst_selected_console;
2662 case SYMVAL_UNBOUND_MARKER: return Qnil;
2665 abort (); return Qnil;
2670 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
2671 Return t if SYMBOL's value is local to BUFFER.
2672 If optional third arg AFTER-SET is non-nil, return t if SYMBOL would be
2673 buffer-local after it is set, regardless of whether it is so presently.
2674 A nil value for BUFFER is *not* the same as (current-buffer), but means
2675 "no buffer". Specifically:
2677 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
2678 the variable is one of the special built-in variables that is always
2679 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
2680 `buffer-undo-list', and others.)
2682 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
2683 the variable has had `make-variable-buffer-local' applied to it.
2685 (symbol, buffer, after_set))
2689 CHECK_SYMBOL (symbol);
2692 buffer = get_buffer (buffer, 1);
2693 local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
2697 local_info = symbol_value_buffer_local_info (symbol, 0);
2700 if (NILP (after_set))
2701 return local_info > 0 ? Qt : Qnil;
2703 return local_info != 0 ? Qt : Qnil;
2708 I've gone ahead and partially implemented this because it's
2709 super-useful for dealing with the compatibility problems in supporting
2710 the old pointer-shape variables, and preventing people from `setq'ing
2711 the new variables. Any other way of handling this problem is way
2712 ugly, likely to be slow, and generally not something I want to waste
2713 my time worrying about.
2715 The interface and/or function name is sure to change before this
2716 gets into its final form. I currently like the way everything is
2717 set up and it has all the features I want it to have, except for
2718 one: I really want to be able to have multiple nested handlers,
2719 to implement an `advice'-like capability. This would allow,
2720 for example, a clean way of implementing `debug-if-set' or
2721 `debug-if-referenced' and such.
2723 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
2724 ************************************************************
2725 **Only** the `set-value', `make-unbound', and `make-local'
2726 handler types are currently implemented. Implementing the
2727 get-value and bound-predicate handlers is somewhat tricky
2728 because there are lots of subfunctions (e.g. find_symbol_value()).
2729 find_symbol_value(), in fact, is called from outside of
2730 this module. You'd have to have it do this:
2732 -- check for a `bound-predicate' handler, call that if so;
2733 if it returns nil, return Qunbound
2734 -- check for a `get-value' handler and call it and return
2737 It gets even trickier when you have to deal with
2738 sub-subfunctions like find_symbol_value_1(), and esp.
2739 when you have to properly handle variable aliases, which
2740 can lead to lots of tricky situations. So I've just
2741 punted on this, since the interface isn't officially
2742 exported and we can get by with just a `set-value'
2745 Actions in unimplemented handler types will correctly
2746 ignore any handlers, and will not fuck anything up or
2749 WARNING WARNING: If you do go and implement another
2750 type of handler, make *sure* to change
2751 would_be_magic_handled() so it knows about this,
2752 or dire things could result.
2753 ************************************************************
2754 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
2756 Real documentation is as follows.
2758 Set a magic handler for VARIABLE.
2759 This allows you to specify arbitrary behavior that results from
2760 accessing or setting a variable. For example, retrieving the
2761 variable's value might actually retrieve the first element off of
2762 a list stored in another variable, and setting the variable's value
2763 might add an element to the front of that list. (This is how the
2764 obsolete variable `unread-command-event' is implemented.)
2766 In general it is NOT good programming practice to use magic variables
2767 in a new package that you are designing. If you feel the need to
2768 do this, it's almost certainly a sign that you should be using a
2769 function instead of a variable. This facility is provided to allow
2770 a package to support obsolete variables and provide compatibility
2771 with similar packages with different variable names and semantics.
2772 By using magic handlers, you can cleanly provide obsoleteness and
2773 compatibility support and separate this support from the core
2774 routines in a package.
2776 VARIABLE should be a symbol naming the variable for which the
2777 magic behavior is provided. HANDLER-TYPE is a symbol specifying
2778 which behavior is being controlled, and HANDLER is the function
2779 that will be called to control this behavior. HARG is a
2780 value that will be passed to HANDLER but is otherwise
2781 uninterpreted. KEEP-EXISTING specifies what to do with existing
2782 handlers of the same type; nil means "erase them all", t means
2783 "keep them but insert at the beginning", the list (t) means
2784 "keep them but insert at the end", a function means "keep
2785 them but insert before the specified function", a list containing
2786 a function means "keep them but insert after the specified
2789 You can specify magic behavior for any type of variable at all,
2790 and for any handler types that are unspecified, the standard
2791 behavior applies. This allows you, for example, to use
2792 `defvaralias' in conjunction with this function. (For that
2793 matter, `defvaralias' could be implemented using this function.)
2795 The behaviors that can be specified in HANDLER-TYPE are
2797 get-value (SYM ARGS FUN HARG HANDLERS)
2798 This means that one of the functions `symbol-value',
2799 `default-value', `symbol-value-in-buffer', or
2800 `symbol-value-in-console' was called on SYM.
2802 set-value (SYM ARGS FUN HARG HANDLERS)
2803 This means that one of the functions `set' or `set-default'
2806 bound-predicate (SYM ARGS FUN HARG HANDLERS)
2807 This means that one of the functions `boundp', `globally-boundp',
2808 or `default-boundp' was called on SYM.
2810 make-unbound (SYM ARGS FUN HARG HANDLERS)
2811 This means that the function `makunbound' was called on SYM.
2813 local-predicate (SYM ARGS FUN HARG HANDLERS)
2814 This means that the function `local-variable-p' was called
2817 make-local (SYM ARGS FUN HARG HANDLERS)
2818 This means that one of the functions `make-local-variable',
2819 `make-variable-buffer-local', `kill-local-variable',
2820 or `kill-console-local-variable' was called on SYM.
2822 The meanings of the arguments are as follows:
2824 SYM is the symbol on which the function was called, and is always
2825 the first argument to the function.
2827 ARGS are the remaining arguments in the original call (i.e. all
2828 but the first). In the case of `set-value' in particular,
2829 the first element of ARGS is the value to which the variable
2830 is being set. In some cases, ARGS is sanitized from what was
2831 actually given. For example, whenever `nil' is passed to an
2832 argument and it means `current-buffer', the current buffer is
2833 substituted instead.
2835 FUN is a symbol indicating which function is being called.
2836 For many of the functions, you can determine the corresponding
2837 function of a different class using
2838 `symbol-function-corresponding-function'.
2840 HARG is the argument that was given in the call
2841 to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
2843 HANDLERS is a structure containing the remaining handlers
2844 for the variable; to call one of them, use
2845 `chain-to-symbol-value-handler'.
2847 NOTE: You may *not* modify the list in ARGS, and if you want to
2848 keep it around after the handler function exits, you must make
2849 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
2852 static enum lisp_magic_handler
2853 decode_magic_handler_type (Lisp_Object symbol)
2855 if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE;
2856 if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE;
2857 if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE;
2858 if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND;
2859 if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE;
2860 if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL;
2862 signal_simple_error ("Unrecognized symbol value handler type", symbol);
2864 return MAGIC_HANDLER_MAX;
2867 static enum lisp_magic_handler
2868 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
2870 if (EQ (funsym, Qsymbol_value)
2871 || EQ (funsym, Qdefault_value)
2872 || EQ (funsym, Qsymbol_value_in_buffer)
2873 || EQ (funsym, Qsymbol_value_in_console))
2874 return MAGIC_HANDLER_GET_VALUE;
2876 if (EQ (funsym, Qset)
2877 || EQ (funsym, Qset_default))
2878 return MAGIC_HANDLER_SET_VALUE;
2880 if (EQ (funsym, Qboundp)
2881 || EQ (funsym, Qglobally_boundp)
2882 || EQ (funsym, Qdefault_boundp))
2883 return MAGIC_HANDLER_BOUND_PREDICATE;
2885 if (EQ (funsym, Qmakunbound))
2886 return MAGIC_HANDLER_MAKE_UNBOUND;
2888 if (EQ (funsym, Qlocal_variable_p))
2889 return MAGIC_HANDLER_LOCAL_PREDICATE;
2891 if (EQ (funsym, Qmake_variable_buffer_local)
2892 || EQ (funsym, Qmake_local_variable))
2893 return MAGIC_HANDLER_MAKE_LOCAL;
2895 if (abort_if_not_found)
2897 signal_simple_error ("Unrecognized symbol-value function", funsym);
2898 return MAGIC_HANDLER_MAX;
2902 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
2904 /* does not take into account variable aliasing. */
2905 Lisp_Object valcontents = XSYMBOL (sym)->value;
2906 enum lisp_magic_handler slot;
2908 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2910 slot = handler_type_from_function_symbol (funsym, 1);
2911 if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND
2912 && slot != MAGIC_HANDLER_MAKE_LOCAL)
2913 /* #### temporary kludge because we haven't implemented
2914 lisp-magic variables completely */
2916 return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
2920 fetch_value_maybe_past_magic (Lisp_Object sym,
2921 Lisp_Object follow_past_lisp_magic)
2923 Lisp_Object value = XSYMBOL (sym)->value;
2924 if (SYMBOL_VALUE_LISP_MAGIC_P (value)
2925 && (EQ (follow_past_lisp_magic, Qt)
2926 || (!NILP (follow_past_lisp_magic)
2927 && !would_be_magic_handled (sym, follow_past_lisp_magic))))
2928 value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed;
2932 static Lisp_Object *
2933 value_slot_past_magic (Lisp_Object sym)
2935 Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
2937 if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
2938 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
2939 return store_pointer;
2943 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
2946 Lisp_Object args[20]; /* should be enough ... */
2948 enum lisp_magic_handler htype;
2949 Lisp_Object legerdemain;
2950 struct symbol_value_lisp_magic *bfwd;
2952 assert (nargs >= 0 && nargs < countof (args));
2953 legerdemain = XSYMBOL (sym)->value;
2954 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2955 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2957 va_start (vargs, nargs);
2958 for (i = 0; i < nargs; i++)
2959 args[i] = va_arg (vargs, Lisp_Object);
2962 htype = handler_type_from_function_symbol (funsym, 1);
2963 if (NILP (bfwd->handler[htype]))
2965 /* #### should be reusing the arglist, not always consing anew.
2966 Repeated handler invocations should not cause repeated consing.
2967 Doesn't matter for now, because this is just a quick implementation
2968 for obsolescence support. */
2969 return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym,
2970 bfwd->harg[htype], Qnil);
2973 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
2975 Don't you dare use this.
2976 If you do, suffer the wrath of Ben, who is likely to rename
2977 this function (or change the semantics of its arguments) without
2978 pity, thereby invalidating your code.
2980 (variable, handler_type, handler, harg, keep_existing))
2982 Lisp_Object valcontents;
2983 struct symbol_value_lisp_magic *bfwd;
2984 enum lisp_magic_handler htype;
2987 /* #### WARNING, only some handler types are implemented. See above.
2988 Actions of other types will ignore a handler if it's there.
2990 #### Also, `chain-to-symbol-value-handler' and
2991 `symbol-function-corresponding-function' are not implemented. */
2992 CHECK_SYMBOL (variable);
2993 CHECK_SYMBOL (handler_type);
2994 htype = decode_magic_handler_type (handler_type);
2995 valcontents = XSYMBOL (variable)->value;
2996 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2998 bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
2999 &lrecord_symbol_value_lisp_magic);
3000 zero_lcrecord (&bfwd->magic);
3001 bfwd->magic.type = SYMVAL_LISP_MAGIC;
3002 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
3004 bfwd->handler[i] = Qnil;
3005 bfwd->harg[i] = Qnil;
3007 bfwd->shadowed = valcontents;
3008 XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
3011 bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
3012 bfwd->handler[htype] = handler;
3013 bfwd->harg[htype] = harg;
3015 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
3016 if (!NILP (bfwd->handler[i]))
3019 if (i == MAGIC_HANDLER_MAX)
3020 /* there are no remaining handlers, so remove the structure. */
3021 XSYMBOL (variable)->value = bfwd->shadowed;
3027 /* functions for working with variable aliases. */
3029 /* Follow the chain of variable aliases for SYMBOL. Return the
3030 resulting symbol, whose value cell is guaranteed not to be a
3031 symbol-value-varalias.
3033 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
3034 If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
3035 never follow; stop right there. Otherwise FUNSYM should be a
3036 recognized symbol-value function symbol; this means, follow
3037 unless there is a special handler for the named function.
3039 OK, there is at least one reason why it's necessary for
3040 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
3041 can always be sure to catch cyclic variable aliasing. If we never
3042 follow past Lisp magic, then if the following is done:
3045 add some magic behavior to a, but not a "get-value" handler
3048 then an attempt to retrieve a's or b's value would cause infinite
3049 looping in `symbol-value'.
3051 We (of course) can't always follow past Lisp magic, because then
3052 we make any variable that is lisp-magic -> varalias behave as if
3053 the lisp-magic is not present at all.
3057 follow_varalias_pointers (Lisp_Object symbol,
3058 Lisp_Object follow_past_lisp_magic)
3060 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
3061 Lisp_Object tortoise, hare, val;
3064 /* quick out just in case */
3065 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value))
3068 /* Compare implementation of indirect_function(). */
3069 for (hare = tortoise = symbol, count = 0;
3070 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic),
3071 SYMBOL_VALUE_VARALIAS_P (val);
3072 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)),
3075 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue;
3078 tortoise = symbol_value_varalias_aliasee
3079 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic
3080 (tortoise, follow_past_lisp_magic)));
3081 if (EQ (hare, tortoise))
3082 return Fsignal (Qcyclic_variable_indirection, list1 (symbol));
3088 DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
3089 Define a variable as an alias for another variable.
3090 Thenceforth, any operations performed on VARIABLE will actually be
3091 performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
3092 If ALIAS is nil, remove any aliases for VARIABLE.
3093 ALIAS can itself be aliased, and the chain of variable aliases
3094 will be followed appropriately.
3095 If VARIABLE already has a value, this value will be shadowed
3096 until the alias is removed, at which point it will be restored.
3097 Currently VARIABLE cannot be a built-in variable, a variable that
3098 has a buffer-local value in any buffer, or the symbols nil or t.
3099 \(ALIAS, however, can be any type of variable.)
3103 struct symbol_value_varalias *bfwd;
3104 Lisp_Object valcontents;
3106 CHECK_SYMBOL (variable);
3107 reject_constant_symbols (variable, Qunbound, 0, Qt);
3109 valcontents = XSYMBOL (variable)->value;
3113 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3115 XSYMBOL (variable)->value =
3116 symbol_value_varalias_shadowed
3117 (XSYMBOL_VALUE_VARALIAS (valcontents));
3122 CHECK_SYMBOL (alias);
3123 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3126 XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
3130 if (SYMBOL_VALUE_MAGIC_P (valcontents)
3131 && !UNBOUNDP (valcontents))
3132 signal_simple_error ("Variable is magic and cannot be aliased", variable);
3133 reject_constant_symbols (variable, Qunbound, 0, Qt);
3135 bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
3136 &lrecord_symbol_value_varalias);
3137 zero_lcrecord (&bfwd->magic);
3138 bfwd->magic.type = SYMVAL_VARALIAS;
3139 bfwd->aliasee = alias;
3140 bfwd->shadowed = valcontents;
3142 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
3143 XSYMBOL (variable)->value = valcontents;
3147 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
3148 If VARIABLE is aliased to another variable, return that variable.
3149 VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
3150 Variable aliases are created with `defvaralias'. See also
3151 `indirect-variable'.
3153 (variable, follow_past_lisp_magic))
3155 Lisp_Object valcontents;
3157 CHECK_SYMBOL (variable);
3158 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3160 CHECK_SYMBOL (follow_past_lisp_magic);
3161 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3164 valcontents = fetch_value_maybe_past_magic (variable,
3165 follow_past_lisp_magic);
3167 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3168 return symbol_value_varalias_aliasee
3169 (XSYMBOL_VALUE_VARALIAS (valcontents));
3174 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /*
3175 Return the variable at the end of OBJECT's variable-alias chain.
3176 If OBJECT is a symbol, follow all variable aliases and return
3177 the final (non-aliased) symbol. Variable aliases are created with
3178 the function `defvaralias'.
3179 If OBJECT is not a symbol, just return it.
3180 Signal a cyclic-variable-indirection error if there is a loop in the
3181 variable chain of symbols.
3183 (object, follow_past_lisp_magic))
3185 if (!SYMBOLP (object))
3187 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3189 CHECK_SYMBOL (follow_past_lisp_magic);
3190 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3192 return follow_varalias_pointers (object, follow_past_lisp_magic);
3196 /************************************************************************/
3197 /* initialization */
3198 /************************************************************************/
3200 /* A dumped XEmacs image has a lot more than 1511 symbols. Last
3201 estimate was that there were actually around 6300. So let's try
3202 making this bigger and see if we get better hashing behavior. */
3203 #define OBARRAY_SIZE 16411
3208 #ifndef Qnull_pointer
3209 Lisp_Object Qnull_pointer;
3212 /* some losing systems can't have static vars at function scope... */
3213 static const struct symbol_value_magic guts_of_unbound_marker =
3214 { /* struct symbol_value_magic */
3215 { /* struct lcrecord_header */
3216 { /* struct lrecord_header */
3217 lrecord_type_symbol_value_forward, /* lrecord_type_index */
3219 1, /* c_readonly bit */
3220 1, /* lisp_readonly bit */
3227 SYMVAL_UNBOUND_MARKER
3231 init_symbols_once_early (void)
3233 INIT_LRECORD_IMPLEMENTATION (symbol);
3234 INIT_LRECORD_IMPLEMENTATION (symbol_value_forward);
3235 INIT_LRECORD_IMPLEMENTATION (symbol_value_buffer_local);
3236 INIT_LRECORD_IMPLEMENTATION (symbol_value_lisp_magic);
3237 INIT_LRECORD_IMPLEMENTATION (symbol_value_varalias);
3239 reinit_symbols_once_early ();
3241 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3242 called the first time. */
3243 Qnil = Fmake_symbol (make_string_nocopy ((const Bufbyte *) "nil", 3));
3244 XSYMBOL (Qnil)->name->plist = Qnil;
3245 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
3246 XSYMBOL (Qnil)->plist = Qnil;
3248 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3249 initial_obarray = Vobarray;
3250 staticpro (&initial_obarray);
3251 /* Intern nil in the obarray */
3253 int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
3254 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3258 /* Required to get around a GCC syntax error on certain
3260 const struct symbol_value_magic *tem = &guts_of_unbound_marker;
3262 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3265 XSYMBOL (Qnil)->function = Qunbound;
3268 /* [tomo:2002-01-22] We should not define Qunloaded as a normal symbol */
3269 defsymbol (&Qunloaded, "#<unloaded>");
3272 defsymbol (&Qt, "t");
3273 XSYMBOL (Qt)->value = Qt; /* Veritas aeterna */
3276 dump_add_root_object (&Qnil);
3277 dump_add_root_object (&Qunbound);
3278 dump_add_root_object (&Vquit_flag);
3282 reinit_symbols_once_early (void)
3285 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3288 #ifndef Qnull_pointer
3289 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3290 so the following is actually a no-op. */
3291 XSETOBJ (Qnull_pointer, 0);
3296 defsymbol_massage_name_1 (Lisp_Object *location, const char *name, int dump_p,
3297 int multiword_predicate_p)
3300 size_t len = strlen (name) - 1;
3303 if (multiword_predicate_p)
3304 assert (len + 1 < sizeof (temp));
3306 assert (len < sizeof (temp));
3307 strcpy (temp, name + 1); /* Remove initial Q */
3308 if (multiword_predicate_p)
3310 strcpy (temp + len - 1, "_p");
3313 for (i = 0; i < len; i++)
3316 *location = Fintern (make_string ((const Bufbyte *) temp, len), Qnil);
3318 staticpro (location);
3320 staticpro_nodump (location);
3324 defsymbol_massage_name_nodump (Lisp_Object *location, const char *name)
3326 defsymbol_massage_name_1 (location, name, 0, 0);
3330 defsymbol_massage_name (Lisp_Object *location, const char *name)
3332 defsymbol_massage_name_1 (location, name, 1, 0);
3336 defsymbol_massage_multiword_predicate_nodump (Lisp_Object *location,
3339 defsymbol_massage_name_1 (location, name, 0, 1);
3343 defsymbol_massage_multiword_predicate (Lisp_Object *location, const char *name)
3345 defsymbol_massage_name_1 (location, name, 1, 1);
3349 defsymbol_nodump (Lisp_Object *location, const char *name)
3351 *location = Fintern (make_string_nocopy ((const Bufbyte *) name,
3354 staticpro_nodump (location);
3358 defsymbol (Lisp_Object *location, const char *name)
3360 *location = Fintern (make_string_nocopy ((const Bufbyte *) name,
3363 staticpro (location);
3367 defkeyword (Lisp_Object *location, const char *name)
3369 defsymbol (location, name);
3370 Fset (*location, *location);
3374 defkeyword_massage_name (Lisp_Object *location, const char *name)
3377 size_t len = strlen (name);
3379 assert (len < sizeof (temp));
3380 strcpy (temp, name);
3381 temp[1] = ':'; /* it's an underscore in the C variable */
3383 defsymbol_massage_name (location, temp);
3384 Fset (*location, *location);
3388 /* Check that nobody spazzed writing a DEFUN. */
3390 check_sane_subr (Lisp_Subr *subr, Lisp_Object sym)
3392 assert (subr->min_args >= 0);
3393 assert (subr->min_args <= SUBR_MAX_ARGS);
3395 if (subr->max_args != MANY &&
3396 subr->max_args != UNEVALLED)
3398 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3399 assert (subr->max_args <= SUBR_MAX_ARGS);
3400 assert (subr->min_args <= subr->max_args);
3403 assert (UNBOUNDP (XSYMBOL (sym)->function));
3406 #define check_sane_subr(subr, sym) /* nothing */
3411 * If we are not in a pure undumped Emacs, we need to make a duplicate of
3412 * the subr. This is because the only time this function will be called
3413 * in a running Emacs is when a dynamically loaded module is adding a
3414 * subr, and we need to make sure that the subr is in allocated, Lisp-
3415 * accessible memory. The address assigned to the static subr struct
3416 * in the shared object will be a trampoline address, so we need to create
3417 * a copy here to ensure that a real address is used.
3419 * Once we have copied everything across, we re-use the original static
3420 * structure to store a pointer to the newly allocated one. This will be
3421 * used in emodules.c by emodules_doc_subr() to find a pointer to the
3422 * allocated object so that we can set its doc string properly.
3424 * NOTE: We don't actually use the DOC pointer here any more, but we did
3425 * in an earlier implementation of module support. There is no harm in
3426 * setting it here in case we ever need it in future implementations.
3427 * subr->doc will point to the new subr structure that was allocated.
3428 * Code can then get this value from the static subr structure and use
3431 * FIXME: Should newsubr be staticpro()'ed? I don't think so but I need
3434 #define check_module_subr() \
3436 if (initialized) { \
3437 Lisp_Subr *newsubr = (Lisp_Subr *) xmalloc (sizeof (Lisp_Subr)); \
3438 memcpy (newsubr, subr, sizeof (Lisp_Subr)); \
3439 subr->doc = (const char *)newsubr; \
3443 #else /* ! HAVE_SHLIB */
3444 #define check_module_subr()
3448 defsubr (Lisp_Subr *subr)
3450 Lisp_Object sym = intern (subr_name (subr));
3453 check_sane_subr (subr, sym);
3454 check_module_subr ();
3456 XSETSUBR (fun, subr);
3457 XSYMBOL (sym)->function = fun;
3460 /* Define a lisp macro using a Lisp_Subr. */
3462 defsubr_macro (Lisp_Subr *subr)
3464 Lisp_Object sym = intern (subr_name (subr));
3467 check_sane_subr (subr, sym);
3468 check_module_subr();
3470 XSETSUBR (fun, subr);
3471 XSYMBOL (sym)->function = Fcons (Qmacro, fun);
3475 deferror_1 (Lisp_Object *symbol, const char *name, const char *messuhhj,
3476 Lisp_Object inherits_from, int massage_p)
3480 defsymbol_massage_name (symbol, name);
3482 defsymbol (symbol, name);
3484 assert (SYMBOLP (inherits_from));
3485 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3486 Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3487 /* NOT build_translated_string (). This function is called at load time
3488 and the string needs to get translated at run time. (This happens
3489 in the function (display-error) in cmdloop.el.) */
3490 Fput (*symbol, Qerror_message, build_string (messuhhj));
3494 deferror (Lisp_Object *symbol, const char *name, const char *messuhhj,
3495 Lisp_Object inherits_from)
3497 deferror_1 (symbol, name, messuhhj, inherits_from, 0);
3501 deferror_massage_name (Lisp_Object *symbol, const char *name,
3502 const char *messuhhj, Lisp_Object inherits_from)
3504 deferror_1 (symbol, name, messuhhj, inherits_from, 1);
3508 deferror_massage_name_and_message (Lisp_Object *symbol, const char *name,
3509 Lisp_Object inherits_from)
3513 size_t len = strlen (name) - 1;
3515 assert (len < sizeof (temp));
3516 strcpy (temp, name + 1); /* Remove initial Q */
3517 temp[0] = toupper (temp[0]);
3518 for (i = 0; i < len; i++)
3522 deferror_1 (symbol, name, temp, inherits_from, 1);
3526 syms_of_symbols (void)
3528 DEFSYMBOL (Qvariable_documentation);
3529 DEFSYMBOL (Qvariable_domain); /* I18N3 */
3530 DEFSYMBOL (Qad_advice_info);
3531 DEFSYMBOL (Qad_activate);
3533 DEFSYMBOL (Qget_value);
3534 DEFSYMBOL (Qset_value);
3535 DEFSYMBOL (Qbound_predicate);
3536 DEFSYMBOL (Qmake_unbound);
3537 DEFSYMBOL (Qlocal_predicate);
3538 DEFSYMBOL (Qmake_local);
3540 DEFSYMBOL (Qboundp);
3541 DEFSYMBOL (Qglobally_boundp);
3542 DEFSYMBOL (Qmakunbound);
3543 DEFSYMBOL (Qsymbol_value);
3545 DEFSYMBOL (Qsetq_default);
3546 DEFSYMBOL (Qdefault_boundp);
3547 DEFSYMBOL (Qdefault_value);
3548 DEFSYMBOL (Qset_default);
3549 DEFSYMBOL (Qmake_variable_buffer_local);
3550 DEFSYMBOL (Qmake_local_variable);
3551 DEFSYMBOL (Qkill_local_variable);
3552 DEFSYMBOL (Qkill_console_local_variable);
3553 DEFSYMBOL (Qsymbol_value_in_buffer);
3554 DEFSYMBOL (Qsymbol_value_in_console);
3555 DEFSYMBOL (Qlocal_variable_p);
3557 DEFSYMBOL (Qconst_integer);
3558 DEFSYMBOL (Qconst_boolean);
3559 DEFSYMBOL (Qconst_object);
3560 DEFSYMBOL (Qconst_specifier);
3561 DEFSYMBOL (Qdefault_buffer);
3562 DEFSYMBOL (Qcurrent_buffer);
3563 DEFSYMBOL (Qconst_current_buffer);
3564 DEFSYMBOL (Qdefault_console);
3565 DEFSYMBOL (Qselected_console);
3566 DEFSYMBOL (Qconst_selected_console);
3569 DEFSUBR (Fintern_soft);
3570 DEFSUBR (Funintern);
3571 DEFSUBR (Fmapatoms);
3572 DEFSUBR (Fapropos_internal);
3574 DEFSUBR (Fsymbol_function);
3575 DEFSUBR (Fsymbol_plist);
3576 DEFSUBR (Fsymbol_name);
3577 DEFSUBR (Fmakunbound);
3578 DEFSUBR (Ffmakunbound);
3580 DEFSUBR (Fglobally_boundp);
3583 DEFSUBR (Fdefine_function);
3584 Ffset (intern ("defalias"), intern ("define-function"));
3585 DEFSUBR (Fsetplist);
3586 DEFSUBR (Fsymbol_value_in_buffer);
3587 DEFSUBR (Fsymbol_value_in_console);
3588 DEFSUBR (Fbuilt_in_variable_type);
3589 DEFSUBR (Fsymbol_value);
3591 DEFSUBR (Fdefault_boundp);
3592 DEFSUBR (Fdefault_value);
3593 DEFSUBR (Fset_default);
3594 DEFSUBR (Fsetq_default);
3595 DEFSUBR (Fmake_variable_buffer_local);
3596 DEFSUBR (Fmake_local_variable);
3597 DEFSUBR (Fkill_local_variable);
3598 DEFSUBR (Fkill_console_local_variable);
3599 DEFSUBR (Flocal_variable_p);
3600 DEFSUBR (Fdefvaralias);
3601 DEFSUBR (Fvariable_alias);
3602 DEFSUBR (Findirect_variable);
3603 DEFSUBR (Fdontusethis_set_symbol_value_handler);
3606 /* Create and initialize a Lisp variable whose value is forwarded to C data */
3608 defvar_magic (const char *symbol_name, const struct symbol_value_forward *magic)
3612 #if defined(HAVE_SHLIB)
3614 * As with defsubr(), this will only be called in a dumped Emacs when
3615 * we are adding variables from a dynamically loaded module. That means
3616 * we can't use purespace. Take that into account.
3619 sym = Fintern (build_string (symbol_name), Qnil);
3622 sym = Fintern (make_string_nocopy ((const Bufbyte *) symbol_name,
3623 strlen (symbol_name)), Qnil);
3625 XSETOBJ (XSYMBOL (sym)->value, magic);
3629 vars_of_symbols (void)
3631 DEFVAR_LISP ("obarray", &Vobarray /*
3632 Symbol table for use by `intern' and `read'.
3633 It is a vector whose length ought to be prime for best results.
3634 The vector's contents don't make sense if examined from Lisp programs;
3635 to find all the symbols in an obarray, use `mapatoms'.
3637 /* obarray has been initialized long before */