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 SYMVAL_BOOLEAN_FORWARD:
794 (declare with DEFVAR_INT or DEFVAR_BOOL)
795 Similar to SYMVAL_OBJECT_FORWARD except that the C variable
796 is of type "int" and is an integer or boolean, respectively.
798 SYMVAL_CONST_OBJECT_FORWARD:
799 SYMVAL_CONST_FIXNUM_FORWARD:
800 SYMVAL_CONST_BOOLEAN_FORWARD:
801 (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
803 Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
804 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
807 SYMVAL_CONST_SPECIFIER_FORWARD:
808 (declare with DEFVAR_SPECIFIER)
809 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that the error
810 message you get when attempting to set the value says to use
811 `set-specifier' instead.
813 SYMVAL_CURRENT_BUFFER_FORWARD:
814 (declare with DEFVAR_BUFFER_LOCAL)
815 This is used for built-in buffer-local variables -- i.e.
816 Lisp variables whose value is stored in the "struct buffer".
817 Variables of this sort always forward into C "Lisp_Object"
818 fields (although there's no reason in principle that other
819 types for ints and booleans couldn't be added). Note that
820 some of these variables are automatically local in each
821 buffer, while some are only local when they become set
822 (similar to `make-variable-buffer-local'). In these latter
823 cases, of course, the default value shows through in all
824 buffers in which the variable doesn't have a local value.
825 This is implemented by making sure the "struct buffer" field
826 always contains the correct value (whether it's local or
827 a default) and maintaining a mask in the "struct buffer"
828 indicating which fields are local. When `set-default' is
829 called on a variable that's not always local to all buffers,
830 it loops through each buffer and sets the corresponding
831 field in each buffer without a local value for the field,
832 according to the mask.
834 Calling `make-local-variable' on a variable of this sort
835 only has the effect of maybe changing the current buffer's mask.
836 Calling `make-variable-buffer-local' on a variable of this
837 sort has no effect at all.
839 SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
840 (declare with DEFVAR_CONST_BUFFER_LOCAL)
841 Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
844 SYMVAL_DEFAULT_BUFFER_FORWARD:
845 (declare with DEFVAR_BUFFER_DEFAULTS)
846 This is used for the Lisp variables that contain the
847 default values of built-in buffer-local variables. Setting
848 or referencing one of these variables forwards into a slot
849 in the special struct buffer Vbuffer_defaults.
851 SYMVAL_UNBOUND_MARKER:
852 This is used for only one object, Qunbound.
854 SYMVAL_SELECTED_CONSOLE_FORWARD:
855 (declare with DEFVAR_CONSOLE_LOCAL)
856 This is used for built-in console-local variables -- i.e.
857 Lisp variables whose value is stored in the "struct console".
858 These work just like built-in buffer-local variables.
859 However, calling `make-local-variable' or
860 `make-variable-buffer-local' on one of these variables
861 is currently disallowed because that would entail having
862 both console-local and buffer-local variables, which is
863 trickier to implement.
865 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
866 (declare with DEFVAR_CONST_CONSOLE_LOCAL)
867 Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
870 SYMVAL_DEFAULT_CONSOLE_FORWARD:
871 (declare with DEFVAR_CONSOLE_DEFAULTS)
872 This is used for the Lisp variables that contain the
873 default values of built-in console-local variables. Setting
874 or referencing one of these variables forwards into a slot
875 in the special struct console Vconsole_defaults.
878 2. symbol-value-buffer-local
880 symbol-value-buffer-local is used for variables that have had
881 `make-local-variable' or `make-variable-buffer-local' applied
882 to them. This object contains an alist mapping buffers to
883 values. In addition, the object contains a "current value",
884 which is the value in some buffer. Whenever you access the
885 variable with `symbol-value' or set it with `set' or `setq',
886 things are switched around so that the "current value"
887 refers to the current buffer, if it wasn't already. This
888 way, repeated references to a variable in the same buffer
889 are almost as efficient as if the variable weren't buffer
890 local. Note that the alist may not be up-to-date w.r.t.
891 the buffer whose value is current, as the "current value"
892 cache is normally only flushed into the alist when the
893 buffer it refers to changes.
895 Note also that it is possible for `make-local-variable'
896 or `make-variable-buffer-local' to be called on a variable
897 that forwards into a C variable (i.e. a variable whose
898 value cell is a symbol-value-forward). In this case,
899 the value cell becomes a symbol-value-buffer-local (as
900 always), and the symbol-value-forward moves into
901 the "current value" cell in this object. Also, in
902 this case the "current value" *always* refers to the
903 current buffer, so that the values of the C variable
904 always is the correct value for the current buffer.
905 set_buffer_internal() automatically updates the current-value
906 cells of all buffer-local variables that forward into C
907 variables. (There is a list of all buffer-local variables
908 that is maintained for this and other purposes.)
910 Note that only certain types of `symbol-value-forward' objects
911 can find their way into the "current value" cell of a
912 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
913 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
914 SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot
915 be buffer-local because they are unsettable;
916 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
917 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
918 does not have much of an effect (it's already buffer-local); and
919 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
920 that's not currently implemented.
923 3. symbol-value-varalias
925 A symbol-value-varalias object is used for variables that
926 are aliases for other variables. This object contains
927 the symbol that this variable is aliased to.
928 symbol-value-varalias objects cannot occur anywhere within
929 a symbol-value-buffer-local object, and most of the
930 low-level functions below do not accept them; you need
931 to call follow_varalias_pointers to get the actual
932 symbol to operate on. */
935 mark_symbol_value_buffer_local (Lisp_Object obj)
937 struct symbol_value_buffer_local *bfwd;
939 #ifdef ERROR_CHECK_TYPECHECK
940 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
941 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
944 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
945 mark_object (bfwd->default_value);
946 mark_object (bfwd->current_value);
947 mark_object (bfwd->current_buffer);
948 return bfwd->current_alist_element;
952 mark_symbol_value_lisp_magic (Lisp_Object obj)
954 struct symbol_value_lisp_magic *bfwd;
957 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
959 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
960 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
962 mark_object (bfwd->handler[i]);
963 mark_object (bfwd->harg[i]);
965 return bfwd->shadowed;
969 mark_symbol_value_varalias (Lisp_Object obj)
971 struct symbol_value_varalias *bfwd;
973 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
975 bfwd = XSYMBOL_VALUE_VARALIAS (obj);
976 mark_object (bfwd->shadowed);
977 return bfwd->aliasee;
980 /* Should never, ever be called. (except by an external debugger) */
982 print_symbol_value_magic (Lisp_Object obj,
983 Lisp_Object printcharfun, int escapeflag)
986 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s type %d) 0x%lx>",
987 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
988 XSYMBOL_VALUE_MAGIC_TYPE (obj),
990 write_c_string (buf, printcharfun);
993 static const struct lrecord_description symbol_value_forward_description[] = {
997 static const struct lrecord_description symbol_value_buffer_local_description[] = {
998 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, default_value) },
999 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_value) },
1000 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_buffer) },
1001 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_alist_element) },
1005 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
1006 { XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 },
1010 static const struct lrecord_description symbol_value_varalias_description[] = {
1011 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, aliasee) },
1012 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, shadowed) },
1016 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
1017 symbol_value_forward,
1019 print_symbol_value_magic, 0, 0, 0,
1020 symbol_value_forward_description,
1021 struct symbol_value_forward);
1023 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
1024 symbol_value_buffer_local,
1025 mark_symbol_value_buffer_local,
1026 print_symbol_value_magic, 0, 0, 0,
1027 symbol_value_buffer_local_description,
1028 struct symbol_value_buffer_local);
1030 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
1031 symbol_value_lisp_magic,
1032 mark_symbol_value_lisp_magic,
1033 print_symbol_value_magic, 0, 0, 0,
1034 symbol_value_lisp_magic_description,
1035 struct symbol_value_lisp_magic);
1037 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
1038 symbol_value_varalias,
1039 mark_symbol_value_varalias,
1040 print_symbol_value_magic, 0, 0, 0,
1041 symbol_value_varalias_description,
1042 struct symbol_value_varalias);
1045 /* Getting and setting values of symbols */
1047 /* Given the raw contents of a symbol value cell, return the Lisp value of
1048 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
1049 symbol-value-lisp-magic, or symbol-value-varalias.
1051 BUFFER specifies a buffer, and is used for built-in buffer-local
1052 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
1053 Note that such variables are never encapsulated in a
1054 symbol-value-buffer-local structure.
1056 CONSOLE specifies a console, and is used for built-in console-local
1057 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
1058 Note that such variables are (currently) never encapsulated in a
1059 symbol-value-buffer-local structure.
1063 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
1064 struct console *console)
1066 const struct symbol_value_forward *fwd;
1068 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1071 fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1072 switch (fwd->magic.type)
1074 case SYMVAL_FIXNUM_FORWARD:
1075 case SYMVAL_CONST_FIXNUM_FORWARD:
1076 return make_int (*((int *)symbol_value_forward_forward (fwd)));
1078 case SYMVAL_BOOLEAN_FORWARD:
1079 case SYMVAL_CONST_BOOLEAN_FORWARD:
1080 return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
1082 case SYMVAL_OBJECT_FORWARD:
1083 case SYMVAL_CONST_OBJECT_FORWARD:
1084 case SYMVAL_CONST_SPECIFIER_FORWARD:
1085 return *((Lisp_Object *)symbol_value_forward_forward (fwd));
1087 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1088 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1089 + ((char *)symbol_value_forward_forward (fwd)
1090 - (char *)&buffer_local_flags))));
1093 case SYMVAL_CURRENT_BUFFER_FORWARD:
1094 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1096 return (*((Lisp_Object *)((char *)buffer
1097 + ((char *)symbol_value_forward_forward (fwd)
1098 - (char *)&buffer_local_flags))));
1100 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1101 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1102 + ((char *)symbol_value_forward_forward (fwd)
1103 - (char *)&console_local_flags))));
1105 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1106 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1108 return (*((Lisp_Object *)((char *)console
1109 + ((char *)symbol_value_forward_forward (fwd)
1110 - (char *)&console_local_flags))));
1112 case SYMVAL_UNBOUND_MARKER:
1118 return Qnil; /* suppress compiler warning */
1121 /* Set the value of default-buffer-local variable SYM to VALUE. */
1124 set_default_buffer_slot_variable (Lisp_Object sym,
1127 /* Handle variables like case-fold-search that have special slots in
1128 the buffer. Make them work apparently like buffer_local variables.
1130 /* At this point, the value cell may not contain a symbol-value-varalias
1131 or symbol-value-buffer-local, and if there's a handler, we should
1132 have already called it. */
1133 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1134 const struct symbol_value_forward *fwd
1135 = XSYMBOL_VALUE_FORWARD (valcontents);
1136 int offset = ((char *) symbol_value_forward_forward (fwd)
1137 - (char *) &buffer_local_flags);
1138 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1139 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1140 int flags) = symbol_value_forward_magicfun (fwd);
1142 *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
1145 if (mask > 0) /* Not always per-buffer */
1147 /* Set value in each buffer which hasn't shadowed the default */
1148 LIST_LOOP_2 (elt, Vbuffer_alist)
1150 struct buffer *b = XBUFFER (XCDR (elt));
1151 if (!(b->local_var_flags & mask))
1154 magicfun (sym, &value, make_buffer (b), 0);
1155 *((Lisp_Object *) (offset + (char *) b)) = value;
1161 /* Set the value of default-console-local variable SYM to VALUE. */
1164 set_default_console_slot_variable (Lisp_Object sym,
1167 /* Handle variables like case-fold-search that have special slots in
1168 the console. Make them work apparently like console_local variables.
1170 /* At this point, the value cell may not contain a symbol-value-varalias
1171 or symbol-value-buffer-local, and if there's a handler, we should
1172 have already called it. */
1173 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1174 const struct symbol_value_forward *fwd
1175 = XSYMBOL_VALUE_FORWARD (valcontents);
1176 int offset = ((char *) symbol_value_forward_forward (fwd)
1177 - (char *) &console_local_flags);
1178 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1179 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1180 int flags) = symbol_value_forward_magicfun (fwd);
1182 *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
1185 if (mask > 0) /* Not always per-console */
1187 /* Set value in each console which hasn't shadowed the default */
1188 LIST_LOOP_2 (console, Vconsole_list)
1190 struct console *d = XCONSOLE (console);
1191 if (!(d->local_var_flags & mask))
1194 magicfun (sym, &value, console, 0);
1195 *((Lisp_Object *) (offset + (char *) d)) = value;
1201 /* Store NEWVAL into SYM.
1203 SYM's value slot may *not* be types (5) or (6) above,
1204 i.e. no symbol-value-varalias objects. (You should have
1205 forwarded past all of these.)
1207 SYM should not be an unsettable symbol or a symbol with
1208 a magic `set-value' handler (unless you want to explicitly
1209 ignore this handler).
1211 OVALUE is the current value of SYM, but forwarded past any
1212 symbol-value-buffer-local and symbol-value-lisp-magic objects.
1213 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1214 the contents of its current-value cell.) NEWVAL may only be
1215 a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
1216 this function will only modify its current-value cell, which should
1217 already be set up to point to the current buffer.
1221 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
1224 if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
1226 Lisp_Object *store_pointer = value_slot_past_magic (sym);
1228 if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
1230 &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
1232 assert (UNBOUNDP (*store_pointer)
1233 || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1234 *store_pointer = newval;
1238 const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue);
1239 int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
1240 Lisp_Object in_object, int flags)
1241 = symbol_value_forward_magicfun (fwd);
1243 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue))
1245 case SYMVAL_FIXNUM_FORWARD:
1248 magicfun (sym, &newval, Qnil, 0);
1249 *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
1252 case SYMVAL_BOOLEAN_FORWARD:
1254 magicfun (sym, &newval, Qnil, 0);
1255 *((int *) symbol_value_forward_forward (fwd))
1259 case SYMVAL_OBJECT_FORWARD:
1261 magicfun (sym, &newval, Qnil, 0);
1262 *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
1265 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1266 set_default_buffer_slot_variable (sym, newval);
1269 case SYMVAL_CURRENT_BUFFER_FORWARD:
1271 magicfun (sym, &newval, make_buffer (current_buffer), 0);
1272 *((Lisp_Object *) ((char *) current_buffer
1273 + ((char *) symbol_value_forward_forward (fwd)
1274 - (char *) &buffer_local_flags)))
1278 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1279 set_default_console_slot_variable (sym, newval);
1282 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1284 magicfun (sym, &newval, Vselected_console, 0);
1285 *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console)
1286 + ((char *) symbol_value_forward_forward (fwd)
1287 - (char *) &console_local_flags)))
1297 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1298 BFWD, locate and return a pointer to the element in BUFFER's
1299 local_var_alist for SYMBOL. The return value will be Qnil if
1300 BUFFER does not have its own value for SYMBOL (i.e. the default
1301 value is seen in that buffer).
1305 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
1306 struct symbol_value_buffer_local *bfwd)
1308 if (!NILP (bfwd->current_buffer) &&
1309 XBUFFER (bfwd->current_buffer) == buffer)
1310 /* This is just an optimization of the below. */
1311 return bfwd->current_alist_element;
1313 return assq_no_quit (symbol, buffer->local_var_alist);
1316 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1317 symbol-value-buffer-local of a per-buffer variable -- i.e. the
1318 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1319 slot -- may be out of date.]
1321 Write out any cached value in buffer-local variable SYMBOL's
1322 buffer-local structure, which is passed in as BFWD.
1326 write_out_buffer_local_cache (Lisp_Object symbol,
1327 struct symbol_value_buffer_local *bfwd)
1329 if (!NILP (bfwd->current_buffer))
1331 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1332 uses it, and that type cannot be inside a symbol-value-buffer-local */
1333 Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0);
1334 if (NILP (bfwd->current_alist_element))
1335 /* current_value may be updated more recently than default_value */
1336 bfwd->default_value = cval;
1338 Fsetcdr (bfwd->current_alist_element, cval);
1342 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1343 Set up BFWD's cache for validity in buffer BUF. This assumes that
1344 the cache is currently in a consistent state (this can include
1345 not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1347 If the cache is already set up for BUF, this function does nothing
1350 Otherwise, if SYM forwards out to a C variable, this also forwards
1351 SYM's value in BUF out to the variable. Therefore, you generally
1352 only want to call this when BUF is, or is about to become, the
1355 (Otherwise, you can just retrieve the value without changing the
1356 cache, at the expense of slower retrieval.)
1360 set_up_buffer_local_cache (Lisp_Object sym,
1361 struct symbol_value_buffer_local *bfwd,
1363 Lisp_Object new_alist_el,
1366 Lisp_Object new_val;
1368 if (!NILP (bfwd->current_buffer)
1369 && buf == XBUFFER (bfwd->current_buffer))
1370 /* Cache is already set up. */
1373 /* Flush out the old cache. */
1374 write_out_buffer_local_cache (sym, bfwd);
1376 /* Retrieve the new alist element and new value. */
1377 if (NILP (new_alist_el)
1379 new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1381 if (NILP (new_alist_el))
1382 new_val = bfwd->default_value;
1384 new_val = Fcdr (new_alist_el);
1386 bfwd->current_alist_element = new_alist_el;
1387 XSETBUFFER (bfwd->current_buffer, buf);
1389 /* Now store the value into the current-value slot.
1390 We don't simply write it there, because the current-value
1391 slot might be a forwarding pointer, in which case we need
1392 to instead write the value into the C variable.
1394 We might also want to call a magic function.
1396 So instead, we call this function. */
1397 store_symval_forwarding (sym, bfwd->current_value, new_val);
1401 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1402 Flush the cache. BFWD->CURRENT_BUFFER will be nil after this operation.
1406 flush_buffer_local_cache (Lisp_Object sym,
1407 struct symbol_value_buffer_local *bfwd)
1409 if (NILP (bfwd->current_buffer))
1410 /* Cache is already flushed. */
1413 /* Flush out the old cache. */
1414 write_out_buffer_local_cache (sym, bfwd);
1416 bfwd->current_alist_element = Qnil;
1417 bfwd->current_buffer = Qnil;
1419 /* Now store default the value into the current-value slot.
1420 We don't simply write it there, because the current-value
1421 slot might be a forwarding pointer, in which case we need
1422 to instead write the value into the C variable.
1424 We might also want to call a magic function.
1426 So instead, we call this function. */
1427 store_symval_forwarding (sym, bfwd->current_value, bfwd->default_value);
1430 /* Flush all the buffer-local variable caches. Whoever has a
1431 non-interned buffer-local variable will be spanked. Whoever has a
1432 magic variable that interns or uninterns symbols... I don't even
1433 want to think about it.
1437 flush_all_buffer_local_cache (void)
1439 Lisp_Object *syms = XVECTOR_DATA (Vobarray);
1440 long count = XVECTOR_LENGTH (Vobarray);
1443 for (i=0; i<count; i++)
1445 Lisp_Object sym = syms[i];
1452 assert (SYMBOLP (sym));
1453 value = fetch_value_maybe_past_magic (sym, Qt);
1454 if (SYMBOL_VALUE_BUFFER_LOCAL_P (value))
1455 flush_buffer_local_cache (sym, XSYMBOL_VALUE_BUFFER_LOCAL (value));
1457 next = symbol_next (XSYMBOL (sym));
1460 XSETSYMBOL (sym, next);
1467 kill_buffer_local_variables (struct buffer *buf)
1469 Lisp_Object prev = Qnil;
1472 /* Any which are supposed to be permanent,
1473 make local again, with the same values they had. */
1475 for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
1477 Lisp_Object sym = XCAR (XCAR (alist));
1478 struct symbol_value_buffer_local *bfwd;
1479 /* Variables with a symbol-value-varalias should not be here
1480 (we should have forwarded past them) and there must be a
1481 symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
1482 just forward past it; if the variable has a handler, it was
1484 Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
1486 assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
1487 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
1489 if (!NILP (Fget (sym, Qpermanent_local, Qnil)))
1490 /* prev points to the last alist element that is still
1491 staying around, so *only* update it now. This didn't
1492 used to be the case; this bug has been around since
1493 mly's rewrite two years ago! */
1497 /* Really truly kill it. */
1499 XCDR (prev) = XCDR (alist);
1501 buf->local_var_alist = XCDR (alist);
1503 /* We just effectively changed the value for this variable
1506 /* (1) If the cache is caching BUF, invalidate the cache. */
1507 if (!NILP (bfwd->current_buffer) &&
1508 buf == XBUFFER (bfwd->current_buffer))
1509 bfwd->current_buffer = Qnil;
1511 /* (2) If we changed the value in current_buffer and this
1512 variable forwards to a C variable, we need to change the
1513 value of the C variable. set_up_buffer_local_cache()
1514 will do this. It doesn't hurt to do it whenever
1515 BUF == current_buffer, so just go ahead and do that. */
1516 if (buf == current_buffer)
1517 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
1523 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1524 struct console *con, int swap_it_in,
1525 Lisp_Object symcons, int set_it_p)
1527 Lisp_Object valcontents;
1530 valcontents = XSYMBOL (sym)->value;
1533 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1536 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1538 case SYMVAL_LISP_MAGIC:
1540 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1544 case SYMVAL_VARALIAS:
1545 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1547 /* presto change-o! */
1550 case SYMVAL_BUFFER_LOCAL:
1551 case SYMVAL_SOME_BUFFER_LOCAL:
1553 struct symbol_value_buffer_local *bfwd
1554 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1558 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1559 valcontents = bfwd->current_value;
1563 if (!NILP (bfwd->current_buffer) &&
1564 buf == XBUFFER (bfwd->current_buffer))
1565 valcontents = bfwd->current_value;
1566 else if (NILP (symcons))
1569 valcontents = assq_no_quit (sym, buf->local_var_alist);
1570 if (NILP (valcontents))
1571 valcontents = bfwd->default_value;
1573 valcontents = XCDR (valcontents);
1576 valcontents = XCDR (symcons);
1584 return do_symval_forwarding (valcontents, buf, con);
1588 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1589 bound. Note that it must not be possible to QUIT within this
1593 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
1600 buf = current_buffer;
1603 CHECK_BUFFER (buffer);
1604 buf = XBUFFER (buffer);
1607 return find_symbol_value_1 (sym, buf,
1608 /* If it bombs out at startup due to a
1609 Lisp error, this may be nil. */
1610 CONSOLEP (Vselected_console)
1611 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
1615 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1620 console = Vselected_console;
1622 CHECK_CONSOLE (console);
1624 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1628 /* Return the current value of SYM. The difference between this function
1629 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1630 this updates the CURRENT_VALUE slot of buffer-local variables to
1631 point to the current buffer, while symbol_value_in_buffer doesn't. */
1634 find_symbol_value (Lisp_Object sym)
1636 /* WARNING: This function can be called when current_buffer is 0
1637 and Vselected_console is Qnil, early in initialization. */
1638 struct console *con;
1639 Lisp_Object valcontents;
1643 valcontents = XSYMBOL (sym)->value;
1644 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1647 if (CONSOLEP (Vselected_console))
1648 con = XCONSOLE (Vselected_console);
1651 /* This can also get called while we're preparing to shutdown.
1652 #### What should really happen in that case? Should we
1653 actually fix things so we can't get here in that case? */
1655 assert (!initialized || preparing_for_armageddon);
1660 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
1663 /* This is an optimized function for quick lookup of buffer local symbols
1664 by avoiding O(n) search. This will work when either:
1665 a) We have already found the symbol e.g. by traversing local_var_alist.
1667 b) We know that the symbol will not be found in the current buffer's
1668 list of local variables.
1669 In the former case, find_it_p is 1 and symbol_cons is the element from
1670 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1673 This function is called from set_buffer_internal which does both of these
1677 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1679 /* WARNING: This function can be called when current_buffer is 0
1680 and Vselected_console is Qnil, early in initialization. */
1681 struct console *con;
1682 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1685 if (CONSOLEP (Vselected_console))
1686 con = XCONSOLE (Vselected_console);
1689 /* This can also get called while we're preparing to shutdown.
1690 #### What should really happen in that case? Should we
1691 actually fix things so we can't get here in that case? */
1693 assert (!initialized || preparing_for_armageddon);
1698 return find_symbol_value_1 (sym, current_buffer, con, 1,
1699 find_it_p ? symbol_cons : Qnil,
1703 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1704 Return SYMBOL's value. Error if that is void.
1708 Lisp_Object val = find_symbol_value (symbol);
1711 return Fsignal (Qvoid_variable, list1 (symbol));
1716 DEFUN ("set", Fset, 2, 2, 0, /*
1717 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1721 REGISTER Lisp_Object valcontents;
1723 /* remember, we're called by Fmakunbound() as well */
1725 CHECK_SYMBOL (symbol);
1728 sym = XSYMBOL (symbol);
1729 valcontents = sym->value;
1731 if (EQ (symbol, Qnil) ||
1733 SYMBOL_IS_KEYWORD (symbol))
1734 reject_constant_symbols (symbol, newval, 0,
1735 UNBOUNDP (newval) ? Qmakunbound : Qset);
1737 if (!SYMBOL_VALUE_MAGIC_P (valcontents) || UNBOUNDP (valcontents))
1739 sym->value = newval;
1743 reject_constant_symbols (symbol, newval, 0,
1744 UNBOUNDP (newval) ? Qmakunbound : Qset);
1746 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1748 case SYMVAL_LISP_MAGIC:
1750 if (UNBOUNDP (newval))
1752 maybe_call_magic_handler (symbol, Qmakunbound, 0);
1753 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = Qunbound;
1757 maybe_call_magic_handler (symbol, Qset, 1, newval);
1758 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = newval;
1762 case SYMVAL_VARALIAS:
1763 symbol = follow_varalias_pointers (symbol,
1765 ? Qmakunbound : Qset);
1766 /* presto change-o! */
1769 case SYMVAL_FIXNUM_FORWARD:
1770 case SYMVAL_BOOLEAN_FORWARD:
1771 case SYMVAL_OBJECT_FORWARD:
1772 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1773 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1774 if (UNBOUNDP (newval))
1775 signal_error (Qerror,
1776 list2 (build_string ("Cannot makunbound"), symbol));
1779 /* case SYMVAL_UNBOUND_MARKER: break; */
1781 case SYMVAL_CURRENT_BUFFER_FORWARD:
1783 const struct symbol_value_forward *fwd
1784 = XSYMBOL_VALUE_FORWARD (valcontents);
1785 int mask = XINT (*((Lisp_Object *)
1786 symbol_value_forward_forward (fwd)));
1788 /* Setting this variable makes it buffer-local */
1789 current_buffer->local_var_flags |= mask;
1793 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1795 const struct symbol_value_forward *fwd
1796 = XSYMBOL_VALUE_FORWARD (valcontents);
1797 int mask = XINT (*((Lisp_Object *)
1798 symbol_value_forward_forward (fwd)));
1800 /* Setting this variable makes it console-local */
1801 XCONSOLE (Vselected_console)->local_var_flags |= mask;
1805 case SYMVAL_BUFFER_LOCAL:
1806 case SYMVAL_SOME_BUFFER_LOCAL:
1808 /* If we want to examine or set the value and
1809 CURRENT-BUFFER is current, we just examine or set
1810 CURRENT-VALUE. If CURRENT-BUFFER is not current, we
1811 store the current CURRENT-VALUE value into
1812 CURRENT-ALIST- ELEMENT, then find the appropriate alist
1813 element for the buffer now current and set up
1814 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
1815 of that element, and store into CURRENT-BUFFER.
1817 If we are setting the variable and the current buffer does
1818 not have an alist entry for this variable, an alist entry is
1821 Note that CURRENT-VALUE can be a forwarding pointer.
1822 Each time it is examined or set, forwarding must be
1824 struct symbol_value_buffer_local *bfwd
1825 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1826 int some_buffer_local_p =
1827 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
1828 /* What value are we caching right now? */
1829 Lisp_Object aelt = bfwd->current_alist_element;
1831 if (!NILP (bfwd->current_buffer) &&
1832 current_buffer == XBUFFER (bfwd->current_buffer)
1833 && ((some_buffer_local_p)
1834 ? 1 /* doesn't automatically become local */
1835 : !NILP (aelt) /* already local */
1838 /* Cache is valid */
1839 valcontents = bfwd->current_value;
1843 /* If the current buffer is not the buffer whose binding is
1844 currently cached, or if it's a SYMVAL_BUFFER_LOCAL and
1845 we're looking at the default value, the cache is invalid; we
1846 need to write it out, and find the new CURRENT-ALIST-ELEMENT
1849 /* Write out the cached value for the old buffer; copy it
1850 back to its alist element. This works if the current
1851 buffer only sees the default value, too. */
1852 write_out_buffer_local_cache (symbol, bfwd);
1854 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1855 aelt = buffer_local_alist_element (current_buffer, symbol, bfwd);
1858 /* This buffer is still seeing the default value. */
1859 if (!some_buffer_local_p)
1861 /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a
1862 new assoc for a local value and set
1863 CURRENT-ALIST-ELEMENT to point to that. */
1865 do_symval_forwarding (bfwd->current_value,
1867 XCONSOLE (Vselected_console));
1868 aelt = Fcons (symbol, aelt);
1869 current_buffer->local_var_alist
1870 = Fcons (aelt, current_buffer->local_var_alist);
1874 /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
1875 we're currently seeing the default value. */
1879 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1880 bfwd->current_alist_element = aelt;
1881 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
1882 XSETBUFFER (bfwd->current_buffer, current_buffer);
1883 valcontents = bfwd->current_value;
1890 store_symval_forwarding (symbol, valcontents, newval);
1896 /* Access or set a buffer-local symbol's default value. */
1898 /* Return the default value of SYM, but don't check for voidness.
1899 Return Qunbound if it is void. */
1902 default_value (Lisp_Object sym)
1904 Lisp_Object valcontents;
1909 valcontents = XSYMBOL (sym)->value;
1912 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1915 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1917 case SYMVAL_LISP_MAGIC:
1919 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1923 case SYMVAL_VARALIAS:
1924 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1925 /* presto change-o! */
1928 case SYMVAL_UNBOUND_MARKER:
1931 case SYMVAL_CURRENT_BUFFER_FORWARD:
1933 const struct symbol_value_forward *fwd
1934 = XSYMBOL_VALUE_FORWARD (valcontents);
1935 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1936 + ((char *)symbol_value_forward_forward (fwd)
1937 - (char *)&buffer_local_flags))));
1940 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1942 const struct symbol_value_forward *fwd
1943 = XSYMBOL_VALUE_FORWARD (valcontents);
1944 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1945 + ((char *)symbol_value_forward_forward (fwd)
1946 - (char *)&console_local_flags))));
1949 case SYMVAL_BUFFER_LOCAL:
1950 case SYMVAL_SOME_BUFFER_LOCAL:
1952 struct symbol_value_buffer_local *bfwd =
1953 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1955 /* Handle user-created local variables. */
1956 /* If var is set up for a buffer that lacks a local value for it,
1957 the current value is nominally the default value.
1958 But the current value slot may be more up to date, since
1959 ordinary setq stores just that slot. So use that. */
1960 if (NILP (bfwd->current_alist_element))
1961 return do_symval_forwarding (bfwd->current_value, current_buffer,
1962 XCONSOLE (Vselected_console));
1964 return bfwd->default_value;
1967 /* For other variables, get the current value. */
1968 return do_symval_forwarding (valcontents, current_buffer,
1969 XCONSOLE (Vselected_console));
1972 RETURN_NOT_REACHED (Qnil) /* suppress compiler warning */
1975 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /*
1976 Return t if SYMBOL has a non-void default value.
1977 This is the value that is seen in buffers that do not have their own values
1982 return UNBOUNDP (default_value (symbol)) ? Qnil : Qt;
1985 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /*
1986 Return SYMBOL's default value.
1987 This is the value that is seen in buffers that do not have their own values
1988 for this variable. The default value is meaningful for variables with
1989 local bindings in certain buffers.
1993 Lisp_Object value = default_value (symbol);
1995 return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (symbol)) : value;
1998 DEFUN ("set-default", Fset_default, 2, 2, 0, /*
1999 Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated.
2000 The default value is seen in buffers that do not have their own values
2005 Lisp_Object valcontents;
2007 CHECK_SYMBOL (symbol);
2010 valcontents = XSYMBOL (symbol)->value;
2013 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2014 return Fset (symbol, value);
2016 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2018 case SYMVAL_LISP_MAGIC:
2019 RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (symbol, Qset_default, 1,
2021 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2025 case SYMVAL_VARALIAS:
2026 symbol = follow_varalias_pointers (symbol, Qset_default);
2027 /* presto change-o! */
2030 case SYMVAL_CURRENT_BUFFER_FORWARD:
2031 set_default_buffer_slot_variable (symbol, value);
2034 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2035 set_default_console_slot_variable (symbol, value);
2038 case SYMVAL_BUFFER_LOCAL:
2039 case SYMVAL_SOME_BUFFER_LOCAL:
2041 /* Store new value into the DEFAULT-VALUE slot */
2042 struct symbol_value_buffer_local *bfwd
2043 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2045 bfwd->default_value = value;
2046 /* If current-buffer doesn't shadow default_value,
2047 * we must set the CURRENT-VALUE slot too */
2048 if (NILP (bfwd->current_alist_element))
2049 store_symval_forwarding (symbol, bfwd->current_value, value);
2054 return Fset (symbol, value);
2058 DEFUN ("setq-default", Fsetq_default, 0, UNEVALLED, 0, /*
2059 Set the default value of variable SYMBOL to VALUE.
2060 SYMBOL, the variable name, is literal (not evaluated);
2061 VALUE is an expression and it is evaluated.
2062 The default value of a variable is seen in buffers
2063 that do not have their own values for the variable.
2065 More generally, you can use multiple variables and values, as in
2066 (setq-default SYMBOL VALUE SYMBOL VALUE...)
2067 This sets each SYMBOL's default value to the corresponding VALUE.
2068 The VALUE for the Nth SYMBOL can refer to the new default values
2069 of previous SYMBOLs.
2073 /* This function can GC */
2074 Lisp_Object symbol, tail, val = Qnil;
2076 struct gcpro gcpro1;
2078 GET_LIST_LENGTH (args, nargs);
2080 if (nargs & 1) /* Odd number of arguments? */
2081 Fsignal (Qwrong_number_of_arguments,
2082 list2 (Qsetq_default, make_int (nargs)));
2086 PROPERTY_LIST_LOOP (tail, symbol, val, args)
2089 Fset_default (symbol, val);
2096 /* Lisp functions for creating and removing buffer-local variables. */
2098 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1,
2099 "vMake Variable Buffer Local: ", /*
2100 Make VARIABLE have a separate value for each buffer.
2101 At any time, the value for the current buffer is in effect.
2102 There is also a default value which is seen in any buffer which has not yet
2104 Using `set' or `setq' to set the variable causes it to have a separate value
2105 for the current buffer if it was previously using the default value.
2106 The function `default-value' gets the default value and `set-default'
2111 Lisp_Object valcontents;
2113 CHECK_SYMBOL (variable);
2116 verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
2118 valcontents = XSYMBOL (variable)->value;
2121 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2123 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2125 case SYMVAL_LISP_MAGIC:
2126 if (!UNBOUNDP (maybe_call_magic_handler
2127 (variable, Qmake_variable_buffer_local, 0)))
2129 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2133 case SYMVAL_VARALIAS:
2134 variable = follow_varalias_pointers (variable,
2135 Qmake_variable_buffer_local);
2136 /* presto change-o! */
2139 case SYMVAL_FIXNUM_FORWARD:
2140 case SYMVAL_BOOLEAN_FORWARD:
2141 case SYMVAL_OBJECT_FORWARD:
2142 case SYMVAL_UNBOUND_MARKER:
2145 case SYMVAL_CURRENT_BUFFER_FORWARD:
2146 case SYMVAL_BUFFER_LOCAL:
2147 /* Already per-each-buffer */
2150 case SYMVAL_SOME_BUFFER_LOCAL:
2152 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
2153 SYMVAL_BUFFER_LOCAL;
2162 struct symbol_value_buffer_local *bfwd
2163 = alloc_lcrecord_type (struct symbol_value_buffer_local,
2164 &lrecord_symbol_value_buffer_local);
2166 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2168 bfwd->default_value = find_symbol_value (variable);
2169 bfwd->current_value = valcontents;
2170 bfwd->current_alist_element = Qnil;
2171 bfwd->current_buffer = Fcurrent_buffer ();
2172 XSETSYMBOL_VALUE_MAGIC (foo, bfwd);
2173 *value_slot_past_magic (variable) = foo;
2174 #if 1 /* #### Yuck! FSFmacs bug-compatibility*/
2175 /* This sets the default-value of any make-variable-buffer-local to nil.
2176 That just sucks. User can just use setq-default to effect that,
2177 but there's no way to do makunbound-default to undo this lossage. */
2178 if (UNBOUNDP (valcontents))
2179 bfwd->default_value = Qnil;
2181 #if 0 /* #### Yuck! */
2182 /* This sets the value to nil in this buffer.
2183 User could use (setq variable nil) to do this.
2184 It isn't as egregious to do this automatically
2185 as it is to do so to the default-value, but it's
2186 still really dubious. */
2187 if (UNBOUNDP (valcontents))
2188 Fset (variable, Qnil);
2194 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1,
2195 "vMake Local Variable: ", /*
2196 Make VARIABLE have a separate value in the current buffer.
2197 Other buffers will continue to share a common default value.
2198 \(The buffer-local value of VARIABLE starts out as the same value
2199 VARIABLE previously had. If VARIABLE was void, it remains void.)
2200 See also `make-variable-buffer-local'.
2202 If the variable is already arranged to become local when set,
2203 this function causes a local value to exist for this buffer,
2204 just as setting the variable would do.
2206 Do not use `make-local-variable' to make a hook variable buffer-local.
2207 Use `make-local-hook' instead.
2211 Lisp_Object valcontents;
2212 struct symbol_value_buffer_local *bfwd;
2214 CHECK_SYMBOL (variable);
2217 verify_ok_for_buffer_local (variable, Qmake_local_variable);
2219 valcontents = XSYMBOL (variable)->value;
2222 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2224 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2226 case SYMVAL_LISP_MAGIC:
2227 if (!UNBOUNDP (maybe_call_magic_handler
2228 (variable, Qmake_local_variable, 0)))
2230 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2234 case SYMVAL_VARALIAS:
2235 variable = follow_varalias_pointers (variable, Qmake_local_variable);
2236 /* presto change-o! */
2239 case SYMVAL_FIXNUM_FORWARD:
2240 case SYMVAL_BOOLEAN_FORWARD:
2241 case SYMVAL_OBJECT_FORWARD:
2242 case SYMVAL_UNBOUND_MARKER:
2245 case SYMVAL_BUFFER_LOCAL:
2246 case SYMVAL_CURRENT_BUFFER_FORWARD:
2248 /* Make sure the symbol has a local value in this particular
2249 buffer, by setting it to the same value it already has. */
2250 Fset (variable, find_symbol_value (variable));
2254 case SYMVAL_SOME_BUFFER_LOCAL:
2256 if (!NILP (buffer_local_alist_element (current_buffer,
2258 (XSYMBOL_VALUE_BUFFER_LOCAL
2260 goto already_local_to_current_buffer;
2262 goto already_local_to_some_other_buffer;
2270 /* Make sure variable is set up to hold per-buffer values */
2271 bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
2272 &lrecord_symbol_value_buffer_local);
2273 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2275 bfwd->current_buffer = Qnil;
2276 bfwd->current_alist_element = Qnil;
2277 bfwd->current_value = valcontents;
2278 /* passing 0 is OK because this should never be a
2279 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2281 bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
2284 if (UNBOUNDP (bfwd->default_value))
2285 bfwd->default_value = Qnil; /* Yuck! */
2288 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
2289 *value_slot_past_magic (variable) = valcontents;
2291 already_local_to_some_other_buffer:
2293 /* Make sure this buffer has its own value of variable */
2294 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2296 if (UNBOUNDP (bfwd->default_value))
2298 /* If default value is unbound, set local value to nil. */
2299 XSETBUFFER (bfwd->current_buffer, current_buffer);
2300 bfwd->current_alist_element = Fcons (variable, Qnil);
2301 current_buffer->local_var_alist =
2302 Fcons (bfwd->current_alist_element, current_buffer->local_var_alist);
2303 store_symval_forwarding (variable, bfwd->current_value, Qnil);
2307 current_buffer->local_var_alist
2308 = Fcons (Fcons (variable, bfwd->default_value),
2309 current_buffer->local_var_alist);
2311 /* Make sure symbol does not think it is set up for this buffer;
2312 force it to look once again for this buffer's value */
2313 if (!NILP (bfwd->current_buffer) &&
2314 current_buffer == XBUFFER (bfwd->current_buffer))
2315 bfwd->current_buffer = Qnil;
2317 already_local_to_current_buffer:
2319 /* If the symbol forwards into a C variable, then swap in the
2320 variable for this buffer immediately. If C code modifies the
2321 variable before we swap in, then that new value will clobber the
2322 default value the next time we swap. */
2323 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2324 if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value))
2326 switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
2328 case SYMVAL_FIXNUM_FORWARD:
2329 case SYMVAL_BOOLEAN_FORWARD:
2330 case SYMVAL_OBJECT_FORWARD:
2331 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2332 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2335 case SYMVAL_UNBOUND_MARKER:
2336 case SYMVAL_CURRENT_BUFFER_FORWARD:
2347 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1,
2348 "vKill Local Variable: ", /*
2349 Make VARIABLE no longer have a separate value in the current buffer.
2350 From now on the default value will apply in this buffer.
2354 Lisp_Object valcontents;
2356 CHECK_SYMBOL (variable);
2359 valcontents = XSYMBOL (variable)->value;
2362 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2365 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2367 case SYMVAL_LISP_MAGIC:
2368 if (!UNBOUNDP (maybe_call_magic_handler
2369 (variable, Qkill_local_variable, 0)))
2371 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2375 case SYMVAL_VARALIAS:
2376 variable = follow_varalias_pointers (variable, Qkill_local_variable);
2377 /* presto change-o! */
2380 case SYMVAL_CURRENT_BUFFER_FORWARD:
2382 const struct symbol_value_forward *fwd
2383 = XSYMBOL_VALUE_FORWARD (valcontents);
2384 int offset = ((char *) symbol_value_forward_forward (fwd)
2385 - (char *) &buffer_local_flags);
2387 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2391 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2392 Lisp_Object in_object, int flags) =
2393 symbol_value_forward_magicfun (fwd);
2394 Lisp_Object oldval = * (Lisp_Object *)
2395 (offset + (char *) XBUFFER (Vbuffer_defaults));
2397 (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
2398 *(Lisp_Object *) (offset + (char *) current_buffer)
2400 current_buffer->local_var_flags &= ~mask;
2405 case SYMVAL_BUFFER_LOCAL:
2406 case SYMVAL_SOME_BUFFER_LOCAL:
2408 /* Get rid of this buffer's alist element, if any */
2409 struct symbol_value_buffer_local *bfwd
2410 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2411 Lisp_Object alist = current_buffer->local_var_alist;
2412 Lisp_Object alist_element
2413 = buffer_local_alist_element (current_buffer, variable, bfwd);
2415 if (!NILP (alist_element))
2416 current_buffer->local_var_alist = Fdelq (alist_element, alist);
2418 /* Make sure symbol does not think it is set up for this buffer;
2419 force it to look once again for this buffer's value */
2420 if (!NILP (bfwd->current_buffer) &&
2421 current_buffer == XBUFFER (bfwd->current_buffer))
2422 bfwd->current_buffer = Qnil;
2424 /* We just changed the value in the current_buffer. If this
2425 variable forwards to a C variable, we need to change the
2426 value of the C variable. set_up_buffer_local_cache()
2427 will do this. It doesn't hurt to do it always,
2428 so just go ahead and do that. */
2429 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2436 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2440 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2441 "vKill Console Local Variable: ", /*
2442 Make VARIABLE no longer have a separate value in the selected console.
2443 From now on the default value will apply in this console.
2447 Lisp_Object valcontents;
2449 CHECK_SYMBOL (variable);
2452 valcontents = XSYMBOL (variable)->value;
2455 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2458 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2460 case SYMVAL_LISP_MAGIC:
2461 if (!UNBOUNDP (maybe_call_magic_handler
2462 (variable, Qkill_console_local_variable, 0)))
2464 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2468 case SYMVAL_VARALIAS:
2469 variable = follow_varalias_pointers (variable,
2470 Qkill_console_local_variable);
2471 /* presto change-o! */
2474 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2476 const struct symbol_value_forward *fwd
2477 = XSYMBOL_VALUE_FORWARD (valcontents);
2478 int offset = ((char *) symbol_value_forward_forward (fwd)
2479 - (char *) &console_local_flags);
2481 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2485 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2486 Lisp_Object in_object, int flags) =
2487 symbol_value_forward_magicfun (fwd);
2488 Lisp_Object oldval = * (Lisp_Object *)
2489 (offset + (char *) XCONSOLE (Vconsole_defaults));
2491 magicfun (variable, &oldval, Vselected_console, 0);
2492 *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
2494 XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
2504 /* Used by specbind to determine what effects it might have. Returns:
2505 * 0 if symbol isn't buffer-local, and wouldn't be after it is set
2506 * <0 if symbol isn't presently buffer-local, but set would make it so
2507 * >0 if symbol is presently buffer-local
2510 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
2512 Lisp_Object valcontents;
2515 valcontents = XSYMBOL (symbol)->value;
2518 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2520 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2522 case SYMVAL_LISP_MAGIC:
2524 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2528 case SYMVAL_VARALIAS:
2529 symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
2530 /* presto change-o! */
2533 case SYMVAL_CURRENT_BUFFER_FORWARD:
2535 const struct symbol_value_forward *fwd
2536 = XSYMBOL_VALUE_FORWARD (valcontents);
2537 int mask = XINT (*((Lisp_Object *)
2538 symbol_value_forward_forward (fwd)));
2539 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
2540 /* Already buffer-local */
2543 /* Would be buffer-local after set */
2546 case SYMVAL_BUFFER_LOCAL:
2547 case SYMVAL_SOME_BUFFER_LOCAL:
2549 struct symbol_value_buffer_local *bfwd
2550 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2552 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
2555 /* Automatically becomes local when set */
2556 return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
2566 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2567 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2569 (symbol, buffer, unbound_value))
2572 CHECK_SYMBOL (symbol);
2573 CHECK_BUFFER (buffer);
2574 value = symbol_value_in_buffer (symbol, buffer);
2575 return UNBOUNDP (value) ? unbound_value : value;
2578 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2579 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2581 (symbol, console, unbound_value))
2584 CHECK_SYMBOL (symbol);
2585 CHECK_CONSOLE (console);
2586 value = symbol_value_in_console (symbol, console);
2587 return UNBOUNDP (value) ? unbound_value : value;
2590 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
2591 If SYMBOL is a built-in variable, return info about this; else return nil.
2592 The returned info will be a symbol, one of
2594 `object' A simple built-in variable.
2595 `const-object' Same, but cannot be set.
2596 `integer' A built-in integer variable.
2597 `const-integer' Same, but cannot be set.
2598 `boolean' A built-in boolean variable.
2599 `const-boolean' Same, but cannot be set.
2600 `const-specifier' Always contains a specifier; e.g. `has-modeline-p'.
2601 `current-buffer' A built-in buffer-local variable.
2602 `const-current-buffer' Same, but cannot be set.
2603 `default-buffer' Forwards to the default value of a built-in
2604 buffer-local variable.
2605 `selected-console' A built-in console-local variable.
2606 `const-selected-console' Same, but cannot be set.
2607 `default-console' Forwards to the default value of a built-in
2608 console-local variable.
2612 REGISTER Lisp_Object valcontents;
2614 CHECK_SYMBOL (symbol);
2617 valcontents = XSYMBOL (symbol)->value;
2620 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2623 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2625 case SYMVAL_LISP_MAGIC:
2626 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2630 case SYMVAL_VARALIAS:
2631 symbol = follow_varalias_pointers (symbol, Qt);
2632 /* presto change-o! */
2635 case SYMVAL_BUFFER_LOCAL:
2636 case SYMVAL_SOME_BUFFER_LOCAL:
2638 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value;
2642 case SYMVAL_FIXNUM_FORWARD: return Qinteger;
2643 case SYMVAL_CONST_FIXNUM_FORWARD: return Qconst_integer;
2644 case SYMVAL_BOOLEAN_FORWARD: return Qboolean;
2645 case SYMVAL_CONST_BOOLEAN_FORWARD: return Qconst_boolean;
2646 case SYMVAL_OBJECT_FORWARD: return Qobject;
2647 case SYMVAL_CONST_OBJECT_FORWARD: return Qconst_object;
2648 case SYMVAL_CONST_SPECIFIER_FORWARD: return Qconst_specifier;
2649 case SYMVAL_DEFAULT_BUFFER_FORWARD: return Qdefault_buffer;
2650 case SYMVAL_CURRENT_BUFFER_FORWARD: return Qcurrent_buffer;
2651 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: return Qconst_current_buffer;
2652 case SYMVAL_DEFAULT_CONSOLE_FORWARD: return Qdefault_console;
2653 case SYMVAL_SELECTED_CONSOLE_FORWARD: return Qselected_console;
2654 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: return Qconst_selected_console;
2655 case SYMVAL_UNBOUND_MARKER: return Qnil;
2658 abort (); return Qnil;
2663 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
2664 Return t if SYMBOL's value is local to BUFFER.
2665 If optional third arg AFTER-SET is non-nil, return t if SYMBOL would be
2666 buffer-local after it is set, regardless of whether it is so presently.
2667 A nil value for BUFFER is *not* the same as (current-buffer), but means
2668 "no buffer". Specifically:
2670 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
2671 the variable is one of the special built-in variables that is always
2672 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
2673 `buffer-undo-list', and others.)
2675 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
2676 the variable has had `make-variable-buffer-local' applied to it.
2678 (symbol, buffer, after_set))
2682 CHECK_SYMBOL (symbol);
2685 buffer = get_buffer (buffer, 1);
2686 local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
2690 local_info = symbol_value_buffer_local_info (symbol, 0);
2693 if (NILP (after_set))
2694 return local_info > 0 ? Qt : Qnil;
2696 return local_info != 0 ? Qt : Qnil;
2701 I've gone ahead and partially implemented this because it's
2702 super-useful for dealing with the compatibility problems in supporting
2703 the old pointer-shape variables, and preventing people from `setq'ing
2704 the new variables. Any other way of handling this problem is way
2705 ugly, likely to be slow, and generally not something I want to waste
2706 my time worrying about.
2708 The interface and/or function name is sure to change before this
2709 gets into its final form. I currently like the way everything is
2710 set up and it has all the features I want it to have, except for
2711 one: I really want to be able to have multiple nested handlers,
2712 to implement an `advice'-like capability. This would allow,
2713 for example, a clean way of implementing `debug-if-set' or
2714 `debug-if-referenced' and such.
2716 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
2717 ************************************************************
2718 **Only** the `set-value', `make-unbound', and `make-local'
2719 handler types are currently implemented. Implementing the
2720 get-value and bound-predicate handlers is somewhat tricky
2721 because there are lots of subfunctions (e.g. find_symbol_value()).
2722 find_symbol_value(), in fact, is called from outside of
2723 this module. You'd have to have it do this:
2725 -- check for a `bound-predicate' handler, call that if so;
2726 if it returns nil, return Qunbound
2727 -- check for a `get-value' handler and call it and return
2730 It gets even trickier when you have to deal with
2731 sub-subfunctions like find_symbol_value_1(), and esp.
2732 when you have to properly handle variable aliases, which
2733 can lead to lots of tricky situations. So I've just
2734 punted on this, since the interface isn't officially
2735 exported and we can get by with just a `set-value'
2738 Actions in unimplemented handler types will correctly
2739 ignore any handlers, and will not fuck anything up or
2742 WARNING WARNING: If you do go and implement another
2743 type of handler, make *sure* to change
2744 would_be_magic_handled() so it knows about this,
2745 or dire things could result.
2746 ************************************************************
2747 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
2749 Real documentation is as follows.
2751 Set a magic handler for VARIABLE.
2752 This allows you to specify arbitrary behavior that results from
2753 accessing or setting a variable. For example, retrieving the
2754 variable's value might actually retrieve the first element off of
2755 a list stored in another variable, and setting the variable's value
2756 might add an element to the front of that list. (This is how the
2757 obsolete variable `unread-command-event' is implemented.)
2759 In general it is NOT good programming practice to use magic variables
2760 in a new package that you are designing. If you feel the need to
2761 do this, it's almost certainly a sign that you should be using a
2762 function instead of a variable. This facility is provided to allow
2763 a package to support obsolete variables and provide compatibility
2764 with similar packages with different variable names and semantics.
2765 By using magic handlers, you can cleanly provide obsoleteness and
2766 compatibility support and separate this support from the core
2767 routines in a package.
2769 VARIABLE should be a symbol naming the variable for which the
2770 magic behavior is provided. HANDLER-TYPE is a symbol specifying
2771 which behavior is being controlled, and HANDLER is the function
2772 that will be called to control this behavior. HARG is a
2773 value that will be passed to HANDLER but is otherwise
2774 uninterpreted. KEEP-EXISTING specifies what to do with existing
2775 handlers of the same type; nil means "erase them all", t means
2776 "keep them but insert at the beginning", the list (t) means
2777 "keep them but insert at the end", a function means "keep
2778 them but insert before the specified function", a list containing
2779 a function means "keep them but insert after the specified
2782 You can specify magic behavior for any type of variable at all,
2783 and for any handler types that are unspecified, the standard
2784 behavior applies. This allows you, for example, to use
2785 `defvaralias' in conjunction with this function. (For that
2786 matter, `defvaralias' could be implemented using this function.)
2788 The behaviors that can be specified in HANDLER-TYPE are
2790 get-value (SYM ARGS FUN HARG HANDLERS)
2791 This means that one of the functions `symbol-value',
2792 `default-value', `symbol-value-in-buffer', or
2793 `symbol-value-in-console' was called on SYM.
2795 set-value (SYM ARGS FUN HARG HANDLERS)
2796 This means that one of the functions `set' or `set-default'
2799 bound-predicate (SYM ARGS FUN HARG HANDLERS)
2800 This means that one of the functions `boundp', `globally-boundp',
2801 or `default-boundp' was called on SYM.
2803 make-unbound (SYM ARGS FUN HARG HANDLERS)
2804 This means that the function `makunbound' was called on SYM.
2806 local-predicate (SYM ARGS FUN HARG HANDLERS)
2807 This means that the function `local-variable-p' was called
2810 make-local (SYM ARGS FUN HARG HANDLERS)
2811 This means that one of the functions `make-local-variable',
2812 `make-variable-buffer-local', `kill-local-variable',
2813 or `kill-console-local-variable' was called on SYM.
2815 The meanings of the arguments are as follows:
2817 SYM is the symbol on which the function was called, and is always
2818 the first argument to the function.
2820 ARGS are the remaining arguments in the original call (i.e. all
2821 but the first). In the case of `set-value' in particular,
2822 the first element of ARGS is the value to which the variable
2823 is being set. In some cases, ARGS is sanitized from what was
2824 actually given. For example, whenever `nil' is passed to an
2825 argument and it means `current-buffer', the current buffer is
2826 substituted instead.
2828 FUN is a symbol indicating which function is being called.
2829 For many of the functions, you can determine the corresponding
2830 function of a different class using
2831 `symbol-function-corresponding-function'.
2833 HARG is the argument that was given in the call
2834 to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
2836 HANDLERS is a structure containing the remaining handlers
2837 for the variable; to call one of them, use
2838 `chain-to-symbol-value-handler'.
2840 NOTE: You may *not* modify the list in ARGS, and if you want to
2841 keep it around after the handler function exits, you must make
2842 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
2845 static enum lisp_magic_handler
2846 decode_magic_handler_type (Lisp_Object symbol)
2848 if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE;
2849 if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE;
2850 if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE;
2851 if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND;
2852 if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE;
2853 if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL;
2855 signal_simple_error ("Unrecognized symbol value handler type", symbol);
2857 return MAGIC_HANDLER_MAX;
2860 static enum lisp_magic_handler
2861 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
2863 if (EQ (funsym, Qsymbol_value)
2864 || EQ (funsym, Qdefault_value)
2865 || EQ (funsym, Qsymbol_value_in_buffer)
2866 || EQ (funsym, Qsymbol_value_in_console))
2867 return MAGIC_HANDLER_GET_VALUE;
2869 if (EQ (funsym, Qset)
2870 || EQ (funsym, Qset_default))
2871 return MAGIC_HANDLER_SET_VALUE;
2873 if (EQ (funsym, Qboundp)
2874 || EQ (funsym, Qglobally_boundp)
2875 || EQ (funsym, Qdefault_boundp))
2876 return MAGIC_HANDLER_BOUND_PREDICATE;
2878 if (EQ (funsym, Qmakunbound))
2879 return MAGIC_HANDLER_MAKE_UNBOUND;
2881 if (EQ (funsym, Qlocal_variable_p))
2882 return MAGIC_HANDLER_LOCAL_PREDICATE;
2884 if (EQ (funsym, Qmake_variable_buffer_local)
2885 || EQ (funsym, Qmake_local_variable))
2886 return MAGIC_HANDLER_MAKE_LOCAL;
2888 if (abort_if_not_found)
2890 signal_simple_error ("Unrecognized symbol-value function", funsym);
2891 return MAGIC_HANDLER_MAX;
2895 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
2897 /* does not take into account variable aliasing. */
2898 Lisp_Object valcontents = XSYMBOL (sym)->value;
2899 enum lisp_magic_handler slot;
2901 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2903 slot = handler_type_from_function_symbol (funsym, 1);
2904 if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND
2905 && slot != MAGIC_HANDLER_MAKE_LOCAL)
2906 /* #### temporary kludge because we haven't implemented
2907 lisp-magic variables completely */
2909 return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
2913 fetch_value_maybe_past_magic (Lisp_Object sym,
2914 Lisp_Object follow_past_lisp_magic)
2916 Lisp_Object value = XSYMBOL (sym)->value;
2917 if (SYMBOL_VALUE_LISP_MAGIC_P (value)
2918 && (EQ (follow_past_lisp_magic, Qt)
2919 || (!NILP (follow_past_lisp_magic)
2920 && !would_be_magic_handled (sym, follow_past_lisp_magic))))
2921 value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed;
2925 static Lisp_Object *
2926 value_slot_past_magic (Lisp_Object sym)
2928 Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
2930 if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
2931 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
2932 return store_pointer;
2936 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
2939 Lisp_Object args[20]; /* should be enough ... */
2941 enum lisp_magic_handler htype;
2942 Lisp_Object legerdemain;
2943 struct symbol_value_lisp_magic *bfwd;
2945 assert (nargs >= 0 && nargs < countof (args));
2946 legerdemain = XSYMBOL (sym)->value;
2947 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2948 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2950 va_start (vargs, nargs);
2951 for (i = 0; i < nargs; i++)
2952 args[i] = va_arg (vargs, Lisp_Object);
2955 htype = handler_type_from_function_symbol (funsym, 1);
2956 if (NILP (bfwd->handler[htype]))
2958 /* #### should be reusing the arglist, not always consing anew.
2959 Repeated handler invocations should not cause repeated consing.
2960 Doesn't matter for now, because this is just a quick implementation
2961 for obsolescence support. */
2962 return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym,
2963 bfwd->harg[htype], Qnil);
2966 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
2968 Don't you dare use this.
2969 If you do, suffer the wrath of Ben, who is likely to rename
2970 this function (or change the semantics of its arguments) without
2971 pity, thereby invalidating your code.
2973 (variable, handler_type, handler, harg, keep_existing))
2975 Lisp_Object valcontents;
2976 struct symbol_value_lisp_magic *bfwd;
2977 enum lisp_magic_handler htype;
2980 /* #### WARNING, only some handler types are implemented. See above.
2981 Actions of other types will ignore a handler if it's there.
2983 #### Also, `chain-to-symbol-value-handler' and
2984 `symbol-function-corresponding-function' are not implemented. */
2985 CHECK_SYMBOL (variable);
2986 CHECK_SYMBOL (handler_type);
2987 htype = decode_magic_handler_type (handler_type);
2988 valcontents = XSYMBOL (variable)->value;
2989 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2991 bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
2992 &lrecord_symbol_value_lisp_magic);
2993 bfwd->magic.type = SYMVAL_LISP_MAGIC;
2994 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2996 bfwd->handler[i] = Qnil;
2997 bfwd->harg[i] = Qnil;
2999 bfwd->shadowed = valcontents;
3000 XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
3003 bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
3004 bfwd->handler[htype] = handler;
3005 bfwd->harg[htype] = harg;
3007 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
3008 if (!NILP (bfwd->handler[i]))
3011 if (i == MAGIC_HANDLER_MAX)
3012 /* there are no remaining handlers, so remove the structure. */
3013 XSYMBOL (variable)->value = bfwd->shadowed;
3019 /* functions for working with variable aliases. */
3021 /* Follow the chain of variable aliases for SYMBOL. Return the
3022 resulting symbol, whose value cell is guaranteed not to be a
3023 symbol-value-varalias.
3025 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
3026 If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
3027 never follow; stop right there. Otherwise FUNSYM should be a
3028 recognized symbol-value function symbol; this means, follow
3029 unless there is a special handler for the named function.
3031 OK, there is at least one reason why it's necessary for
3032 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
3033 can always be sure to catch cyclic variable aliasing. If we never
3034 follow past Lisp magic, then if the following is done:
3037 add some magic behavior to a, but not a "get-value" handler
3040 then an attempt to retrieve a's or b's value would cause infinite
3041 looping in `symbol-value'.
3043 We (of course) can't always follow past Lisp magic, because then
3044 we make any variable that is lisp-magic -> varalias behave as if
3045 the lisp-magic is not present at all.
3049 follow_varalias_pointers (Lisp_Object symbol,
3050 Lisp_Object follow_past_lisp_magic)
3052 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
3053 Lisp_Object tortoise, hare, val;
3056 /* quick out just in case */
3057 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value))
3060 /* Compare implementation of indirect_function(). */
3061 for (hare = tortoise = symbol, count = 0;
3062 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic),
3063 SYMBOL_VALUE_VARALIAS_P (val);
3064 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)),
3067 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue;
3070 tortoise = symbol_value_varalias_aliasee
3071 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic
3072 (tortoise, follow_past_lisp_magic)));
3073 if (EQ (hare, tortoise))
3074 return Fsignal (Qcyclic_variable_indirection, list1 (symbol));
3080 DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
3081 Define a variable as an alias for another variable.
3082 Thenceforth, any operations performed on VARIABLE will actually be
3083 performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
3084 If ALIAS is nil, remove any aliases for VARIABLE.
3085 ALIAS can itself be aliased, and the chain of variable aliases
3086 will be followed appropriately.
3087 If VARIABLE already has a value, this value will be shadowed
3088 until the alias is removed, at which point it will be restored.
3089 Currently VARIABLE cannot be a built-in variable, a variable that
3090 has a buffer-local value in any buffer, or the symbols nil or t.
3091 \(ALIAS, however, can be any type of variable.)
3095 struct symbol_value_varalias *bfwd;
3096 Lisp_Object valcontents;
3098 CHECK_SYMBOL (variable);
3099 reject_constant_symbols (variable, Qunbound, 0, Qt);
3101 valcontents = XSYMBOL (variable)->value;
3105 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3107 XSYMBOL (variable)->value =
3108 symbol_value_varalias_shadowed
3109 (XSYMBOL_VALUE_VARALIAS (valcontents));
3114 CHECK_SYMBOL (alias);
3115 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3118 XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
3122 if (SYMBOL_VALUE_MAGIC_P (valcontents)
3123 && !UNBOUNDP (valcontents))
3124 signal_simple_error ("Variable is magic and cannot be aliased", variable);
3125 reject_constant_symbols (variable, Qunbound, 0, Qt);
3127 bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
3128 &lrecord_symbol_value_varalias);
3129 bfwd->magic.type = SYMVAL_VARALIAS;
3130 bfwd->aliasee = alias;
3131 bfwd->shadowed = valcontents;
3133 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
3134 XSYMBOL (variable)->value = valcontents;
3138 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
3139 If VARIABLE is aliased to another variable, return that variable.
3140 VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
3141 Variable aliases are created with `defvaralias'. See also
3142 `indirect-variable'.
3144 (variable, follow_past_lisp_magic))
3146 Lisp_Object valcontents;
3148 CHECK_SYMBOL (variable);
3149 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3151 CHECK_SYMBOL (follow_past_lisp_magic);
3152 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3155 valcontents = fetch_value_maybe_past_magic (variable,
3156 follow_past_lisp_magic);
3158 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3159 return symbol_value_varalias_aliasee
3160 (XSYMBOL_VALUE_VARALIAS (valcontents));
3165 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /*
3166 Return the variable at the end of OBJECT's variable-alias chain.
3167 If OBJECT is a symbol, follow all variable aliases and return
3168 the final (non-aliased) symbol. Variable aliases are created with
3169 the function `defvaralias'.
3170 If OBJECT is not a symbol, just return it.
3171 Signal a cyclic-variable-indirection error if there is a loop in the
3172 variable chain of symbols.
3174 (object, follow_past_lisp_magic))
3176 if (!SYMBOLP (object))
3178 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3180 CHECK_SYMBOL (follow_past_lisp_magic);
3181 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3183 return follow_varalias_pointers (object, follow_past_lisp_magic);
3187 /************************************************************************/
3188 /* initialization */
3189 /************************************************************************/
3191 /* A dumped XEmacs image has a lot more than 1511 symbols. Last
3192 estimate was that there were actually around 6300. So let's try
3193 making this bigger and see if we get better hashing behavior. */
3194 #define OBARRAY_SIZE 16411
3199 #ifndef Qnull_pointer
3200 Lisp_Object Qnull_pointer;
3203 /* some losing systems can't have static vars at function scope... */
3204 static const struct symbol_value_magic guts_of_unbound_marker =
3205 { /* struct symbol_value_magic */
3206 { /* struct lcrecord_header */
3207 { /* struct lrecord_header */
3208 lrecord_type_symbol_value_forward, /* lrecord_type_index */
3210 1, /* c_readonly bit */
3211 1, /* lisp_readonly bit */
3218 SYMVAL_UNBOUND_MARKER
3222 init_symbols_once_early (void)
3224 INIT_LRECORD_IMPLEMENTATION (symbol);
3225 INIT_LRECORD_IMPLEMENTATION (symbol_value_forward);
3226 INIT_LRECORD_IMPLEMENTATION (symbol_value_buffer_local);
3227 INIT_LRECORD_IMPLEMENTATION (symbol_value_lisp_magic);
3228 INIT_LRECORD_IMPLEMENTATION (symbol_value_varalias);
3230 reinit_symbols_once_early ();
3232 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3233 called the first time. */
3234 Qnil = Fmake_symbol (make_string_nocopy ((const Bufbyte *) "nil", 3));
3235 XSYMBOL (Qnil)->name->plist = Qnil;
3236 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
3237 XSYMBOL (Qnil)->plist = Qnil;
3239 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3240 initial_obarray = Vobarray;
3241 staticpro (&initial_obarray);
3242 /* Intern nil in the obarray */
3244 int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
3245 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3249 /* Required to get around a GCC syntax error on certain
3251 const struct symbol_value_magic *tem = &guts_of_unbound_marker;
3253 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3256 XSYMBOL (Qnil)->function = Qunbound;
3258 defsymbol (&Qt, "t");
3259 XSYMBOL (Qt)->value = Qt; /* Veritas aeterna */
3263 pdump_wire (&Qunbound);
3264 pdump_wire (&Vquit_flag);
3268 reinit_symbols_once_early (void)
3271 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3274 #ifndef Qnull_pointer
3275 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3276 so the following is actually a no-op. */
3277 XSETOBJ (Qnull_pointer, 0);
3282 defsymbol_massage_name_1 (Lisp_Object *location, const char *name, int dump_p,
3283 int multiword_predicate_p)
3286 int len = strlen (name) - 1;
3289 if (multiword_predicate_p)
3290 assert (len + 1 < sizeof (temp));
3292 assert (len < sizeof (temp));
3293 strcpy (temp, name + 1); /* Remove initial Q */
3294 if (multiword_predicate_p)
3296 strcpy (temp + len - 1, "_p");
3299 for (i = 0; i < len; i++)
3302 *location = Fintern (make_string ((const Bufbyte *) temp, len), Qnil);
3304 staticpro (location);
3306 staticpro_nodump (location);
3310 defsymbol_massage_name_nodump (Lisp_Object *location, const char *name)
3312 defsymbol_massage_name_1 (location, name, 0, 0);
3316 defsymbol_massage_name (Lisp_Object *location, const char *name)
3318 defsymbol_massage_name_1 (location, name, 1, 0);
3322 defsymbol_massage_multiword_predicate_nodump (Lisp_Object *location,
3325 defsymbol_massage_name_1 (location, name, 0, 1);
3329 defsymbol_massage_multiword_predicate (Lisp_Object *location, const char *name)
3331 defsymbol_massage_name_1 (location, name, 1, 1);
3335 defsymbol_nodump (Lisp_Object *location, const char *name)
3337 *location = Fintern (make_string_nocopy ((const Bufbyte *) name,
3340 staticpro_nodump (location);
3344 defsymbol (Lisp_Object *location, const char *name)
3346 *location = Fintern (make_string_nocopy ((const Bufbyte *) name,
3349 staticpro (location);
3353 defkeyword (Lisp_Object *location, const char *name)
3355 defsymbol (location, name);
3356 Fset (*location, *location);
3360 defkeyword_massage_name (Lisp_Object *location, const char *name)
3363 int len = strlen (name);
3365 assert (len < sizeof (temp));
3366 strcpy (temp, name);
3367 temp[1] = ':'; /* it's an underscore in the C variable */
3369 defsymbol_massage_name (location, temp);
3370 Fset (*location, *location);
3374 /* Check that nobody spazzed writing a DEFUN. */
3376 check_sane_subr (Lisp_Subr *subr, Lisp_Object sym)
3378 assert (subr->min_args >= 0);
3379 assert (subr->min_args <= SUBR_MAX_ARGS);
3381 if (subr->max_args != MANY &&
3382 subr->max_args != UNEVALLED)
3384 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3385 assert (subr->max_args <= SUBR_MAX_ARGS);
3386 assert (subr->min_args <= subr->max_args);
3389 assert (UNBOUNDP (XSYMBOL (sym)->function));
3392 #define check_sane_subr(subr, sym) /* nothing */
3397 * If we are not in a pure undumped Emacs, we need to make a duplicate of
3398 * the subr. This is because the only time this function will be called
3399 * in a running Emacs is when a dynamically loaded module is adding a
3400 * subr, and we need to make sure that the subr is in allocated, Lisp-
3401 * accessible memory. The address assigned to the static subr struct
3402 * in the shared object will be a trampoline address, so we need to create
3403 * a copy here to ensure that a real address is used.
3405 * Once we have copied everything across, we re-use the original static
3406 * structure to store a pointer to the newly allocated one. This will be
3407 * used in emodules.c by emodules_doc_subr() to find a pointer to the
3408 * allocated object so that we can set its doc string properly.
3410 * NOTE: We don't actually use the DOC pointer here any more, but we did
3411 * in an earlier implementation of module support. There is no harm in
3412 * setting it here in case we ever need it in future implementations.
3413 * subr->doc will point to the new subr structure that was allocated.
3414 * Code can then get this value from the static subr structure and use
3417 * FIXME: Should newsubr be staticpro()'ed? I don't think so but I need
3420 #define check_module_subr() \
3422 if (initialized) { \
3423 Lisp_Subr *newsubr = (Lisp_Subr *) xmalloc (sizeof (Lisp_Subr)); \
3424 memcpy (newsubr, subr, sizeof (Lisp_Subr)); \
3425 subr->doc = (const char *)newsubr; \
3429 #else /* ! HAVE_SHLIB */
3430 #define check_module_subr()
3434 defsubr (Lisp_Subr *subr)
3436 Lisp_Object sym = intern (subr_name (subr));
3439 check_sane_subr (subr, sym);
3440 check_module_subr ();
3442 XSETSUBR (fun, subr);
3443 XSYMBOL (sym)->function = fun;
3446 /* Define a lisp macro using a Lisp_Subr. */
3448 defsubr_macro (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 = Fcons (Qmacro, fun);
3461 deferror_1 (Lisp_Object *symbol, const char *name, const char *messuhhj,
3462 Lisp_Object inherits_from, int massage_p)
3466 defsymbol_massage_name (symbol, name);
3468 defsymbol (symbol, name);
3470 assert (SYMBOLP (inherits_from));
3471 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3472 Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3473 /* NOT build_translated_string (). This function is called at load time
3474 and the string needs to get translated at run time. (This happens
3475 in the function (display-error) in cmdloop.el.) */
3476 Fput (*symbol, Qerror_message, build_string (messuhhj));
3480 deferror (Lisp_Object *symbol, const char *name, const char *messuhhj,
3481 Lisp_Object inherits_from)
3483 deferror_1 (symbol, name, messuhhj, inherits_from, 0);
3487 deferror_massage_name (Lisp_Object *symbol, const char *name,
3488 const char *messuhhj, Lisp_Object inherits_from)
3490 deferror_1 (symbol, name, messuhhj, inherits_from, 1);
3494 deferror_massage_name_and_message (Lisp_Object *symbol, const char *name,
3495 Lisp_Object inherits_from)
3499 int len = strlen (name) - 1;
3501 assert (len < sizeof (temp));
3502 strcpy (temp, name + 1); /* Remove initial Q */
3503 temp[0] = toupper (temp[0]);
3504 for (i = 0; i < len; i++)
3508 deferror_1 (symbol, name, temp, inherits_from, 1);
3512 syms_of_symbols (void)
3514 DEFSYMBOL (Qvariable_documentation);
3515 DEFSYMBOL (Qvariable_domain); /* I18N3 */
3516 DEFSYMBOL (Qad_advice_info);
3517 DEFSYMBOL (Qad_activate);
3519 DEFSYMBOL (Qget_value);
3520 DEFSYMBOL (Qset_value);
3521 DEFSYMBOL (Qbound_predicate);
3522 DEFSYMBOL (Qmake_unbound);
3523 DEFSYMBOL (Qlocal_predicate);
3524 DEFSYMBOL (Qmake_local);
3526 DEFSYMBOL (Qboundp);
3527 DEFSYMBOL (Qglobally_boundp);
3528 DEFSYMBOL (Qmakunbound);
3529 DEFSYMBOL (Qsymbol_value);
3531 DEFSYMBOL (Qsetq_default);
3532 DEFSYMBOL (Qdefault_boundp);
3533 DEFSYMBOL (Qdefault_value);
3534 DEFSYMBOL (Qset_default);
3535 DEFSYMBOL (Qmake_variable_buffer_local);
3536 DEFSYMBOL (Qmake_local_variable);
3537 DEFSYMBOL (Qkill_local_variable);
3538 DEFSYMBOL (Qkill_console_local_variable);
3539 DEFSYMBOL (Qsymbol_value_in_buffer);
3540 DEFSYMBOL (Qsymbol_value_in_console);
3541 DEFSYMBOL (Qlocal_variable_p);
3543 DEFSYMBOL (Qconst_integer);
3544 DEFSYMBOL (Qconst_boolean);
3545 DEFSYMBOL (Qconst_object);
3546 DEFSYMBOL (Qconst_specifier);
3547 DEFSYMBOL (Qdefault_buffer);
3548 DEFSYMBOL (Qcurrent_buffer);
3549 DEFSYMBOL (Qconst_current_buffer);
3550 DEFSYMBOL (Qdefault_console);
3551 DEFSYMBOL (Qselected_console);
3552 DEFSYMBOL (Qconst_selected_console);
3555 DEFSUBR (Fintern_soft);
3556 DEFSUBR (Funintern);
3557 DEFSUBR (Fmapatoms);
3558 DEFSUBR (Fapropos_internal);
3560 DEFSUBR (Fsymbol_function);
3561 DEFSUBR (Fsymbol_plist);
3562 DEFSUBR (Fsymbol_name);
3563 DEFSUBR (Fmakunbound);
3564 DEFSUBR (Ffmakunbound);
3566 DEFSUBR (Fglobally_boundp);
3569 DEFSUBR (Fdefine_function);
3570 Ffset (intern ("defalias"), intern ("define-function"));
3571 DEFSUBR (Fsetplist);
3572 DEFSUBR (Fsymbol_value_in_buffer);
3573 DEFSUBR (Fsymbol_value_in_console);
3574 DEFSUBR (Fbuilt_in_variable_type);
3575 DEFSUBR (Fsymbol_value);
3577 DEFSUBR (Fdefault_boundp);
3578 DEFSUBR (Fdefault_value);
3579 DEFSUBR (Fset_default);
3580 DEFSUBR (Fsetq_default);
3581 DEFSUBR (Fmake_variable_buffer_local);
3582 DEFSUBR (Fmake_local_variable);
3583 DEFSUBR (Fkill_local_variable);
3584 DEFSUBR (Fkill_console_local_variable);
3585 DEFSUBR (Flocal_variable_p);
3586 DEFSUBR (Fdefvaralias);
3587 DEFSUBR (Fvariable_alias);
3588 DEFSUBR (Findirect_variable);
3589 DEFSUBR (Fdontusethis_set_symbol_value_handler);
3592 /* Create and initialize a Lisp variable whose value is forwarded to C data */
3594 defvar_magic (const char *symbol_name, const struct symbol_value_forward *magic)
3598 #if defined(HAVE_SHLIB)
3600 * As with defsubr(), this will only be called in a dumped Emacs when
3601 * we are adding variables from a dynamically loaded module. That means
3602 * we can't use purespace. Take that into account.
3605 sym = Fintern (build_string (symbol_name), Qnil);
3608 sym = Fintern (make_string_nocopy ((const Bufbyte *) symbol_name,
3609 strlen (symbol_name)), Qnil);
3611 XSETOBJ (XSYMBOL (sym)->value, magic);
3615 vars_of_symbols (void)
3617 DEFVAR_LISP ("obarray", &Vobarray /*
3618 Symbol table for use by `intern' and `read'.
3619 It is a vector whose length ought to be prime for best results.
3620 The vector's contents don't make sense if examined from Lisp programs;
3621 to find all the symbols in an obarray, use `mapatoms'.
3623 /* obarray has been initialized long before */