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_LO_RESET_NIL, offsetof (struct symbol_value_buffer_local, current_value), 3 },
1003 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
1004 { XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 },
1008 static const struct lrecord_description symbol_value_varalias_description[] = {
1009 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, aliasee) },
1010 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, shadowed) },
1014 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
1015 symbol_value_forward,
1017 print_symbol_value_magic, 0, 0, 0,
1018 symbol_value_forward_description,
1019 struct symbol_value_forward);
1021 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
1022 symbol_value_buffer_local,
1023 mark_symbol_value_buffer_local,
1024 print_symbol_value_magic, 0, 0, 0,
1025 symbol_value_buffer_local_description,
1026 struct symbol_value_buffer_local);
1028 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
1029 symbol_value_lisp_magic,
1030 mark_symbol_value_lisp_magic,
1031 print_symbol_value_magic, 0, 0, 0,
1032 symbol_value_lisp_magic_description,
1033 struct symbol_value_lisp_magic);
1035 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
1036 symbol_value_varalias,
1037 mark_symbol_value_varalias,
1038 print_symbol_value_magic, 0, 0, 0,
1039 symbol_value_varalias_description,
1040 struct symbol_value_varalias);
1043 /* Getting and setting values of symbols */
1045 /* Given the raw contents of a symbol value cell, return the Lisp value of
1046 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
1047 symbol-value-lisp-magic, or symbol-value-varalias.
1049 BUFFER specifies a buffer, and is used for built-in buffer-local
1050 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
1051 Note that such variables are never encapsulated in a
1052 symbol-value-buffer-local structure.
1054 CONSOLE specifies a console, and is used for built-in console-local
1055 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
1056 Note that such variables are (currently) never encapsulated in a
1057 symbol-value-buffer-local structure.
1061 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
1062 struct console *console)
1064 const struct symbol_value_forward *fwd;
1066 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1069 fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1070 switch (fwd->magic.type)
1072 case SYMVAL_FIXNUM_FORWARD:
1073 case SYMVAL_CONST_FIXNUM_FORWARD:
1074 return make_int (*((int *)symbol_value_forward_forward (fwd)));
1076 case SYMVAL_BOOLEAN_FORWARD:
1077 case SYMVAL_CONST_BOOLEAN_FORWARD:
1078 return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
1080 case SYMVAL_OBJECT_FORWARD:
1081 case SYMVAL_CONST_OBJECT_FORWARD:
1082 case SYMVAL_CONST_SPECIFIER_FORWARD:
1083 return *((Lisp_Object *)symbol_value_forward_forward (fwd));
1085 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1086 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1087 + ((char *)symbol_value_forward_forward (fwd)
1088 - (char *)&buffer_local_flags))));
1091 case SYMVAL_CURRENT_BUFFER_FORWARD:
1092 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1094 return (*((Lisp_Object *)((char *)buffer
1095 + ((char *)symbol_value_forward_forward (fwd)
1096 - (char *)&buffer_local_flags))));
1098 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1099 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1100 + ((char *)symbol_value_forward_forward (fwd)
1101 - (char *)&console_local_flags))));
1103 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1104 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1106 return (*((Lisp_Object *)((char *)console
1107 + ((char *)symbol_value_forward_forward (fwd)
1108 - (char *)&console_local_flags))));
1110 case SYMVAL_UNBOUND_MARKER:
1116 return Qnil; /* suppress compiler warning */
1119 /* Set the value of default-buffer-local variable SYM to VALUE. */
1122 set_default_buffer_slot_variable (Lisp_Object sym,
1125 /* Handle variables like case-fold-search that have special slots in
1126 the buffer. Make them work apparently like buffer_local variables.
1128 /* At this point, the value cell may not contain a symbol-value-varalias
1129 or symbol-value-buffer-local, and if there's a handler, we should
1130 have already called it. */
1131 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1132 const struct symbol_value_forward *fwd
1133 = XSYMBOL_VALUE_FORWARD (valcontents);
1134 int offset = ((char *) symbol_value_forward_forward (fwd)
1135 - (char *) &buffer_local_flags);
1136 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1137 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1138 int flags) = symbol_value_forward_magicfun (fwd);
1140 *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
1143 if (mask > 0) /* Not always per-buffer */
1145 /* Set value in each buffer which hasn't shadowed the default */
1146 LIST_LOOP_2 (elt, Vbuffer_alist)
1148 struct buffer *b = XBUFFER (XCDR (elt));
1149 if (!(b->local_var_flags & mask))
1152 magicfun (sym, &value, make_buffer (b), 0);
1153 *((Lisp_Object *) (offset + (char *) b)) = value;
1159 /* Set the value of default-console-local variable SYM to VALUE. */
1162 set_default_console_slot_variable (Lisp_Object sym,
1165 /* Handle variables like case-fold-search that have special slots in
1166 the console. Make them work apparently like console_local variables.
1168 /* At this point, the value cell may not contain a symbol-value-varalias
1169 or symbol-value-buffer-local, and if there's a handler, we should
1170 have already called it. */
1171 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1172 const struct symbol_value_forward *fwd
1173 = XSYMBOL_VALUE_FORWARD (valcontents);
1174 int offset = ((char *) symbol_value_forward_forward (fwd)
1175 - (char *) &console_local_flags);
1176 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1177 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1178 int flags) = symbol_value_forward_magicfun (fwd);
1180 *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
1183 if (mask > 0) /* Not always per-console */
1185 /* Set value in each console which hasn't shadowed the default */
1186 LIST_LOOP_2 (console, Vconsole_list)
1188 struct console *d = XCONSOLE (console);
1189 if (!(d->local_var_flags & mask))
1192 magicfun (sym, &value, console, 0);
1193 *((Lisp_Object *) (offset + (char *) d)) = value;
1199 /* Store NEWVAL into SYM.
1201 SYM's value slot may *not* be types (5) or (6) above,
1202 i.e. no symbol-value-varalias objects. (You should have
1203 forwarded past all of these.)
1205 SYM should not be an unsettable symbol or a symbol with
1206 a magic `set-value' handler (unless you want to explicitly
1207 ignore this handler).
1209 OVALUE is the current value of SYM, but forwarded past any
1210 symbol-value-buffer-local and symbol-value-lisp-magic objects.
1211 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1212 the contents of its current-value cell.) NEWVAL may only be
1213 a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
1214 this function will only modify its current-value cell, which should
1215 already be set up to point to the current buffer.
1219 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
1222 if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
1224 Lisp_Object *store_pointer = value_slot_past_magic (sym);
1226 if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
1228 &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
1230 assert (UNBOUNDP (*store_pointer)
1231 || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1232 *store_pointer = newval;
1236 const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue);
1237 int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
1238 Lisp_Object in_object, int flags)
1239 = symbol_value_forward_magicfun (fwd);
1241 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue))
1243 case SYMVAL_FIXNUM_FORWARD:
1246 magicfun (sym, &newval, Qnil, 0);
1247 *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
1250 case SYMVAL_BOOLEAN_FORWARD:
1252 magicfun (sym, &newval, Qnil, 0);
1253 *((int *) symbol_value_forward_forward (fwd))
1257 case SYMVAL_OBJECT_FORWARD:
1259 magicfun (sym, &newval, Qnil, 0);
1260 *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
1263 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1264 set_default_buffer_slot_variable (sym, newval);
1267 case SYMVAL_CURRENT_BUFFER_FORWARD:
1269 magicfun (sym, &newval, make_buffer (current_buffer), 0);
1270 *((Lisp_Object *) ((char *) current_buffer
1271 + ((char *) symbol_value_forward_forward (fwd)
1272 - (char *) &buffer_local_flags)))
1276 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1277 set_default_console_slot_variable (sym, newval);
1280 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1282 magicfun (sym, &newval, Vselected_console, 0);
1283 *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console)
1284 + ((char *) symbol_value_forward_forward (fwd)
1285 - (char *) &console_local_flags)))
1295 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1296 BFWD, locate and return a pointer to the element in BUFFER's
1297 local_var_alist for SYMBOL. The return value will be Qnil if
1298 BUFFER does not have its own value for SYMBOL (i.e. the default
1299 value is seen in that buffer).
1303 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
1304 struct symbol_value_buffer_local *bfwd)
1306 if (!NILP (bfwd->current_buffer) &&
1307 XBUFFER (bfwd->current_buffer) == buffer)
1308 /* This is just an optimization of the below. */
1309 return bfwd->current_alist_element;
1311 return assq_no_quit (symbol, buffer->local_var_alist);
1314 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1315 symbol-value-buffer-local of a per-buffer variable -- i.e. the
1316 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1317 slot -- may be out of date.]
1319 Write out any cached value in buffer-local variable SYMBOL's
1320 buffer-local structure, which is passed in as BFWD.
1324 write_out_buffer_local_cache (Lisp_Object symbol,
1325 struct symbol_value_buffer_local *bfwd)
1327 if (!NILP (bfwd->current_buffer))
1329 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1330 uses it, and that type cannot be inside a symbol-value-buffer-local */
1331 Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0);
1332 if (NILP (bfwd->current_alist_element))
1333 /* current_value may be updated more recently than default_value */
1334 bfwd->default_value = cval;
1336 Fsetcdr (bfwd->current_alist_element, cval);
1340 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1341 Set up BFWD's cache for validity in buffer BUF. This assumes that
1342 the cache is currently in a consistent state (this can include
1343 not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1345 If the cache is already set up for BUF, this function does nothing
1348 Otherwise, if SYM forwards out to a C variable, this also forwards
1349 SYM's value in BUF out to the variable. Therefore, you generally
1350 only want to call this when BUF is, or is about to become, the
1353 (Otherwise, you can just retrieve the value without changing the
1354 cache, at the expense of slower retrieval.)
1358 set_up_buffer_local_cache (Lisp_Object sym,
1359 struct symbol_value_buffer_local *bfwd,
1361 Lisp_Object new_alist_el,
1364 Lisp_Object new_val;
1366 if (!NILP (bfwd->current_buffer)
1367 && buf == XBUFFER (bfwd->current_buffer))
1368 /* Cache is already set up. */
1371 /* Flush out the old cache. */
1372 write_out_buffer_local_cache (sym, bfwd);
1374 /* Retrieve the new alist element and new value. */
1375 if (NILP (new_alist_el)
1377 new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1379 if (NILP (new_alist_el))
1380 new_val = bfwd->default_value;
1382 new_val = Fcdr (new_alist_el);
1384 bfwd->current_alist_element = new_alist_el;
1385 XSETBUFFER (bfwd->current_buffer, buf);
1387 /* Now store the value into the current-value slot.
1388 We don't simply write it there, because the current-value
1389 slot might be a forwarding pointer, in which case we need
1390 to instead write the value into the C variable.
1392 We might also want to call a magic function.
1394 So instead, we call this function. */
1395 store_symval_forwarding (sym, bfwd->current_value, new_val);
1400 kill_buffer_local_variables (struct buffer *buf)
1402 Lisp_Object prev = Qnil;
1405 /* Any which are supposed to be permanent,
1406 make local again, with the same values they had. */
1408 for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
1410 Lisp_Object sym = XCAR (XCAR (alist));
1411 struct symbol_value_buffer_local *bfwd;
1412 /* Variables with a symbol-value-varalias should not be here
1413 (we should have forwarded past them) and there must be a
1414 symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
1415 just forward past it; if the variable has a handler, it was
1417 Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
1419 assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
1420 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
1422 if (!NILP (Fget (sym, Qpermanent_local, Qnil)))
1423 /* prev points to the last alist element that is still
1424 staying around, so *only* update it now. This didn't
1425 used to be the case; this bug has been around since
1426 mly's rewrite two years ago! */
1430 /* Really truly kill it. */
1432 XCDR (prev) = XCDR (alist);
1434 buf->local_var_alist = XCDR (alist);
1436 /* We just effectively changed the value for this variable
1439 /* (1) If the cache is caching BUF, invalidate the cache. */
1440 if (!NILP (bfwd->current_buffer) &&
1441 buf == XBUFFER (bfwd->current_buffer))
1442 bfwd->current_buffer = Qnil;
1444 /* (2) If we changed the value in current_buffer and this
1445 variable forwards to a C variable, we need to change the
1446 value of the C variable. set_up_buffer_local_cache()
1447 will do this. It doesn't hurt to do it whenever
1448 BUF == current_buffer, so just go ahead and do that. */
1449 if (buf == current_buffer)
1450 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
1456 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1457 struct console *con, int swap_it_in,
1458 Lisp_Object symcons, int set_it_p)
1460 Lisp_Object valcontents;
1463 valcontents = XSYMBOL (sym)->value;
1466 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1469 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1471 case SYMVAL_LISP_MAGIC:
1473 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1477 case SYMVAL_VARALIAS:
1478 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1480 /* presto change-o! */
1483 case SYMVAL_BUFFER_LOCAL:
1484 case SYMVAL_SOME_BUFFER_LOCAL:
1486 struct symbol_value_buffer_local *bfwd
1487 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1491 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1492 valcontents = bfwd->current_value;
1496 if (!NILP (bfwd->current_buffer) &&
1497 buf == XBUFFER (bfwd->current_buffer))
1498 valcontents = bfwd->current_value;
1499 else if (NILP (symcons))
1502 valcontents = assq_no_quit (sym, buf->local_var_alist);
1503 if (NILP (valcontents))
1504 valcontents = bfwd->default_value;
1506 valcontents = XCDR (valcontents);
1509 valcontents = XCDR (symcons);
1517 return do_symval_forwarding (valcontents, buf, con);
1521 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1522 bound. Note that it must not be possible to QUIT within this
1526 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
1533 buf = current_buffer;
1536 CHECK_BUFFER (buffer);
1537 buf = XBUFFER (buffer);
1540 return find_symbol_value_1 (sym, buf,
1541 /* If it bombs out at startup due to a
1542 Lisp error, this may be nil. */
1543 CONSOLEP (Vselected_console)
1544 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
1548 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1553 console = Vselected_console;
1555 CHECK_CONSOLE (console);
1557 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1561 /* Return the current value of SYM. The difference between this function
1562 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1563 this updates the CURRENT_VALUE slot of buffer-local variables to
1564 point to the current buffer, while symbol_value_in_buffer doesn't. */
1567 find_symbol_value (Lisp_Object sym)
1569 /* WARNING: This function can be called when current_buffer is 0
1570 and Vselected_console is Qnil, early in initialization. */
1571 struct console *con;
1572 Lisp_Object valcontents;
1576 valcontents = XSYMBOL (sym)->value;
1577 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1580 if (CONSOLEP (Vselected_console))
1581 con = XCONSOLE (Vselected_console);
1584 /* This can also get called while we're preparing to shutdown.
1585 #### What should really happen in that case? Should we
1586 actually fix things so we can't get here in that case? */
1588 assert (!initialized || preparing_for_armageddon);
1593 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
1596 /* This is an optimized function for quick lookup of buffer local symbols
1597 by avoiding O(n) search. This will work when either:
1598 a) We have already found the symbol e.g. by traversing local_var_alist.
1600 b) We know that the symbol will not be found in the current buffer's
1601 list of local variables.
1602 In the former case, find_it_p is 1 and symbol_cons is the element from
1603 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1606 This function is called from set_buffer_internal which does both of these
1610 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1612 /* WARNING: This function can be called when current_buffer is 0
1613 and Vselected_console is Qnil, early in initialization. */
1614 struct console *con;
1615 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1618 if (CONSOLEP (Vselected_console))
1619 con = XCONSOLE (Vselected_console);
1622 /* This can also get called while we're preparing to shutdown.
1623 #### What should really happen in that case? Should we
1624 actually fix things so we can't get here in that case? */
1626 assert (!initialized || preparing_for_armageddon);
1631 return find_symbol_value_1 (sym, current_buffer, con, 1,
1632 find_it_p ? symbol_cons : Qnil,
1636 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1637 Return SYMBOL's value. Error if that is void.
1641 Lisp_Object val = find_symbol_value (symbol);
1644 return Fsignal (Qvoid_variable, list1 (symbol));
1649 DEFUN ("set", Fset, 2, 2, 0, /*
1650 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1654 REGISTER Lisp_Object valcontents;
1656 /* remember, we're called by Fmakunbound() as well */
1658 CHECK_SYMBOL (symbol);
1661 sym = XSYMBOL (symbol);
1662 valcontents = sym->value;
1664 if (EQ (symbol, Qnil) ||
1666 SYMBOL_IS_KEYWORD (symbol))
1667 reject_constant_symbols (symbol, newval, 0,
1668 UNBOUNDP (newval) ? Qmakunbound : Qset);
1670 if (!SYMBOL_VALUE_MAGIC_P (valcontents) || UNBOUNDP (valcontents))
1672 sym->value = newval;
1676 reject_constant_symbols (symbol, newval, 0,
1677 UNBOUNDP (newval) ? Qmakunbound : Qset);
1679 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1681 case SYMVAL_LISP_MAGIC:
1683 if (UNBOUNDP (newval))
1685 maybe_call_magic_handler (symbol, Qmakunbound, 0);
1686 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = Qunbound;
1690 maybe_call_magic_handler (symbol, Qset, 1, newval);
1691 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = newval;
1695 case SYMVAL_VARALIAS:
1696 symbol = follow_varalias_pointers (symbol,
1698 ? Qmakunbound : Qset);
1699 /* presto change-o! */
1702 case SYMVAL_FIXNUM_FORWARD:
1703 case SYMVAL_BOOLEAN_FORWARD:
1704 case SYMVAL_OBJECT_FORWARD:
1705 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1706 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1707 if (UNBOUNDP (newval))
1708 signal_error (Qerror,
1709 list2 (build_string ("Cannot makunbound"), symbol));
1712 /* case SYMVAL_UNBOUND_MARKER: break; */
1714 case SYMVAL_CURRENT_BUFFER_FORWARD:
1716 const struct symbol_value_forward *fwd
1717 = XSYMBOL_VALUE_FORWARD (valcontents);
1718 int mask = XINT (*((Lisp_Object *)
1719 symbol_value_forward_forward (fwd)));
1721 /* Setting this variable makes it buffer-local */
1722 current_buffer->local_var_flags |= mask;
1726 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1728 const struct symbol_value_forward *fwd
1729 = XSYMBOL_VALUE_FORWARD (valcontents);
1730 int mask = XINT (*((Lisp_Object *)
1731 symbol_value_forward_forward (fwd)));
1733 /* Setting this variable makes it console-local */
1734 XCONSOLE (Vselected_console)->local_var_flags |= mask;
1738 case SYMVAL_BUFFER_LOCAL:
1739 case SYMVAL_SOME_BUFFER_LOCAL:
1741 /* If we want to examine or set the value and
1742 CURRENT-BUFFER is current, we just examine or set
1743 CURRENT-VALUE. If CURRENT-BUFFER is not current, we
1744 store the current CURRENT-VALUE value into
1745 CURRENT-ALIST- ELEMENT, then find the appropriate alist
1746 element for the buffer now current and set up
1747 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
1748 of that element, and store into CURRENT-BUFFER.
1750 If we are setting the variable and the current buffer does
1751 not have an alist entry for this variable, an alist entry is
1754 Note that CURRENT-VALUE can be a forwarding pointer.
1755 Each time it is examined or set, forwarding must be
1757 struct symbol_value_buffer_local *bfwd
1758 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1759 int some_buffer_local_p =
1760 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
1761 /* What value are we caching right now? */
1762 Lisp_Object aelt = bfwd->current_alist_element;
1764 if (!NILP (bfwd->current_buffer) &&
1765 current_buffer == XBUFFER (bfwd->current_buffer)
1766 && ((some_buffer_local_p)
1767 ? 1 /* doesn't automatically become local */
1768 : !NILP (aelt) /* already local */
1771 /* Cache is valid */
1772 valcontents = bfwd->current_value;
1776 /* If the current buffer is not the buffer whose binding is
1777 currently cached, or if it's a SYMVAL_BUFFER_LOCAL and
1778 we're looking at the default value, the cache is invalid; we
1779 need to write it out, and find the new CURRENT-ALIST-ELEMENT
1782 /* Write out the cached value for the old buffer; copy it
1783 back to its alist element. This works if the current
1784 buffer only sees the default value, too. */
1785 write_out_buffer_local_cache (symbol, bfwd);
1787 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1788 aelt = buffer_local_alist_element (current_buffer, symbol, bfwd);
1791 /* This buffer is still seeing the default value. */
1792 if (!some_buffer_local_p)
1794 /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a
1795 new assoc for a local value and set
1796 CURRENT-ALIST-ELEMENT to point to that. */
1798 do_symval_forwarding (bfwd->current_value,
1800 XCONSOLE (Vselected_console));
1801 aelt = Fcons (symbol, aelt);
1802 current_buffer->local_var_alist
1803 = Fcons (aelt, current_buffer->local_var_alist);
1807 /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
1808 we're currently seeing the default value. */
1812 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1813 bfwd->current_alist_element = aelt;
1814 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
1815 XSETBUFFER (bfwd->current_buffer, current_buffer);
1816 valcontents = bfwd->current_value;
1823 store_symval_forwarding (symbol, valcontents, newval);
1829 /* Access or set a buffer-local symbol's default value. */
1831 /* Return the default value of SYM, but don't check for voidness.
1832 Return Qunbound if it is void. */
1835 default_value (Lisp_Object sym)
1837 Lisp_Object valcontents;
1842 valcontents = XSYMBOL (sym)->value;
1845 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1848 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1850 case SYMVAL_LISP_MAGIC:
1852 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1856 case SYMVAL_VARALIAS:
1857 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1858 /* presto change-o! */
1861 case SYMVAL_UNBOUND_MARKER:
1864 case SYMVAL_CURRENT_BUFFER_FORWARD:
1866 const struct symbol_value_forward *fwd
1867 = XSYMBOL_VALUE_FORWARD (valcontents);
1868 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1869 + ((char *)symbol_value_forward_forward (fwd)
1870 - (char *)&buffer_local_flags))));
1873 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1875 const struct symbol_value_forward *fwd
1876 = XSYMBOL_VALUE_FORWARD (valcontents);
1877 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1878 + ((char *)symbol_value_forward_forward (fwd)
1879 - (char *)&console_local_flags))));
1882 case SYMVAL_BUFFER_LOCAL:
1883 case SYMVAL_SOME_BUFFER_LOCAL:
1885 struct symbol_value_buffer_local *bfwd =
1886 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1888 /* Handle user-created local variables. */
1889 /* If var is set up for a buffer that lacks a local value for it,
1890 the current value is nominally the default value.
1891 But the current value slot may be more up to date, since
1892 ordinary setq stores just that slot. So use that. */
1893 if (NILP (bfwd->current_alist_element))
1894 return do_symval_forwarding (bfwd->current_value, current_buffer,
1895 XCONSOLE (Vselected_console));
1897 return bfwd->default_value;
1900 /* For other variables, get the current value. */
1901 return do_symval_forwarding (valcontents, current_buffer,
1902 XCONSOLE (Vselected_console));
1905 RETURN_NOT_REACHED (Qnil) /* suppress compiler warning */
1908 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /*
1909 Return t if SYMBOL has a non-void default value.
1910 This is the value that is seen in buffers that do not have their own values
1915 return UNBOUNDP (default_value (symbol)) ? Qnil : Qt;
1918 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /*
1919 Return SYMBOL's default value.
1920 This is the value that is seen in buffers that do not have their own values
1921 for this variable. The default value is meaningful for variables with
1922 local bindings in certain buffers.
1926 Lisp_Object value = default_value (symbol);
1928 return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (symbol)) : value;
1931 DEFUN ("set-default", Fset_default, 2, 2, 0, /*
1932 Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated.
1933 The default value is seen in buffers that do not have their own values
1938 Lisp_Object valcontents;
1940 CHECK_SYMBOL (symbol);
1943 valcontents = XSYMBOL (symbol)->value;
1946 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1947 return Fset (symbol, value);
1949 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1951 case SYMVAL_LISP_MAGIC:
1952 RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (symbol, Qset_default, 1,
1954 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1958 case SYMVAL_VARALIAS:
1959 symbol = follow_varalias_pointers (symbol, Qset_default);
1960 /* presto change-o! */
1963 case SYMVAL_CURRENT_BUFFER_FORWARD:
1964 set_default_buffer_slot_variable (symbol, value);
1967 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1968 set_default_console_slot_variable (symbol, value);
1971 case SYMVAL_BUFFER_LOCAL:
1972 case SYMVAL_SOME_BUFFER_LOCAL:
1974 /* Store new value into the DEFAULT-VALUE slot */
1975 struct symbol_value_buffer_local *bfwd
1976 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1978 bfwd->default_value = value;
1979 /* If current-buffer doesn't shadow default_value,
1980 * we must set the CURRENT-VALUE slot too */
1981 if (NILP (bfwd->current_alist_element))
1982 store_symval_forwarding (symbol, bfwd->current_value, value);
1987 return Fset (symbol, value);
1991 DEFUN ("setq-default", Fsetq_default, 0, UNEVALLED, 0, /*
1992 Set the default value of variable SYMBOL to VALUE.
1993 SYMBOL, the variable name, is literal (not evaluated);
1994 VALUE is an expression and it is evaluated.
1995 The default value of a variable is seen in buffers
1996 that do not have their own values for the variable.
1998 More generally, you can use multiple variables and values, as in
1999 (setq-default SYMBOL VALUE SYMBOL VALUE...)
2000 This sets each SYMBOL's default value to the corresponding VALUE.
2001 The VALUE for the Nth SYMBOL can refer to the new default values
2002 of previous SYMBOLs.
2006 /* This function can GC */
2007 Lisp_Object symbol, tail, val = Qnil;
2009 struct gcpro gcpro1;
2011 GET_LIST_LENGTH (args, nargs);
2013 if (nargs & 1) /* Odd number of arguments? */
2014 Fsignal (Qwrong_number_of_arguments,
2015 list2 (Qsetq_default, make_int (nargs)));
2019 PROPERTY_LIST_LOOP (tail, symbol, val, args)
2022 Fset_default (symbol, val);
2029 /* Lisp functions for creating and removing buffer-local variables. */
2031 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1,
2032 "vMake Variable Buffer Local: ", /*
2033 Make VARIABLE have a separate value for each buffer.
2034 At any time, the value for the current buffer is in effect.
2035 There is also a default value which is seen in any buffer which has not yet
2037 Using `set' or `setq' to set the variable causes it to have a separate value
2038 for the current buffer if it was previously using the default value.
2039 The function `default-value' gets the default value and `set-default'
2044 Lisp_Object valcontents;
2046 CHECK_SYMBOL (variable);
2049 verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
2051 valcontents = XSYMBOL (variable)->value;
2054 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2056 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2058 case SYMVAL_LISP_MAGIC:
2059 if (!UNBOUNDP (maybe_call_magic_handler
2060 (variable, Qmake_variable_buffer_local, 0)))
2062 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2066 case SYMVAL_VARALIAS:
2067 variable = follow_varalias_pointers (variable,
2068 Qmake_variable_buffer_local);
2069 /* presto change-o! */
2072 case SYMVAL_FIXNUM_FORWARD:
2073 case SYMVAL_BOOLEAN_FORWARD:
2074 case SYMVAL_OBJECT_FORWARD:
2075 case SYMVAL_UNBOUND_MARKER:
2078 case SYMVAL_CURRENT_BUFFER_FORWARD:
2079 case SYMVAL_BUFFER_LOCAL:
2080 /* Already per-each-buffer */
2083 case SYMVAL_SOME_BUFFER_LOCAL:
2085 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
2086 SYMVAL_BUFFER_LOCAL;
2095 struct symbol_value_buffer_local *bfwd
2096 = alloc_lcrecord_type (struct symbol_value_buffer_local,
2097 &lrecord_symbol_value_buffer_local);
2099 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2101 bfwd->default_value = find_symbol_value (variable);
2102 bfwd->current_value = valcontents;
2103 bfwd->current_alist_element = Qnil;
2104 bfwd->current_buffer = Fcurrent_buffer ();
2105 XSETSYMBOL_VALUE_MAGIC (foo, bfwd);
2106 *value_slot_past_magic (variable) = foo;
2107 #if 1 /* #### Yuck! FSFmacs bug-compatibility*/
2108 /* This sets the default-value of any make-variable-buffer-local to nil.
2109 That just sucks. User can just use setq-default to effect that,
2110 but there's no way to do makunbound-default to undo this lossage. */
2111 if (UNBOUNDP (valcontents))
2112 bfwd->default_value = Qnil;
2114 #if 0 /* #### Yuck! */
2115 /* This sets the value to nil in this buffer.
2116 User could use (setq variable nil) to do this.
2117 It isn't as egregious to do this automatically
2118 as it is to do so to the default-value, but it's
2119 still really dubious. */
2120 if (UNBOUNDP (valcontents))
2121 Fset (variable, Qnil);
2127 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1,
2128 "vMake Local Variable: ", /*
2129 Make VARIABLE have a separate value in the current buffer.
2130 Other buffers will continue to share a common default value.
2131 \(The buffer-local value of VARIABLE starts out as the same value
2132 VARIABLE previously had. If VARIABLE was void, it remains void.)
2133 See also `make-variable-buffer-local'.
2135 If the variable is already arranged to become local when set,
2136 this function causes a local value to exist for this buffer,
2137 just as setting the variable would do.
2139 Do not use `make-local-variable' to make a hook variable buffer-local.
2140 Use `make-local-hook' instead.
2144 Lisp_Object valcontents;
2145 struct symbol_value_buffer_local *bfwd;
2147 CHECK_SYMBOL (variable);
2150 verify_ok_for_buffer_local (variable, Qmake_local_variable);
2152 valcontents = XSYMBOL (variable)->value;
2155 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2157 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2159 case SYMVAL_LISP_MAGIC:
2160 if (!UNBOUNDP (maybe_call_magic_handler
2161 (variable, Qmake_local_variable, 0)))
2163 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2167 case SYMVAL_VARALIAS:
2168 variable = follow_varalias_pointers (variable, Qmake_local_variable);
2169 /* presto change-o! */
2172 case SYMVAL_FIXNUM_FORWARD:
2173 case SYMVAL_BOOLEAN_FORWARD:
2174 case SYMVAL_OBJECT_FORWARD:
2175 case SYMVAL_UNBOUND_MARKER:
2178 case SYMVAL_BUFFER_LOCAL:
2179 case SYMVAL_CURRENT_BUFFER_FORWARD:
2181 /* Make sure the symbol has a local value in this particular
2182 buffer, by setting it to the same value it already has. */
2183 Fset (variable, find_symbol_value (variable));
2187 case SYMVAL_SOME_BUFFER_LOCAL:
2189 if (!NILP (buffer_local_alist_element (current_buffer,
2191 (XSYMBOL_VALUE_BUFFER_LOCAL
2193 goto already_local_to_current_buffer;
2195 goto already_local_to_some_other_buffer;
2203 /* Make sure variable is set up to hold per-buffer values */
2204 bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
2205 &lrecord_symbol_value_buffer_local);
2206 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2208 bfwd->current_buffer = Qnil;
2209 bfwd->current_alist_element = Qnil;
2210 bfwd->current_value = valcontents;
2211 /* passing 0 is OK because this should never be a
2212 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2214 bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
2217 if (UNBOUNDP (bfwd->default_value))
2218 bfwd->default_value = Qnil; /* Yuck! */
2221 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
2222 *value_slot_past_magic (variable) = valcontents;
2224 already_local_to_some_other_buffer:
2226 /* Make sure this buffer has its own value of variable */
2227 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2229 if (UNBOUNDP (bfwd->default_value))
2231 /* If default value is unbound, set local value to nil. */
2232 XSETBUFFER (bfwd->current_buffer, current_buffer);
2233 bfwd->current_alist_element = Fcons (variable, Qnil);
2234 current_buffer->local_var_alist =
2235 Fcons (bfwd->current_alist_element, current_buffer->local_var_alist);
2236 store_symval_forwarding (variable, bfwd->current_value, Qnil);
2240 current_buffer->local_var_alist
2241 = Fcons (Fcons (variable, bfwd->default_value),
2242 current_buffer->local_var_alist);
2244 /* Make sure symbol does not think it is set up for this buffer;
2245 force it to look once again for this buffer's value */
2246 if (!NILP (bfwd->current_buffer) &&
2247 current_buffer == XBUFFER (bfwd->current_buffer))
2248 bfwd->current_buffer = Qnil;
2250 already_local_to_current_buffer:
2252 /* If the symbol forwards into a C variable, then swap in the
2253 variable for this buffer immediately. If C code modifies the
2254 variable before we swap in, then that new value will clobber the
2255 default value the next time we swap. */
2256 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2257 if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value))
2259 switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
2261 case SYMVAL_FIXNUM_FORWARD:
2262 case SYMVAL_BOOLEAN_FORWARD:
2263 case SYMVAL_OBJECT_FORWARD:
2264 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2265 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2268 case SYMVAL_UNBOUND_MARKER:
2269 case SYMVAL_CURRENT_BUFFER_FORWARD:
2280 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1,
2281 "vKill Local Variable: ", /*
2282 Make VARIABLE no longer have a separate value in the current buffer.
2283 From now on the default value will apply in this buffer.
2287 Lisp_Object valcontents;
2289 CHECK_SYMBOL (variable);
2292 valcontents = XSYMBOL (variable)->value;
2295 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2298 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2300 case SYMVAL_LISP_MAGIC:
2301 if (!UNBOUNDP (maybe_call_magic_handler
2302 (variable, Qkill_local_variable, 0)))
2304 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2308 case SYMVAL_VARALIAS:
2309 variable = follow_varalias_pointers (variable, Qkill_local_variable);
2310 /* presto change-o! */
2313 case SYMVAL_CURRENT_BUFFER_FORWARD:
2315 const struct symbol_value_forward *fwd
2316 = XSYMBOL_VALUE_FORWARD (valcontents);
2317 int offset = ((char *) symbol_value_forward_forward (fwd)
2318 - (char *) &buffer_local_flags);
2320 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2324 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2325 Lisp_Object in_object, int flags) =
2326 symbol_value_forward_magicfun (fwd);
2327 Lisp_Object oldval = * (Lisp_Object *)
2328 (offset + (char *) XBUFFER (Vbuffer_defaults));
2330 (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
2331 *(Lisp_Object *) (offset + (char *) current_buffer)
2333 current_buffer->local_var_flags &= ~mask;
2338 case SYMVAL_BUFFER_LOCAL:
2339 case SYMVAL_SOME_BUFFER_LOCAL:
2341 /* Get rid of this buffer's alist element, if any */
2342 struct symbol_value_buffer_local *bfwd
2343 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2344 Lisp_Object alist = current_buffer->local_var_alist;
2345 Lisp_Object alist_element
2346 = buffer_local_alist_element (current_buffer, variable, bfwd);
2348 if (!NILP (alist_element))
2349 current_buffer->local_var_alist = Fdelq (alist_element, alist);
2351 /* Make sure symbol does not think it is set up for this buffer;
2352 force it to look once again for this buffer's value */
2353 if (!NILP (bfwd->current_buffer) &&
2354 current_buffer == XBUFFER (bfwd->current_buffer))
2355 bfwd->current_buffer = Qnil;
2357 /* We just changed the value in the current_buffer. If this
2358 variable forwards to a C variable, we need to change the
2359 value of the C variable. set_up_buffer_local_cache()
2360 will do this. It doesn't hurt to do it always,
2361 so just go ahead and do that. */
2362 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2369 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2373 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2374 "vKill Console Local Variable: ", /*
2375 Make VARIABLE no longer have a separate value in the selected console.
2376 From now on the default value will apply in this console.
2380 Lisp_Object valcontents;
2382 CHECK_SYMBOL (variable);
2385 valcontents = XSYMBOL (variable)->value;
2388 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2391 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2393 case SYMVAL_LISP_MAGIC:
2394 if (!UNBOUNDP (maybe_call_magic_handler
2395 (variable, Qkill_console_local_variable, 0)))
2397 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2401 case SYMVAL_VARALIAS:
2402 variable = follow_varalias_pointers (variable,
2403 Qkill_console_local_variable);
2404 /* presto change-o! */
2407 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2409 const struct symbol_value_forward *fwd
2410 = XSYMBOL_VALUE_FORWARD (valcontents);
2411 int offset = ((char *) symbol_value_forward_forward (fwd)
2412 - (char *) &console_local_flags);
2414 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2418 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2419 Lisp_Object in_object, int flags) =
2420 symbol_value_forward_magicfun (fwd);
2421 Lisp_Object oldval = * (Lisp_Object *)
2422 (offset + (char *) XCONSOLE (Vconsole_defaults));
2424 magicfun (variable, &oldval, Vselected_console, 0);
2425 *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
2427 XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
2437 /* Used by specbind to determine what effects it might have. Returns:
2438 * 0 if symbol isn't buffer-local, and wouldn't be after it is set
2439 * <0 if symbol isn't presently buffer-local, but set would make it so
2440 * >0 if symbol is presently buffer-local
2443 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
2445 Lisp_Object valcontents;
2448 valcontents = XSYMBOL (symbol)->value;
2451 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2453 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2455 case SYMVAL_LISP_MAGIC:
2457 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2461 case SYMVAL_VARALIAS:
2462 symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
2463 /* presto change-o! */
2466 case SYMVAL_CURRENT_BUFFER_FORWARD:
2468 const struct symbol_value_forward *fwd
2469 = XSYMBOL_VALUE_FORWARD (valcontents);
2470 int mask = XINT (*((Lisp_Object *)
2471 symbol_value_forward_forward (fwd)));
2472 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
2473 /* Already buffer-local */
2476 /* Would be buffer-local after set */
2479 case SYMVAL_BUFFER_LOCAL:
2480 case SYMVAL_SOME_BUFFER_LOCAL:
2482 struct symbol_value_buffer_local *bfwd
2483 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2485 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
2488 /* Automatically becomes local when set */
2489 return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
2499 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2500 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2502 (symbol, buffer, unbound_value))
2505 CHECK_SYMBOL (symbol);
2506 CHECK_BUFFER (buffer);
2507 value = symbol_value_in_buffer (symbol, buffer);
2508 return UNBOUNDP (value) ? unbound_value : value;
2511 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2512 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2514 (symbol, console, unbound_value))
2517 CHECK_SYMBOL (symbol);
2518 CHECK_CONSOLE (console);
2519 value = symbol_value_in_console (symbol, console);
2520 return UNBOUNDP (value) ? unbound_value : value;
2523 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
2524 If SYMBOL is a built-in variable, return info about this; else return nil.
2525 The returned info will be a symbol, one of
2527 `object' A simple built-in variable.
2528 `const-object' Same, but cannot be set.
2529 `integer' A built-in integer variable.
2530 `const-integer' Same, but cannot be set.
2531 `boolean' A built-in boolean variable.
2532 `const-boolean' Same, but cannot be set.
2533 `const-specifier' Always contains a specifier; e.g. `has-modeline-p'.
2534 `current-buffer' A built-in buffer-local variable.
2535 `const-current-buffer' Same, but cannot be set.
2536 `default-buffer' Forwards to the default value of a built-in
2537 buffer-local variable.
2538 `selected-console' A built-in console-local variable.
2539 `const-selected-console' Same, but cannot be set.
2540 `default-console' Forwards to the default value of a built-in
2541 console-local variable.
2545 REGISTER Lisp_Object valcontents;
2547 CHECK_SYMBOL (symbol);
2550 valcontents = XSYMBOL (symbol)->value;
2553 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2556 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2558 case SYMVAL_LISP_MAGIC:
2559 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2563 case SYMVAL_VARALIAS:
2564 symbol = follow_varalias_pointers (symbol, Qt);
2565 /* presto change-o! */
2568 case SYMVAL_BUFFER_LOCAL:
2569 case SYMVAL_SOME_BUFFER_LOCAL:
2571 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value;
2575 case SYMVAL_FIXNUM_FORWARD: return Qinteger;
2576 case SYMVAL_CONST_FIXNUM_FORWARD: return Qconst_integer;
2577 case SYMVAL_BOOLEAN_FORWARD: return Qboolean;
2578 case SYMVAL_CONST_BOOLEAN_FORWARD: return Qconst_boolean;
2579 case SYMVAL_OBJECT_FORWARD: return Qobject;
2580 case SYMVAL_CONST_OBJECT_FORWARD: return Qconst_object;
2581 case SYMVAL_CONST_SPECIFIER_FORWARD: return Qconst_specifier;
2582 case SYMVAL_DEFAULT_BUFFER_FORWARD: return Qdefault_buffer;
2583 case SYMVAL_CURRENT_BUFFER_FORWARD: return Qcurrent_buffer;
2584 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: return Qconst_current_buffer;
2585 case SYMVAL_DEFAULT_CONSOLE_FORWARD: return Qdefault_console;
2586 case SYMVAL_SELECTED_CONSOLE_FORWARD: return Qselected_console;
2587 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: return Qconst_selected_console;
2588 case SYMVAL_UNBOUND_MARKER: return Qnil;
2591 abort (); return Qnil;
2596 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
2597 Return t if SYMBOL's value is local to BUFFER.
2598 If optional third arg AFTER-SET is non-nil, return t if SYMBOL would be
2599 buffer-local after it is set, regardless of whether it is so presently.
2600 A nil value for BUFFER is *not* the same as (current-buffer), but means
2601 "no buffer". Specifically:
2603 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
2604 the variable is one of the special built-in variables that is always
2605 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
2606 `buffer-undo-list', and others.)
2608 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
2609 the variable has had `make-variable-buffer-local' applied to it.
2611 (symbol, buffer, after_set))
2615 CHECK_SYMBOL (symbol);
2618 buffer = get_buffer (buffer, 1);
2619 local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
2623 local_info = symbol_value_buffer_local_info (symbol, 0);
2626 if (NILP (after_set))
2627 return local_info > 0 ? Qt : Qnil;
2629 return local_info != 0 ? Qt : Qnil;
2634 I've gone ahead and partially implemented this because it's
2635 super-useful for dealing with the compatibility problems in supporting
2636 the old pointer-shape variables, and preventing people from `setq'ing
2637 the new variables. Any other way of handling this problem is way
2638 ugly, likely to be slow, and generally not something I want to waste
2639 my time worrying about.
2641 The interface and/or function name is sure to change before this
2642 gets into its final form. I currently like the way everything is
2643 set up and it has all the features I want it to have, except for
2644 one: I really want to be able to have multiple nested handlers,
2645 to implement an `advice'-like capability. This would allow,
2646 for example, a clean way of implementing `debug-if-set' or
2647 `debug-if-referenced' and such.
2649 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
2650 ************************************************************
2651 **Only** the `set-value', `make-unbound', and `make-local'
2652 handler types are currently implemented. Implementing the
2653 get-value and bound-predicate handlers is somewhat tricky
2654 because there are lots of subfunctions (e.g. find_symbol_value()).
2655 find_symbol_value(), in fact, is called from outside of
2656 this module. You'd have to have it do this:
2658 -- check for a `bound-predicate' handler, call that if so;
2659 if it returns nil, return Qunbound
2660 -- check for a `get-value' handler and call it and return
2663 It gets even trickier when you have to deal with
2664 sub-subfunctions like find_symbol_value_1(), and esp.
2665 when you have to properly handle variable aliases, which
2666 can lead to lots of tricky situations. So I've just
2667 punted on this, since the interface isn't officially
2668 exported and we can get by with just a `set-value'
2671 Actions in unimplemented handler types will correctly
2672 ignore any handlers, and will not fuck anything up or
2675 WARNING WARNING: If you do go and implement another
2676 type of handler, make *sure* to change
2677 would_be_magic_handled() so it knows about this,
2678 or dire things could result.
2679 ************************************************************
2680 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
2682 Real documentation is as follows.
2684 Set a magic handler for VARIABLE.
2685 This allows you to specify arbitrary behavior that results from
2686 accessing or setting a variable. For example, retrieving the
2687 variable's value might actually retrieve the first element off of
2688 a list stored in another variable, and setting the variable's value
2689 might add an element to the front of that list. (This is how the
2690 obsolete variable `unread-command-event' is implemented.)
2692 In general it is NOT good programming practice to use magic variables
2693 in a new package that you are designing. If you feel the need to
2694 do this, it's almost certainly a sign that you should be using a
2695 function instead of a variable. This facility is provided to allow
2696 a package to support obsolete variables and provide compatibility
2697 with similar packages with different variable names and semantics.
2698 By using magic handlers, you can cleanly provide obsoleteness and
2699 compatibility support and separate this support from the core
2700 routines in a package.
2702 VARIABLE should be a symbol naming the variable for which the
2703 magic behavior is provided. HANDLER-TYPE is a symbol specifying
2704 which behavior is being controlled, and HANDLER is the function
2705 that will be called to control this behavior. HARG is a
2706 value that will be passed to HANDLER but is otherwise
2707 uninterpreted. KEEP-EXISTING specifies what to do with existing
2708 handlers of the same type; nil means "erase them all", t means
2709 "keep them but insert at the beginning", the list (t) means
2710 "keep them but insert at the end", a function means "keep
2711 them but insert before the specified function", a list containing
2712 a function means "keep them but insert after the specified
2715 You can specify magic behavior for any type of variable at all,
2716 and for any handler types that are unspecified, the standard
2717 behavior applies. This allows you, for example, to use
2718 `defvaralias' in conjunction with this function. (For that
2719 matter, `defvaralias' could be implemented using this function.)
2721 The behaviors that can be specified in HANDLER-TYPE are
2723 get-value (SYM ARGS FUN HARG HANDLERS)
2724 This means that one of the functions `symbol-value',
2725 `default-value', `symbol-value-in-buffer', or
2726 `symbol-value-in-console' was called on SYM.
2728 set-value (SYM ARGS FUN HARG HANDLERS)
2729 This means that one of the functions `set' or `set-default'
2732 bound-predicate (SYM ARGS FUN HARG HANDLERS)
2733 This means that one of the functions `boundp', `globally-boundp',
2734 or `default-boundp' was called on SYM.
2736 make-unbound (SYM ARGS FUN HARG HANDLERS)
2737 This means that the function `makunbound' was called on SYM.
2739 local-predicate (SYM ARGS FUN HARG HANDLERS)
2740 This means that the function `local-variable-p' was called
2743 make-local (SYM ARGS FUN HARG HANDLERS)
2744 This means that one of the functions `make-local-variable',
2745 `make-variable-buffer-local', `kill-local-variable',
2746 or `kill-console-local-variable' was called on SYM.
2748 The meanings of the arguments are as follows:
2750 SYM is the symbol on which the function was called, and is always
2751 the first argument to the function.
2753 ARGS are the remaining arguments in the original call (i.e. all
2754 but the first). In the case of `set-value' in particular,
2755 the first element of ARGS is the value to which the variable
2756 is being set. In some cases, ARGS is sanitized from what was
2757 actually given. For example, whenever `nil' is passed to an
2758 argument and it means `current-buffer', the current buffer is
2759 substituted instead.
2761 FUN is a symbol indicating which function is being called.
2762 For many of the functions, you can determine the corresponding
2763 function of a different class using
2764 `symbol-function-corresponding-function'.
2766 HARG is the argument that was given in the call
2767 to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
2769 HANDLERS is a structure containing the remaining handlers
2770 for the variable; to call one of them, use
2771 `chain-to-symbol-value-handler'.
2773 NOTE: You may *not* modify the list in ARGS, and if you want to
2774 keep it around after the handler function exits, you must make
2775 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
2778 static enum lisp_magic_handler
2779 decode_magic_handler_type (Lisp_Object symbol)
2781 if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE;
2782 if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE;
2783 if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE;
2784 if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND;
2785 if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE;
2786 if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL;
2788 signal_simple_error ("Unrecognized symbol value handler type", symbol);
2790 return MAGIC_HANDLER_MAX;
2793 static enum lisp_magic_handler
2794 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
2796 if (EQ (funsym, Qsymbol_value)
2797 || EQ (funsym, Qdefault_value)
2798 || EQ (funsym, Qsymbol_value_in_buffer)
2799 || EQ (funsym, Qsymbol_value_in_console))
2800 return MAGIC_HANDLER_GET_VALUE;
2802 if (EQ (funsym, Qset)
2803 || EQ (funsym, Qset_default))
2804 return MAGIC_HANDLER_SET_VALUE;
2806 if (EQ (funsym, Qboundp)
2807 || EQ (funsym, Qglobally_boundp)
2808 || EQ (funsym, Qdefault_boundp))
2809 return MAGIC_HANDLER_BOUND_PREDICATE;
2811 if (EQ (funsym, Qmakunbound))
2812 return MAGIC_HANDLER_MAKE_UNBOUND;
2814 if (EQ (funsym, Qlocal_variable_p))
2815 return MAGIC_HANDLER_LOCAL_PREDICATE;
2817 if (EQ (funsym, Qmake_variable_buffer_local)
2818 || EQ (funsym, Qmake_local_variable))
2819 return MAGIC_HANDLER_MAKE_LOCAL;
2821 if (abort_if_not_found)
2823 signal_simple_error ("Unrecognized symbol-value function", funsym);
2824 return MAGIC_HANDLER_MAX;
2828 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
2830 /* does not take into account variable aliasing. */
2831 Lisp_Object valcontents = XSYMBOL (sym)->value;
2832 enum lisp_magic_handler slot;
2834 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2836 slot = handler_type_from_function_symbol (funsym, 1);
2837 if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND
2838 && slot != MAGIC_HANDLER_MAKE_LOCAL)
2839 /* #### temporary kludge because we haven't implemented
2840 lisp-magic variables completely */
2842 return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
2846 fetch_value_maybe_past_magic (Lisp_Object sym,
2847 Lisp_Object follow_past_lisp_magic)
2849 Lisp_Object value = XSYMBOL (sym)->value;
2850 if (SYMBOL_VALUE_LISP_MAGIC_P (value)
2851 && (EQ (follow_past_lisp_magic, Qt)
2852 || (!NILP (follow_past_lisp_magic)
2853 && !would_be_magic_handled (sym, follow_past_lisp_magic))))
2854 value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed;
2858 static Lisp_Object *
2859 value_slot_past_magic (Lisp_Object sym)
2861 Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
2863 if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
2864 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
2865 return store_pointer;
2869 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
2872 Lisp_Object args[20]; /* should be enough ... */
2874 enum lisp_magic_handler htype;
2875 Lisp_Object legerdemain;
2876 struct symbol_value_lisp_magic *bfwd;
2878 assert (nargs >= 0 && nargs < countof (args));
2879 legerdemain = XSYMBOL (sym)->value;
2880 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2881 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2883 va_start (vargs, nargs);
2884 for (i = 0; i < nargs; i++)
2885 args[i] = va_arg (vargs, Lisp_Object);
2888 htype = handler_type_from_function_symbol (funsym, 1);
2889 if (NILP (bfwd->handler[htype]))
2891 /* #### should be reusing the arglist, not always consing anew.
2892 Repeated handler invocations should not cause repeated consing.
2893 Doesn't matter for now, because this is just a quick implementation
2894 for obsolescence support. */
2895 return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym,
2896 bfwd->harg[htype], Qnil);
2899 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
2901 Don't you dare use this.
2902 If you do, suffer the wrath of Ben, who is likely to rename
2903 this function (or change the semantics of its arguments) without
2904 pity, thereby invalidating your code.
2906 (variable, handler_type, handler, harg, keep_existing))
2908 Lisp_Object valcontents;
2909 struct symbol_value_lisp_magic *bfwd;
2910 enum lisp_magic_handler htype;
2913 /* #### WARNING, only some handler types are implemented. See above.
2914 Actions of other types will ignore a handler if it's there.
2916 #### Also, `chain-to-symbol-value-handler' and
2917 `symbol-function-corresponding-function' are not implemented. */
2918 CHECK_SYMBOL (variable);
2919 CHECK_SYMBOL (handler_type);
2920 htype = decode_magic_handler_type (handler_type);
2921 valcontents = XSYMBOL (variable)->value;
2922 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2924 bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
2925 &lrecord_symbol_value_lisp_magic);
2926 bfwd->magic.type = SYMVAL_LISP_MAGIC;
2927 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2929 bfwd->handler[i] = Qnil;
2930 bfwd->harg[i] = Qnil;
2932 bfwd->shadowed = valcontents;
2933 XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
2936 bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
2937 bfwd->handler[htype] = handler;
2938 bfwd->harg[htype] = harg;
2940 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2941 if (!NILP (bfwd->handler[i]))
2944 if (i == MAGIC_HANDLER_MAX)
2945 /* there are no remaining handlers, so remove the structure. */
2946 XSYMBOL (variable)->value = bfwd->shadowed;
2952 /* functions for working with variable aliases. */
2954 /* Follow the chain of variable aliases for SYMBOL. Return the
2955 resulting symbol, whose value cell is guaranteed not to be a
2956 symbol-value-varalias.
2958 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
2959 If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
2960 never follow; stop right there. Otherwise FUNSYM should be a
2961 recognized symbol-value function symbol; this means, follow
2962 unless there is a special handler for the named function.
2964 OK, there is at least one reason why it's necessary for
2965 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
2966 can always be sure to catch cyclic variable aliasing. If we never
2967 follow past Lisp magic, then if the following is done:
2970 add some magic behavior to a, but not a "get-value" handler
2973 then an attempt to retrieve a's or b's value would cause infinite
2974 looping in `symbol-value'.
2976 We (of course) can't always follow past Lisp magic, because then
2977 we make any variable that is lisp-magic -> varalias behave as if
2978 the lisp-magic is not present at all.
2982 follow_varalias_pointers (Lisp_Object symbol,
2983 Lisp_Object follow_past_lisp_magic)
2985 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
2986 Lisp_Object tortoise, hare, val;
2989 /* quick out just in case */
2990 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value))
2993 /* Compare implementation of indirect_function(). */
2994 for (hare = tortoise = symbol, count = 0;
2995 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic),
2996 SYMBOL_VALUE_VARALIAS_P (val);
2997 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)),
3000 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue;
3003 tortoise = symbol_value_varalias_aliasee
3004 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic
3005 (tortoise, follow_past_lisp_magic)));
3006 if (EQ (hare, tortoise))
3007 return Fsignal (Qcyclic_variable_indirection, list1 (symbol));
3013 DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
3014 Define a variable as an alias for another variable.
3015 Thenceforth, any operations performed on VARIABLE will actually be
3016 performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
3017 If ALIAS is nil, remove any aliases for VARIABLE.
3018 ALIAS can itself be aliased, and the chain of variable aliases
3019 will be followed appropriately.
3020 If VARIABLE already has a value, this value will be shadowed
3021 until the alias is removed, at which point it will be restored.
3022 Currently VARIABLE cannot be a built-in variable, a variable that
3023 has a buffer-local value in any buffer, or the symbols nil or t.
3024 \(ALIAS, however, can be any type of variable.)
3028 struct symbol_value_varalias *bfwd;
3029 Lisp_Object valcontents;
3031 CHECK_SYMBOL (variable);
3032 reject_constant_symbols (variable, Qunbound, 0, Qt);
3034 valcontents = XSYMBOL (variable)->value;
3038 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3040 XSYMBOL (variable)->value =
3041 symbol_value_varalias_shadowed
3042 (XSYMBOL_VALUE_VARALIAS (valcontents));
3047 CHECK_SYMBOL (alias);
3048 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3051 XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
3055 if (SYMBOL_VALUE_MAGIC_P (valcontents)
3056 && !UNBOUNDP (valcontents))
3057 signal_simple_error ("Variable is magic and cannot be aliased", variable);
3058 reject_constant_symbols (variable, Qunbound, 0, Qt);
3060 bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
3061 &lrecord_symbol_value_varalias);
3062 bfwd->magic.type = SYMVAL_VARALIAS;
3063 bfwd->aliasee = alias;
3064 bfwd->shadowed = valcontents;
3066 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
3067 XSYMBOL (variable)->value = valcontents;
3071 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
3072 If VARIABLE is aliased to another variable, return that variable.
3073 VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
3074 Variable aliases are created with `defvaralias'. See also
3075 `indirect-variable'.
3077 (variable, follow_past_lisp_magic))
3079 Lisp_Object valcontents;
3081 CHECK_SYMBOL (variable);
3082 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3084 CHECK_SYMBOL (follow_past_lisp_magic);
3085 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3088 valcontents = fetch_value_maybe_past_magic (variable,
3089 follow_past_lisp_magic);
3091 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3092 return symbol_value_varalias_aliasee
3093 (XSYMBOL_VALUE_VARALIAS (valcontents));
3098 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /*
3099 Return the variable at the end of OBJECT's variable-alias chain.
3100 If OBJECT is a symbol, follow all variable aliases and return
3101 the final (non-aliased) symbol. Variable aliases are created with
3102 the function `defvaralias'.
3103 If OBJECT is not a symbol, just return it.
3104 Signal a cyclic-variable-indirection error if there is a loop in the
3105 variable chain of symbols.
3107 (object, follow_past_lisp_magic))
3109 if (!SYMBOLP (object))
3111 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3113 CHECK_SYMBOL (follow_past_lisp_magic);
3114 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3116 return follow_varalias_pointers (object, follow_past_lisp_magic);
3120 /************************************************************************/
3121 /* initialization */
3122 /************************************************************************/
3124 /* A dumped XEmacs image has a lot more than 1511 symbols. Last
3125 estimate was that there were actually around 6300. So let's try
3126 making this bigger and see if we get better hashing behavior. */
3127 #define OBARRAY_SIZE 16411
3132 #ifndef Qnull_pointer
3133 Lisp_Object Qnull_pointer;
3136 /* some losing systems can't have static vars at function scope... */
3137 static const struct symbol_value_magic guts_of_unbound_marker =
3138 { /* struct symbol_value_magic */
3139 { /* struct lcrecord_header */
3140 { /* struct lrecord_header */
3141 lrecord_type_symbol_value_forward, /* lrecord_type_index */
3143 1, /* c_readonly bit */
3144 1, /* lisp_readonly bit */
3151 SYMVAL_UNBOUND_MARKER
3155 init_symbols_once_early (void)
3157 INIT_LRECORD_IMPLEMENTATION (symbol);
3158 INIT_LRECORD_IMPLEMENTATION (symbol_value_forward);
3159 INIT_LRECORD_IMPLEMENTATION (symbol_value_buffer_local);
3160 INIT_LRECORD_IMPLEMENTATION (symbol_value_lisp_magic);
3161 INIT_LRECORD_IMPLEMENTATION (symbol_value_varalias);
3163 reinit_symbols_once_early ();
3165 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3166 called the first time. */
3167 Qnil = Fmake_symbol (make_string_nocopy ((const Bufbyte *) "nil", 3));
3168 XSYMBOL (Qnil)->name->plist = Qnil;
3169 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
3170 XSYMBOL (Qnil)->plist = Qnil;
3172 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3173 initial_obarray = Vobarray;
3174 staticpro (&initial_obarray);
3175 /* Intern nil in the obarray */
3177 int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
3178 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3182 /* Required to get around a GCC syntax error on certain
3184 const struct symbol_value_magic *tem = &guts_of_unbound_marker;
3186 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3189 XSYMBOL (Qnil)->function = Qunbound;
3191 defsymbol (&Qt, "t");
3192 XSYMBOL (Qt)->value = Qt; /* Veritas aeterna */
3196 pdump_wire (&Qunbound);
3197 pdump_wire (&Vquit_flag);
3201 reinit_symbols_once_early (void)
3204 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3207 #ifndef Qnull_pointer
3208 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3209 so the following is actually a no-op. */
3210 XSETOBJ (Qnull_pointer, 0);
3215 defsymbol_massage_name_1 (Lisp_Object *location, const char *name, int dump_p,
3216 int multiword_predicate_p)
3219 int len = strlen (name) - 1;
3222 if (multiword_predicate_p)
3223 assert (len + 1 < sizeof (temp));
3225 assert (len < sizeof (temp));
3226 strcpy (temp, name + 1); /* Remove initial Q */
3227 if (multiword_predicate_p)
3229 strcpy (temp + len - 1, "_p");
3232 for (i = 0; i < len; i++)
3235 *location = Fintern (make_string ((const Bufbyte *) temp, len), Qnil);
3237 staticpro (location);
3239 staticpro_nodump (location);
3243 defsymbol_massage_name_nodump (Lisp_Object *location, const char *name)
3245 defsymbol_massage_name_1 (location, name, 0, 0);
3249 defsymbol_massage_name (Lisp_Object *location, const char *name)
3251 defsymbol_massage_name_1 (location, name, 1, 0);
3255 defsymbol_massage_multiword_predicate_nodump (Lisp_Object *location,
3258 defsymbol_massage_name_1 (location, name, 0, 1);
3262 defsymbol_massage_multiword_predicate (Lisp_Object *location, const char *name)
3264 defsymbol_massage_name_1 (location, name, 1, 1);
3268 defsymbol_nodump (Lisp_Object *location, const char *name)
3270 *location = Fintern (make_string_nocopy ((const Bufbyte *) name,
3273 staticpro_nodump (location);
3277 defsymbol (Lisp_Object *location, const char *name)
3279 *location = Fintern (make_string_nocopy ((const Bufbyte *) name,
3282 staticpro (location);
3286 defkeyword (Lisp_Object *location, const char *name)
3288 defsymbol (location, name);
3289 Fset (*location, *location);
3293 defkeyword_massage_name (Lisp_Object *location, const char *name)
3296 int len = strlen (name);
3298 assert (len < sizeof (temp));
3299 strcpy (temp, name);
3300 temp[1] = ':'; /* it's an underscore in the C variable */
3302 defsymbol_massage_name (location, temp);
3303 Fset (*location, *location);
3307 /* Check that nobody spazzed writing a DEFUN. */
3309 check_sane_subr (Lisp_Subr *subr, Lisp_Object sym)
3311 assert (subr->min_args >= 0);
3312 assert (subr->min_args <= SUBR_MAX_ARGS);
3314 if (subr->max_args != MANY &&
3315 subr->max_args != UNEVALLED)
3317 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3318 assert (subr->max_args <= SUBR_MAX_ARGS);
3319 assert (subr->min_args <= subr->max_args);
3322 assert (UNBOUNDP (XSYMBOL (sym)->function));
3325 #define check_sane_subr(subr, sym) /* nothing */
3330 * If we are not in a pure undumped Emacs, we need to make a duplicate of
3331 * the subr. This is because the only time this function will be called
3332 * in a running Emacs is when a dynamically loaded module is adding a
3333 * subr, and we need to make sure that the subr is in allocated, Lisp-
3334 * accessible memory. The address assigned to the static subr struct
3335 * in the shared object will be a trampoline address, so we need to create
3336 * a copy here to ensure that a real address is used.
3338 * Once we have copied everything across, we re-use the original static
3339 * structure to store a pointer to the newly allocated one. This will be
3340 * used in emodules.c by emodules_doc_subr() to find a pointer to the
3341 * allocated object so that we can set its doc string properly.
3343 * NOTE: We don't actually use the DOC pointer here any more, but we did
3344 * in an earlier implementation of module support. There is no harm in
3345 * setting it here in case we ever need it in future implementations.
3346 * subr->doc will point to the new subr structure that was allocated.
3347 * Code can then get this value from the static subr structure and use
3350 * FIXME: Should newsubr be staticpro()'ed? I don't think so but I need
3353 #define check_module_subr() \
3355 if (initialized) { \
3356 Lisp_Subr *newsubr = (Lisp_Subr *) xmalloc (sizeof (Lisp_Subr)); \
3357 memcpy (newsubr, subr, sizeof (Lisp_Subr)); \
3358 subr->doc = (const char *)newsubr; \
3362 #else /* ! HAVE_SHLIB */
3363 #define check_module_subr()
3367 defsubr (Lisp_Subr *subr)
3369 Lisp_Object sym = intern (subr_name (subr));
3372 check_sane_subr (subr, sym);
3373 check_module_subr ();
3375 XSETSUBR (fun, subr);
3376 XSYMBOL (sym)->function = fun;
3379 /* Define a lisp macro using a Lisp_Subr. */
3381 defsubr_macro (Lisp_Subr *subr)
3383 Lisp_Object sym = intern (subr_name (subr));
3386 check_sane_subr (subr, sym);
3387 check_module_subr();
3389 XSETSUBR (fun, subr);
3390 XSYMBOL (sym)->function = Fcons (Qmacro, fun);
3394 deferror_1 (Lisp_Object *symbol, const char *name, const char *messuhhj,
3395 Lisp_Object inherits_from, int massage_p)
3399 defsymbol_massage_name (symbol, name);
3401 defsymbol (symbol, name);
3403 assert (SYMBOLP (inherits_from));
3404 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3405 Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3406 /* NOT build_translated_string (). This function is called at load time
3407 and the string needs to get translated at run time. (This happens
3408 in the function (display-error) in cmdloop.el.) */
3409 Fput (*symbol, Qerror_message, build_string (messuhhj));
3413 deferror (Lisp_Object *symbol, const char *name, const char *messuhhj,
3414 Lisp_Object inherits_from)
3416 deferror_1 (symbol, name, messuhhj, inherits_from, 0);
3420 deferror_massage_name (Lisp_Object *symbol, const char *name,
3421 const char *messuhhj, Lisp_Object inherits_from)
3423 deferror_1 (symbol, name, messuhhj, inherits_from, 1);
3427 deferror_massage_name_and_message (Lisp_Object *symbol, const char *name,
3428 Lisp_Object inherits_from)
3432 int len = strlen (name) - 1;
3434 assert (len < sizeof (temp));
3435 strcpy (temp, name + 1); /* Remove initial Q */
3436 temp[0] = toupper (temp[0]);
3437 for (i = 0; i < len; i++)
3441 deferror_1 (symbol, name, temp, inherits_from, 1);
3445 syms_of_symbols (void)
3447 DEFSYMBOL (Qvariable_documentation);
3448 DEFSYMBOL (Qvariable_domain); /* I18N3 */
3449 DEFSYMBOL (Qad_advice_info);
3450 DEFSYMBOL (Qad_activate);
3452 DEFSYMBOL (Qget_value);
3453 DEFSYMBOL (Qset_value);
3454 DEFSYMBOL (Qbound_predicate);
3455 DEFSYMBOL (Qmake_unbound);
3456 DEFSYMBOL (Qlocal_predicate);
3457 DEFSYMBOL (Qmake_local);
3459 DEFSYMBOL (Qboundp);
3460 DEFSYMBOL (Qglobally_boundp);
3461 DEFSYMBOL (Qmakunbound);
3462 DEFSYMBOL (Qsymbol_value);
3464 DEFSYMBOL (Qsetq_default);
3465 DEFSYMBOL (Qdefault_boundp);
3466 DEFSYMBOL (Qdefault_value);
3467 DEFSYMBOL (Qset_default);
3468 DEFSYMBOL (Qmake_variable_buffer_local);
3469 DEFSYMBOL (Qmake_local_variable);
3470 DEFSYMBOL (Qkill_local_variable);
3471 DEFSYMBOL (Qkill_console_local_variable);
3472 DEFSYMBOL (Qsymbol_value_in_buffer);
3473 DEFSYMBOL (Qsymbol_value_in_console);
3474 DEFSYMBOL (Qlocal_variable_p);
3476 DEFSYMBOL (Qconst_integer);
3477 DEFSYMBOL (Qconst_boolean);
3478 DEFSYMBOL (Qconst_object);
3479 DEFSYMBOL (Qconst_specifier);
3480 DEFSYMBOL (Qdefault_buffer);
3481 DEFSYMBOL (Qcurrent_buffer);
3482 DEFSYMBOL (Qconst_current_buffer);
3483 DEFSYMBOL (Qdefault_console);
3484 DEFSYMBOL (Qselected_console);
3485 DEFSYMBOL (Qconst_selected_console);
3488 DEFSUBR (Fintern_soft);
3489 DEFSUBR (Funintern);
3490 DEFSUBR (Fmapatoms);
3491 DEFSUBR (Fapropos_internal);
3493 DEFSUBR (Fsymbol_function);
3494 DEFSUBR (Fsymbol_plist);
3495 DEFSUBR (Fsymbol_name);
3496 DEFSUBR (Fmakunbound);
3497 DEFSUBR (Ffmakunbound);
3499 DEFSUBR (Fglobally_boundp);
3502 DEFSUBR (Fdefine_function);
3503 Ffset (intern ("defalias"), intern ("define-function"));
3504 DEFSUBR (Fsetplist);
3505 DEFSUBR (Fsymbol_value_in_buffer);
3506 DEFSUBR (Fsymbol_value_in_console);
3507 DEFSUBR (Fbuilt_in_variable_type);
3508 DEFSUBR (Fsymbol_value);
3510 DEFSUBR (Fdefault_boundp);
3511 DEFSUBR (Fdefault_value);
3512 DEFSUBR (Fset_default);
3513 DEFSUBR (Fsetq_default);
3514 DEFSUBR (Fmake_variable_buffer_local);
3515 DEFSUBR (Fmake_local_variable);
3516 DEFSUBR (Fkill_local_variable);
3517 DEFSUBR (Fkill_console_local_variable);
3518 DEFSUBR (Flocal_variable_p);
3519 DEFSUBR (Fdefvaralias);
3520 DEFSUBR (Fvariable_alias);
3521 DEFSUBR (Findirect_variable);
3522 DEFSUBR (Fdontusethis_set_symbol_value_handler);
3525 /* Create and initialize a Lisp variable whose value is forwarded to C data */
3527 defvar_magic (const char *symbol_name, const struct symbol_value_forward *magic)
3531 #if defined(HAVE_SHLIB)
3533 * As with defsubr(), this will only be called in a dumped Emacs when
3534 * we are adding variables from a dynamically loaded module. That means
3535 * we can't use purespace. Take that into account.
3538 sym = Fintern (build_string (symbol_name), Qnil);
3541 sym = Fintern (make_string_nocopy ((const Bufbyte *) symbol_name,
3542 strlen (symbol_name)), Qnil);
3544 XSETOBJ (XSYMBOL (sym)->value, magic);
3548 vars_of_symbols (void)
3550 DEFVAR_LISP ("obarray", &Vobarray /*
3551 Symbol table for use by `intern' and `read'.
3552 It is a vector whose length ought to be prime for best results.
3553 The vector's contents don't make sense if examined from Lisp programs;
3554 to find all the symbols in an obarray, use `mapatoms'.
3556 /* obarray has been initialized long before */