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 A second optional argument specifies the obarray to use;
202 it defaults to the value of `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 A second optional argument specifies the obarray to use;
249 it defaults to the value of `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 Show all symbols whose names contain match for REGEXP.
494 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL)
495 is done for each symbol and a symbol is mentioned only if that
497 Return list of symbols found.
501 struct appropos_mapper_closure closure;
504 CHECK_STRING (regexp);
506 closure.regexp = regexp;
507 closure.predicate = predicate;
508 closure.accumulation = Qnil;
509 GCPRO1 (closure.accumulation);
510 map_obarray (Vobarray, apropos_mapper, &closure);
511 closure.accumulation = Fsort (closure.accumulation, Qstring_lessp);
513 return closure.accumulation;
517 /* Extract and set components of symbols */
519 static void set_up_buffer_local_cache (Lisp_Object sym,
520 struct symbol_value_buffer_local *bfwd,
522 Lisp_Object new_alist_el,
525 DEFUN ("boundp", Fboundp, 1, 1, 0, /*
526 Return t if SYMBOL's value is not void.
530 CHECK_SYMBOL (symbol);
531 return UNBOUNDP (find_symbol_value (symbol)) ? Qnil : Qt;
534 DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /*
535 Return t if SYMBOL has a global (non-bound) value.
536 This is for the byte-compiler; you really shouldn't be using this.
540 CHECK_SYMBOL (symbol);
541 return UNBOUNDP (top_level_value (symbol)) ? Qnil : Qt;
544 DEFUN ("fboundp", Ffboundp, 1, 1, 0, /*
545 Return t if SYMBOL's function definition is not void.
549 CHECK_SYMBOL (symbol);
550 return UNBOUNDP (XSYMBOL (symbol)->function) ? Qnil : Qt;
553 /* Return non-zero if SYM's value or function (the current contents of
554 which should be passed in as VAL) is constant, i.e. unsettable. */
557 symbol_is_constant (Lisp_Object sym, Lisp_Object val)
559 /* #### - I wonder if it would be better to just have a new magic value
560 type and make nil, t, and all keywords have that same magic
561 constant_symbol value. This test is awfully specific about what is
562 constant and what isn't. --Stig */
563 if (EQ (sym, Qnil) ||
567 if (SYMBOL_VALUE_MAGIC_P (val))
568 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
570 case SYMVAL_CONST_OBJECT_FORWARD:
571 case SYMVAL_CONST_SPECIFIER_FORWARD:
572 case SYMVAL_CONST_FIXNUM_FORWARD:
573 case SYMVAL_CONST_BOOLEAN_FORWARD:
574 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
575 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
577 default: break; /* Warning suppression */
580 /* We don't return true for keywords here because they are handled
581 specially by reject_constant_symbols(). */
585 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
586 non-zero) to NEWVAL. Make sure this is allowed.
587 FOLLOW_PAST_LISP_MAGIC specifies whether we delve past
588 symbol-value-lisp-magic objects. */
591 reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p,
592 Lisp_Object follow_past_lisp_magic)
595 (function_p ? XSYMBOL (sym)->function
596 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
598 if (SYMBOL_VALUE_MAGIC_P (val) &&
599 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
600 signal_simple_error ("Use `set-specifier' to change a specifier's value",
603 if (symbol_is_constant (sym, val)
604 || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)))
605 signal_error (Qsetting_constant,
606 UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
609 /* Verify that it's ok to make SYM buffer-local. This rejects
610 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC
611 specifies whether we delve into symbol-value-lisp-magic objects.
612 (Should be a symbol indicating what action is being taken; that way,
613 we don't delve if there's a handler for that action, but do otherwise.) */
616 verify_ok_for_buffer_local (Lisp_Object sym,
617 Lisp_Object follow_past_lisp_magic)
619 Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic);
621 if (symbol_is_constant (sym, val))
623 if (SYMBOL_VALUE_MAGIC_P (val))
624 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
626 case SYMVAL_DEFAULT_BUFFER_FORWARD:
627 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
628 /* #### It's theoretically possible for it to be reasonable
629 to have both console-local and buffer-local variables,
630 but I don't want to consider that right now. */
631 case SYMVAL_SELECTED_CONSOLE_FORWARD:
633 default: break; /* Warning suppression */
639 signal_error (Qerror,
640 list2 (build_string ("Symbol may not be buffer-local"), sym));
643 DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /*
644 Make SYMBOL's value be void.
648 Fset (symbol, Qunbound);
652 DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /*
653 Make SYMBOL's function definition be void.
657 CHECK_SYMBOL (symbol);
658 reject_constant_symbols (symbol, Qunbound, 1, Qt);
659 XSYMBOL (symbol)->function = Qunbound;
663 DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /*
664 Return SYMBOL's function definition. Error if that is void.
668 CHECK_SYMBOL (symbol);
669 if (UNBOUNDP (XSYMBOL (symbol)->function))
670 signal_void_function_error (symbol);
671 return XSYMBOL (symbol)->function;
674 DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /*
675 Return SYMBOL's property list.
679 CHECK_SYMBOL (symbol);
680 return XSYMBOL (symbol)->plist;
683 DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /*
684 Return SYMBOL's name, a string.
690 CHECK_SYMBOL (symbol);
691 XSETSTRING (name, XSYMBOL (symbol)->name);
695 DEFUN ("fset", Ffset, 2, 2, 0, /*
696 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
700 /* This function can GC */
701 CHECK_SYMBOL (symbol);
702 reject_constant_symbols (symbol, newdef, 1, Qt);
703 if (!NILP (Vautoload_queue) && !UNBOUNDP (XSYMBOL (symbol)->function))
704 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
706 XSYMBOL (symbol)->function = newdef;
707 /* Handle automatic advice activation */
708 if (CONSP (XSYMBOL (symbol)->plist) &&
709 !NILP (Fget (symbol, Qad_advice_info, Qnil)))
711 call2 (Qad_activate, symbol, Qnil);
712 newdef = XSYMBOL (symbol)->function;
718 DEFUN ("define-function", Fdefine_function, 2, 2, 0, /*
719 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
720 Associates the function with the current load file, if any.
724 /* This function can GC */
725 Ffset (symbol, newdef);
726 LOADHIST_ATTACH (symbol);
731 DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
732 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
736 CHECK_SYMBOL (symbol);
737 #if 0 /* Inserted for debugging 6/28/1997 -slb */
738 /* Somebody is setting a property list of integer 0, who? */
739 /* Not this way apparently. */
740 if (EQ(newplist, Qzero)) abort();
743 XSYMBOL (symbol)->plist = newplist;
748 /**********************************************************************/
750 /**********************************************************************/
752 /* If the contents of the value cell of a symbol is one of the following
753 three types of objects, then the symbol is "magic" in that setting
754 and retrieving its value doesn't just set or retrieve the raw
755 contents of the value cell. None of these objects can escape to
756 the user level, so there is no loss of generality.
758 If a symbol is "unbound", then the contents of its value cell is
759 Qunbound. Despite appearances, this is *not* a symbol, but is a
760 symbol-value-forward object. This is so that printing it results
761 in "INTERNAL OBJECT (XEmacs bug?)", in case it leaks to Lisp, somehow.
763 Logically all of the following objects are "symbol-value-magic"
764 objects, and there are some games played w.r.t. this (#### this
765 should be cleaned up). SYMBOL_VALUE_MAGIC_P is true for all of
766 the object types. XSYMBOL_VALUE_MAGIC_TYPE returns the type of
767 symbol-value-magic object. There are more than three types
768 returned by this macro: in particular, symbol-value-forward
769 has eight subtypes, and symbol-value-buffer-local has two. See
772 1. symbol-value-forward
774 symbol-value-forward is used for variables whose actual contents
775 are stored in a C variable of some sort, and for Qunbound. The
776 lcheader.next field (which is only used to chain together free
777 lcrecords) holds a pointer to the actual C variable. Included
778 in this type are "buffer-local" variables that are actually
779 stored in the buffer object itself; in this case, the "pointer"
780 is an offset into the struct buffer structure.
782 The subtypes are as follows:
784 SYMVAL_OBJECT_FORWARD:
785 (declare with DEFVAR_LISP)
786 The value of this variable is stored in a C variable of type
787 "Lisp_Object". Setting this variable sets the C variable.
788 Accessing this variable retrieves a value from the C variable.
789 These variables can be buffer-local -- in this case, the
790 raw symbol-value field gets converted into a
791 symbol-value-buffer-local, whose "current_value" slot contains
792 the symbol-value-forward. (See below.)
794 SYMVAL_FIXNUM_FORWARD:
795 SYMVAL_BOOLEAN_FORWARD:
796 (declare with DEFVAR_INT or DEFVAR_BOOL)
797 Similar to SYMVAL_OBJECT_FORWARD except that the C variable
798 is of type "int" and is an integer or boolean, respectively.
800 SYMVAL_CONST_OBJECT_FORWARD:
801 SYMVAL_CONST_FIXNUM_FORWARD:
802 SYMVAL_CONST_BOOLEAN_FORWARD:
803 (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
805 Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
806 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
809 SYMVAL_CONST_SPECIFIER_FORWARD:
810 (declare with DEFVAR_SPECIFIER)
811 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that the error
812 message you get when attempting to set the value says to use
813 `set-specifier' instead.
815 SYMVAL_CURRENT_BUFFER_FORWARD:
816 (declare with DEFVAR_BUFFER_LOCAL)
817 This is used for built-in buffer-local variables -- i.e.
818 Lisp variables whose value is stored in the "struct buffer".
819 Variables of this sort always forward into C "Lisp_Object"
820 fields (although there's no reason in principle that other
821 types for ints and booleans couldn't be added). Note that
822 some of these variables are automatically local in each
823 buffer, while some are only local when they become set
824 (similar to `make-variable-buffer-local'). In these latter
825 cases, of course, the default value shows through in all
826 buffers in which the variable doesn't have a local value.
827 This is implemented by making sure the "struct buffer" field
828 always contains the correct value (whether it's local or
829 a default) and maintaining a mask in the "struct buffer"
830 indicating which fields are local. When `set-default' is
831 called on a variable that's not always local to all buffers,
832 it loops through each buffer and sets the corresponding
833 field in each buffer without a local value for the field,
834 according to the mask.
836 Calling `make-local-variable' on a variable of this sort
837 only has the effect of maybe changing the current buffer's mask.
838 Calling `make-variable-buffer-local' on a variable of this
839 sort has no effect at all.
841 SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
842 (declare with DEFVAR_CONST_BUFFER_LOCAL)
843 Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
846 SYMVAL_DEFAULT_BUFFER_FORWARD:
847 (declare with DEFVAR_BUFFER_DEFAULTS)
848 This is used for the Lisp variables that contain the
849 default values of built-in buffer-local variables. Setting
850 or referencing one of these variables forwards into a slot
851 in the special struct buffer Vbuffer_defaults.
853 SYMVAL_UNBOUND_MARKER:
854 This is used for only one object, Qunbound.
856 SYMVAL_SELECTED_CONSOLE_FORWARD:
857 (declare with DEFVAR_CONSOLE_LOCAL)
858 This is used for built-in console-local variables -- i.e.
859 Lisp variables whose value is stored in the "struct console".
860 These work just like built-in buffer-local variables.
861 However, calling `make-local-variable' or
862 `make-variable-buffer-local' on one of these variables
863 is currently disallowed because that would entail having
864 both console-local and buffer-local variables, which is
865 trickier to implement.
867 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
868 (declare with DEFVAR_CONST_CONSOLE_LOCAL)
869 Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
872 SYMVAL_DEFAULT_CONSOLE_FORWARD:
873 (declare with DEFVAR_CONSOLE_DEFAULTS)
874 This is used for the Lisp variables that contain the
875 default values of built-in console-local variables. Setting
876 or referencing one of these variables forwards into a slot
877 in the special struct console Vconsole_defaults.
880 2. symbol-value-buffer-local
882 symbol-value-buffer-local is used for variables that have had
883 `make-local-variable' or `make-variable-buffer-local' applied
884 to them. This object contains an alist mapping buffers to
885 values. In addition, the object contains a "current value",
886 which is the value in some buffer. Whenever you access the
887 variable with `symbol-value' or set it with `set' or `setq',
888 things are switched around so that the "current value"
889 refers to the current buffer, if it wasn't already. This
890 way, repeated references to a variable in the same buffer
891 are almost as efficient as if the variable weren't buffer
892 local. Note that the alist may not be up-to-date w.r.t.
893 the buffer whose value is current, as the "current value"
894 cache is normally only flushed into the alist when the
895 buffer it refers to changes.
897 Note also that it is possible for `make-local-variable'
898 or `make-variable-buffer-local' to be called on a variable
899 that forwards into a C variable (i.e. a variable whose
900 value cell is a symbol-value-forward). In this case,
901 the value cell becomes a symbol-value-buffer-local (as
902 always), and the symbol-value-forward moves into
903 the "current value" cell in this object. Also, in
904 this case the "current value" *always* refers to the
905 current buffer, so that the values of the C variable
906 always is the correct value for the current buffer.
907 set_buffer_internal() automatically updates the current-value
908 cells of all buffer-local variables that forward into C
909 variables. (There is a list of all buffer-local variables
910 that is maintained for this and other purposes.)
912 Note that only certain types of `symbol-value-forward' objects
913 can find their way into the "current value" cell of a
914 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
915 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
916 SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot
917 be buffer-local because they are unsettable;
918 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
919 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
920 does not have much of an effect (it's already buffer-local); and
921 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
922 that's not currently implemented.
925 3. symbol-value-varalias
927 A symbol-value-varalias object is used for variables that
928 are aliases for other variables. This object contains
929 the symbol that this variable is aliased to.
930 symbol-value-varalias objects cannot occur anywhere within
931 a symbol-value-buffer-local object, and most of the
932 low-level functions below do not accept them; you need
933 to call follow_varalias_pointers to get the actual
934 symbol to operate on. */
937 mark_symbol_value_buffer_local (Lisp_Object obj)
939 struct symbol_value_buffer_local *bfwd;
941 #ifdef ERROR_CHECK_TYPECHECK
942 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
943 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
946 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
947 mark_object (bfwd->default_value);
948 mark_object (bfwd->current_value);
949 mark_object (bfwd->current_buffer);
950 return bfwd->current_alist_element;
954 mark_symbol_value_lisp_magic (Lisp_Object obj)
956 struct symbol_value_lisp_magic *bfwd;
959 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
961 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
962 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
964 mark_object (bfwd->handler[i]);
965 mark_object (bfwd->harg[i]);
967 return bfwd->shadowed;
971 mark_symbol_value_varalias (Lisp_Object obj)
973 struct symbol_value_varalias *bfwd;
975 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
977 bfwd = XSYMBOL_VALUE_VARALIAS (obj);
978 mark_object (bfwd->shadowed);
979 return bfwd->aliasee;
982 /* Should never, ever be called. (except by an external debugger) */
984 print_symbol_value_magic (Lisp_Object obj,
985 Lisp_Object printcharfun, int escapeflag)
988 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s type %d) 0x%lx>",
989 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
990 XSYMBOL_VALUE_MAGIC_TYPE (obj),
992 write_c_string (buf, printcharfun);
995 static const struct lrecord_description symbol_value_forward_description[] = {
999 static const struct lrecord_description symbol_value_buffer_local_description[] = {
1000 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, default_value) },
1001 { XD_LO_RESET_NIL, offsetof (struct symbol_value_buffer_local, current_value), 3 },
1005 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
1006 { XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 },
1010 static const struct lrecord_description symbol_value_varalias_description[] = {
1011 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, aliasee) },
1012 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, shadowed) },
1016 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
1017 symbol_value_forward,
1019 print_symbol_value_magic, 0, 0, 0,
1020 symbol_value_forward_description,
1021 struct symbol_value_forward);
1023 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
1024 symbol_value_buffer_local,
1025 mark_symbol_value_buffer_local,
1026 print_symbol_value_magic, 0, 0, 0,
1027 symbol_value_buffer_local_description,
1028 struct symbol_value_buffer_local);
1030 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
1031 symbol_value_lisp_magic,
1032 mark_symbol_value_lisp_magic,
1033 print_symbol_value_magic, 0, 0, 0,
1034 symbol_value_lisp_magic_description,
1035 struct symbol_value_lisp_magic);
1037 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
1038 symbol_value_varalias,
1039 mark_symbol_value_varalias,
1040 print_symbol_value_magic, 0, 0, 0,
1041 symbol_value_varalias_description,
1042 struct symbol_value_varalias);
1045 /* Getting and setting values of symbols */
1047 /* Given the raw contents of a symbol value cell, return the Lisp value of
1048 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
1049 symbol-value-lisp-magic, or symbol-value-varalias.
1051 BUFFER specifies a buffer, and is used for built-in buffer-local
1052 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
1053 Note that such variables are never encapsulated in a
1054 symbol-value-buffer-local structure.
1056 CONSOLE specifies a console, and is used for built-in console-local
1057 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
1058 Note that such variables are (currently) never encapsulated in a
1059 symbol-value-buffer-local structure.
1063 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
1064 struct console *console)
1066 const struct symbol_value_forward *fwd;
1068 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1071 fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1072 switch (fwd->magic.type)
1074 case SYMVAL_FIXNUM_FORWARD:
1075 case SYMVAL_CONST_FIXNUM_FORWARD:
1076 return make_int (*((int *)symbol_value_forward_forward (fwd)));
1078 case SYMVAL_BOOLEAN_FORWARD:
1079 case SYMVAL_CONST_BOOLEAN_FORWARD:
1080 return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
1082 case SYMVAL_OBJECT_FORWARD:
1083 case SYMVAL_CONST_OBJECT_FORWARD:
1084 case SYMVAL_CONST_SPECIFIER_FORWARD:
1085 return *((Lisp_Object *)symbol_value_forward_forward (fwd));
1087 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1088 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1089 + ((char *)symbol_value_forward_forward (fwd)
1090 - (char *)&buffer_local_flags))));
1093 case SYMVAL_CURRENT_BUFFER_FORWARD:
1094 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1096 return (*((Lisp_Object *)((char *)buffer
1097 + ((char *)symbol_value_forward_forward (fwd)
1098 - (char *)&buffer_local_flags))));
1100 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1101 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1102 + ((char *)symbol_value_forward_forward (fwd)
1103 - (char *)&console_local_flags))));
1105 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1106 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1108 return (*((Lisp_Object *)((char *)console
1109 + ((char *)symbol_value_forward_forward (fwd)
1110 - (char *)&console_local_flags))));
1112 case SYMVAL_UNBOUND_MARKER:
1118 return Qnil; /* suppress compiler warning */
1121 /* Set the value of default-buffer-local variable SYM to VALUE. */
1124 set_default_buffer_slot_variable (Lisp_Object sym,
1127 /* Handle variables like case-fold-search that have special slots in
1128 the buffer. Make them work apparently like buffer_local variables.
1130 /* At this point, the value cell may not contain a symbol-value-varalias
1131 or symbol-value-buffer-local, and if there's a handler, we should
1132 have already called it. */
1133 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1134 const struct symbol_value_forward *fwd
1135 = XSYMBOL_VALUE_FORWARD (valcontents);
1136 int offset = ((char *) symbol_value_forward_forward (fwd)
1137 - (char *) &buffer_local_flags);
1138 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1139 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1140 int flags) = symbol_value_forward_magicfun (fwd);
1142 *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
1145 if (mask > 0) /* Not always per-buffer */
1147 /* Set value in each buffer which hasn't shadowed the default */
1148 LIST_LOOP_2 (elt, Vbuffer_alist)
1150 struct buffer *b = XBUFFER (XCDR (elt));
1151 if (!(b->local_var_flags & mask))
1154 magicfun (sym, &value, make_buffer (b), 0);
1155 *((Lisp_Object *) (offset + (char *) b)) = value;
1161 /* Set the value of default-console-local variable SYM to VALUE. */
1164 set_default_console_slot_variable (Lisp_Object sym,
1167 /* Handle variables like case-fold-search that have special slots in
1168 the console. Make them work apparently like console_local variables.
1170 /* At this point, the value cell may not contain a symbol-value-varalias
1171 or symbol-value-buffer-local, and if there's a handler, we should
1172 have already called it. */
1173 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1174 const struct symbol_value_forward *fwd
1175 = XSYMBOL_VALUE_FORWARD (valcontents);
1176 int offset = ((char *) symbol_value_forward_forward (fwd)
1177 - (char *) &console_local_flags);
1178 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1179 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1180 int flags) = symbol_value_forward_magicfun (fwd);
1182 *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
1185 if (mask > 0) /* Not always per-console */
1187 /* Set value in each console which hasn't shadowed the default */
1188 LIST_LOOP_2 (console, Vconsole_list)
1190 struct console *d = XCONSOLE (console);
1191 if (!(d->local_var_flags & mask))
1194 magicfun (sym, &value, console, 0);
1195 *((Lisp_Object *) (offset + (char *) d)) = value;
1201 /* Store NEWVAL into SYM.
1203 SYM's value slot may *not* be types (5) or (6) above,
1204 i.e. no symbol-value-varalias objects. (You should have
1205 forwarded past all of these.)
1207 SYM should not be an unsettable symbol or a symbol with
1208 a magic `set-value' handler (unless you want to explicitly
1209 ignore this handler).
1211 OVALUE is the current value of SYM, but forwarded past any
1212 symbol-value-buffer-local and symbol-value-lisp-magic objects.
1213 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1214 the contents of its current-value cell.) NEWVAL may only be
1215 a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
1216 this function will only modify its current-value cell, which should
1217 already be set up to point to the current buffer.
1221 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
1224 if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
1226 Lisp_Object *store_pointer = value_slot_past_magic (sym);
1228 if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
1230 &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
1232 assert (UNBOUNDP (*store_pointer)
1233 || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1234 *store_pointer = newval;
1238 const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue);
1239 int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
1240 Lisp_Object in_object, int flags)
1241 = symbol_value_forward_magicfun (fwd);
1243 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue))
1245 case SYMVAL_FIXNUM_FORWARD:
1248 magicfun (sym, &newval, Qnil, 0);
1249 *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
1252 case SYMVAL_BOOLEAN_FORWARD:
1254 magicfun (sym, &newval, Qnil, 0);
1255 *((int *) symbol_value_forward_forward (fwd))
1259 case SYMVAL_OBJECT_FORWARD:
1261 magicfun (sym, &newval, Qnil, 0);
1262 *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
1265 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1266 set_default_buffer_slot_variable (sym, newval);
1269 case SYMVAL_CURRENT_BUFFER_FORWARD:
1271 magicfun (sym, &newval, make_buffer (current_buffer), 0);
1272 *((Lisp_Object *) ((char *) current_buffer
1273 + ((char *) symbol_value_forward_forward (fwd)
1274 - (char *) &buffer_local_flags)))
1278 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1279 set_default_console_slot_variable (sym, newval);
1282 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1284 magicfun (sym, &newval, Vselected_console, 0);
1285 *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console)
1286 + ((char *) symbol_value_forward_forward (fwd)
1287 - (char *) &console_local_flags)))
1297 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1298 BFWD, locate and return a pointer to the element in BUFFER's
1299 local_var_alist for SYMBOL. The return value will be Qnil if
1300 BUFFER does not have its own value for SYMBOL (i.e. the default
1301 value is seen in that buffer).
1305 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
1306 struct symbol_value_buffer_local *bfwd)
1308 if (!NILP (bfwd->current_buffer) &&
1309 XBUFFER (bfwd->current_buffer) == buffer)
1310 /* This is just an optimization of the below. */
1311 return bfwd->current_alist_element;
1313 return assq_no_quit (symbol, buffer->local_var_alist);
1316 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1317 symbol-value-buffer-local of a per-buffer variable -- i.e. the
1318 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1319 slot -- may be out of date.]
1321 Write out any cached value in buffer-local variable SYMBOL's
1322 buffer-local structure, which is passed in as BFWD.
1326 write_out_buffer_local_cache (Lisp_Object symbol,
1327 struct symbol_value_buffer_local *bfwd)
1329 if (!NILP (bfwd->current_buffer))
1331 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1332 uses it, and that type cannot be inside a symbol-value-buffer-local */
1333 Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0);
1334 if (NILP (bfwd->current_alist_element))
1335 /* current_value may be updated more recently than default_value */
1336 bfwd->default_value = cval;
1338 Fsetcdr (bfwd->current_alist_element, cval);
1342 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1343 Set up BFWD's cache for validity in buffer BUF. This assumes that
1344 the cache is currently in a consistent state (this can include
1345 not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1347 If the cache is already set up for BUF, this function does nothing
1350 Otherwise, if SYM forwards out to a C variable, this also forwards
1351 SYM's value in BUF out to the variable. Therefore, you generally
1352 only want to call this when BUF is, or is about to become, the
1355 (Otherwise, you can just retrieve the value without changing the
1356 cache, at the expense of slower retrieval.)
1360 set_up_buffer_local_cache (Lisp_Object sym,
1361 struct symbol_value_buffer_local *bfwd,
1363 Lisp_Object new_alist_el,
1366 Lisp_Object new_val;
1368 if (!NILP (bfwd->current_buffer)
1369 && buf == XBUFFER (bfwd->current_buffer))
1370 /* Cache is already set up. */
1373 /* Flush out the old cache. */
1374 write_out_buffer_local_cache (sym, bfwd);
1376 /* Retrieve the new alist element and new value. */
1377 if (NILP (new_alist_el)
1379 new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1381 if (NILP (new_alist_el))
1382 new_val = bfwd->default_value;
1384 new_val = Fcdr (new_alist_el);
1386 bfwd->current_alist_element = new_alist_el;
1387 XSETBUFFER (bfwd->current_buffer, buf);
1389 /* Now store the value into the current-value slot.
1390 We don't simply write it there, because the current-value
1391 slot might be a forwarding pointer, in which case we need
1392 to instead write the value into the C variable.
1394 We might also want to call a magic function.
1396 So instead, we call this function. */
1397 store_symval_forwarding (sym, bfwd->current_value, new_val);
1402 kill_buffer_local_variables (struct buffer *buf)
1404 Lisp_Object prev = Qnil;
1407 /* Any which are supposed to be permanent,
1408 make local again, with the same values they had. */
1410 for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
1412 Lisp_Object sym = XCAR (XCAR (alist));
1413 struct symbol_value_buffer_local *bfwd;
1414 /* Variables with a symbol-value-varalias should not be here
1415 (we should have forwarded past them) and there must be a
1416 symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
1417 just forward past it; if the variable has a handler, it was
1419 Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
1421 assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
1422 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
1424 if (!NILP (Fget (sym, Qpermanent_local, Qnil)))
1425 /* prev points to the last alist element that is still
1426 staying around, so *only* update it now. This didn't
1427 used to be the case; this bug has been around since
1428 mly's rewrite two years ago! */
1432 /* Really truly kill it. */
1434 XCDR (prev) = XCDR (alist);
1436 buf->local_var_alist = XCDR (alist);
1438 /* We just effectively changed the value for this variable
1441 /* (1) If the cache is caching BUF, invalidate the cache. */
1442 if (!NILP (bfwd->current_buffer) &&
1443 buf == XBUFFER (bfwd->current_buffer))
1444 bfwd->current_buffer = Qnil;
1446 /* (2) If we changed the value in current_buffer and this
1447 variable forwards to a C variable, we need to change the
1448 value of the C variable. set_up_buffer_local_cache()
1449 will do this. It doesn't hurt to do it whenever
1450 BUF == current_buffer, so just go ahead and do that. */
1451 if (buf == current_buffer)
1452 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
1458 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1459 struct console *con, int swap_it_in,
1460 Lisp_Object symcons, int set_it_p)
1462 Lisp_Object valcontents;
1465 valcontents = XSYMBOL (sym)->value;
1468 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1471 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1473 case SYMVAL_LISP_MAGIC:
1475 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1479 case SYMVAL_VARALIAS:
1480 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1482 /* presto change-o! */
1485 case SYMVAL_BUFFER_LOCAL:
1486 case SYMVAL_SOME_BUFFER_LOCAL:
1488 struct symbol_value_buffer_local *bfwd
1489 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1493 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1494 valcontents = bfwd->current_value;
1498 if (!NILP (bfwd->current_buffer) &&
1499 buf == XBUFFER (bfwd->current_buffer))
1500 valcontents = bfwd->current_value;
1501 else if (NILP (symcons))
1504 valcontents = assq_no_quit (sym, buf->local_var_alist);
1505 if (NILP (valcontents))
1506 valcontents = bfwd->default_value;
1508 valcontents = XCDR (valcontents);
1511 valcontents = XCDR (symcons);
1519 return do_symval_forwarding (valcontents, buf, con);
1523 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1524 bound. Note that it must not be possible to QUIT within this
1528 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
1535 buf = current_buffer;
1538 CHECK_BUFFER (buffer);
1539 buf = XBUFFER (buffer);
1542 return find_symbol_value_1 (sym, buf,
1543 /* If it bombs out at startup due to a
1544 Lisp error, this may be nil. */
1545 CONSOLEP (Vselected_console)
1546 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
1550 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1555 console = Vselected_console;
1557 CHECK_CONSOLE (console);
1559 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1563 /* Return the current value of SYM. The difference between this function
1564 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1565 this updates the CURRENT_VALUE slot of buffer-local variables to
1566 point to the current buffer, while symbol_value_in_buffer doesn't. */
1569 find_symbol_value (Lisp_Object sym)
1571 /* WARNING: This function can be called when current_buffer is 0
1572 and Vselected_console is Qnil, early in initialization. */
1573 struct console *con;
1574 Lisp_Object valcontents;
1578 valcontents = XSYMBOL (sym)->value;
1579 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1582 if (CONSOLEP (Vselected_console))
1583 con = XCONSOLE (Vselected_console);
1586 /* This can also get called while we're preparing to shutdown.
1587 #### What should really happen in that case? Should we
1588 actually fix things so we can't get here in that case? */
1590 assert (!initialized || preparing_for_armageddon);
1595 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
1598 /* This is an optimized function for quick lookup of buffer local symbols
1599 by avoiding O(n) search. This will work when either:
1600 a) We have already found the symbol e.g. by traversing local_var_alist.
1602 b) We know that the symbol will not be found in the current buffer's
1603 list of local variables.
1604 In the former case, find_it_p is 1 and symbol_cons is the element from
1605 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1608 This function is called from set_buffer_internal which does both of these
1612 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1614 /* WARNING: This function can be called when current_buffer is 0
1615 and Vselected_console is Qnil, early in initialization. */
1616 struct console *con;
1617 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1620 if (CONSOLEP (Vselected_console))
1621 con = XCONSOLE (Vselected_console);
1624 /* This can also get called while we're preparing to shutdown.
1625 #### What should really happen in that case? Should we
1626 actually fix things so we can't get here in that case? */
1628 assert (!initialized || preparing_for_armageddon);
1633 return find_symbol_value_1 (sym, current_buffer, con, 1,
1634 find_it_p ? symbol_cons : Qnil,
1638 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1639 Return SYMBOL's value. Error if that is void.
1643 Lisp_Object val = find_symbol_value (symbol);
1646 return Fsignal (Qvoid_variable, list1 (symbol));
1651 DEFUN ("set", Fset, 2, 2, 0, /*
1652 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1656 REGISTER Lisp_Object valcontents;
1658 /* remember, we're called by Fmakunbound() as well */
1660 CHECK_SYMBOL (symbol);
1663 sym = XSYMBOL (symbol);
1664 valcontents = sym->value;
1666 if (EQ (symbol, Qnil) ||
1668 SYMBOL_IS_KEYWORD (symbol))
1669 reject_constant_symbols (symbol, newval, 0,
1670 UNBOUNDP (newval) ? Qmakunbound : Qset);
1672 if (!SYMBOL_VALUE_MAGIC_P (valcontents) || UNBOUNDP (valcontents))
1674 sym->value = newval;
1678 reject_constant_symbols (symbol, newval, 0,
1679 UNBOUNDP (newval) ? Qmakunbound : Qset);
1681 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1683 case SYMVAL_LISP_MAGIC:
1685 if (UNBOUNDP (newval))
1687 maybe_call_magic_handler (symbol, Qmakunbound, 0);
1688 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = Qunbound;
1692 maybe_call_magic_handler (symbol, Qset, 1, newval);
1693 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = newval;
1697 case SYMVAL_VARALIAS:
1698 symbol = follow_varalias_pointers (symbol,
1700 ? Qmakunbound : Qset);
1701 /* presto change-o! */
1704 case SYMVAL_FIXNUM_FORWARD:
1705 case SYMVAL_BOOLEAN_FORWARD:
1706 case SYMVAL_OBJECT_FORWARD:
1707 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1708 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1709 if (UNBOUNDP (newval))
1710 signal_error (Qerror,
1711 list2 (build_string ("Cannot makunbound"), symbol));
1714 /* case SYMVAL_UNBOUND_MARKER: break; */
1716 case SYMVAL_CURRENT_BUFFER_FORWARD:
1718 const struct symbol_value_forward *fwd
1719 = XSYMBOL_VALUE_FORWARD (valcontents);
1720 int mask = XINT (*((Lisp_Object *)
1721 symbol_value_forward_forward (fwd)));
1723 /* Setting this variable makes it buffer-local */
1724 current_buffer->local_var_flags |= mask;
1728 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1730 const struct symbol_value_forward *fwd
1731 = XSYMBOL_VALUE_FORWARD (valcontents);
1732 int mask = XINT (*((Lisp_Object *)
1733 symbol_value_forward_forward (fwd)));
1735 /* Setting this variable makes it console-local */
1736 XCONSOLE (Vselected_console)->local_var_flags |= mask;
1740 case SYMVAL_BUFFER_LOCAL:
1741 case SYMVAL_SOME_BUFFER_LOCAL:
1743 /* If we want to examine or set the value and
1744 CURRENT-BUFFER is current, we just examine or set
1745 CURRENT-VALUE. If CURRENT-BUFFER is not current, we
1746 store the current CURRENT-VALUE value into
1747 CURRENT-ALIST- ELEMENT, then find the appropriate alist
1748 element for the buffer now current and set up
1749 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
1750 of that element, and store into CURRENT-BUFFER.
1752 If we are setting the variable and the current buffer does
1753 not have an alist entry for this variable, an alist entry is
1756 Note that CURRENT-VALUE can be a forwarding pointer.
1757 Each time it is examined or set, forwarding must be
1759 struct symbol_value_buffer_local *bfwd
1760 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1761 int some_buffer_local_p =
1762 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
1763 /* What value are we caching right now? */
1764 Lisp_Object aelt = bfwd->current_alist_element;
1766 if (!NILP (bfwd->current_buffer) &&
1767 current_buffer == XBUFFER (bfwd->current_buffer)
1768 && ((some_buffer_local_p)
1769 ? 1 /* doesn't automatically become local */
1770 : !NILP (aelt) /* already local */
1773 /* Cache is valid */
1774 valcontents = bfwd->current_value;
1778 /* If the current buffer is not the buffer whose binding is
1779 currently cached, or if it's a SYMVAL_BUFFER_LOCAL and
1780 we're looking at the default value, the cache is invalid; we
1781 need to write it out, and find the new CURRENT-ALIST-ELEMENT
1784 /* Write out the cached value for the old buffer; copy it
1785 back to its alist element. This works if the current
1786 buffer only sees the default value, too. */
1787 write_out_buffer_local_cache (symbol, bfwd);
1789 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1790 aelt = buffer_local_alist_element (current_buffer, symbol, bfwd);
1793 /* This buffer is still seeing the default value. */
1794 if (!some_buffer_local_p)
1796 /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a
1797 new assoc for a local value and set
1798 CURRENT-ALIST-ELEMENT to point to that. */
1800 do_symval_forwarding (bfwd->current_value,
1802 XCONSOLE (Vselected_console));
1803 aelt = Fcons (symbol, aelt);
1804 current_buffer->local_var_alist
1805 = Fcons (aelt, current_buffer->local_var_alist);
1809 /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
1810 we're currently seeing the default value. */
1814 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1815 bfwd->current_alist_element = aelt;
1816 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
1817 XSETBUFFER (bfwd->current_buffer, current_buffer);
1818 valcontents = bfwd->current_value;
1825 store_symval_forwarding (symbol, valcontents, newval);
1831 /* Access or set a buffer-local symbol's default value. */
1833 /* Return the default value of SYM, but don't check for voidness.
1834 Return Qunbound if it is void. */
1837 default_value (Lisp_Object sym)
1839 Lisp_Object valcontents;
1844 valcontents = XSYMBOL (sym)->value;
1847 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1850 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1852 case SYMVAL_LISP_MAGIC:
1854 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1858 case SYMVAL_VARALIAS:
1859 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1860 /* presto change-o! */
1863 case SYMVAL_UNBOUND_MARKER:
1866 case SYMVAL_CURRENT_BUFFER_FORWARD:
1868 const struct symbol_value_forward *fwd
1869 = XSYMBOL_VALUE_FORWARD (valcontents);
1870 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1871 + ((char *)symbol_value_forward_forward (fwd)
1872 - (char *)&buffer_local_flags))));
1875 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1877 const struct symbol_value_forward *fwd
1878 = XSYMBOL_VALUE_FORWARD (valcontents);
1879 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1880 + ((char *)symbol_value_forward_forward (fwd)
1881 - (char *)&console_local_flags))));
1884 case SYMVAL_BUFFER_LOCAL:
1885 case SYMVAL_SOME_BUFFER_LOCAL:
1887 struct symbol_value_buffer_local *bfwd =
1888 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1890 /* Handle user-created local variables. */
1891 /* If var is set up for a buffer that lacks a local value for it,
1892 the current value is nominally the default value.
1893 But the current value slot may be more up to date, since
1894 ordinary setq stores just that slot. So use that. */
1895 if (NILP (bfwd->current_alist_element))
1896 return do_symval_forwarding (bfwd->current_value, current_buffer,
1897 XCONSOLE (Vselected_console));
1899 return bfwd->default_value;
1902 /* For other variables, get the current value. */
1903 return do_symval_forwarding (valcontents, current_buffer,
1904 XCONSOLE (Vselected_console));
1907 RETURN_NOT_REACHED (Qnil) /* suppress compiler warning */
1910 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /*
1911 Return t if SYMBOL has a non-void default value.
1912 This is the value that is seen in buffers that do not have their own values
1917 return UNBOUNDP (default_value (symbol)) ? Qnil : Qt;
1920 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /*
1921 Return SYMBOL's default value.
1922 This is the value that is seen in buffers that do not have their own values
1923 for this variable. The default value is meaningful for variables with
1924 local bindings in certain buffers.
1928 Lisp_Object value = default_value (symbol);
1930 return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (symbol)) : value;
1933 DEFUN ("set-default", Fset_default, 2, 2, 0, /*
1934 Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.
1935 The default value is seen in buffers that do not have their own values
1940 Lisp_Object valcontents;
1942 CHECK_SYMBOL (symbol);
1945 valcontents = XSYMBOL (symbol)->value;
1948 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1949 return Fset (symbol, value);
1951 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1953 case SYMVAL_LISP_MAGIC:
1954 RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (symbol, Qset_default, 1,
1956 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1960 case SYMVAL_VARALIAS:
1961 symbol = follow_varalias_pointers (symbol, Qset_default);
1962 /* presto change-o! */
1965 case SYMVAL_CURRENT_BUFFER_FORWARD:
1966 set_default_buffer_slot_variable (symbol, value);
1969 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1970 set_default_console_slot_variable (symbol, value);
1973 case SYMVAL_BUFFER_LOCAL:
1974 case SYMVAL_SOME_BUFFER_LOCAL:
1976 /* Store new value into the DEFAULT-VALUE slot */
1977 struct symbol_value_buffer_local *bfwd
1978 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1980 bfwd->default_value = value;
1981 /* If current-buffer doesn't shadow default_value,
1982 * we must set the CURRENT-VALUE slot too */
1983 if (NILP (bfwd->current_alist_element))
1984 store_symval_forwarding (symbol, bfwd->current_value, value);
1989 return Fset (symbol, value);
1993 DEFUN ("setq-default", Fsetq_default, 0, UNEVALLED, 0, /*
1994 Set the default value of variable SYMBOL to VALUE.
1995 SYMBOL, the variable name, is literal (not evaluated);
1996 VALUE is an expression and it is evaluated.
1997 The default value of a variable is seen in buffers
1998 that do not have their own values for the variable.
2000 More generally, you can use multiple variables and values, as in
2001 (setq-default SYMBOL VALUE SYMBOL VALUE...)
2002 This sets each SYMBOL's default value to the corresponding VALUE.
2003 The VALUE for the Nth SYMBOL can refer to the new default values
2004 of previous SYMBOLs.
2008 /* This function can GC */
2009 Lisp_Object symbol, tail, val = Qnil;
2011 struct gcpro gcpro1;
2013 GET_LIST_LENGTH (args, nargs);
2015 if (nargs & 1) /* Odd number of arguments? */
2016 Fsignal (Qwrong_number_of_arguments,
2017 list2 (Qsetq_default, make_int (nargs)));
2021 PROPERTY_LIST_LOOP (tail, symbol, val, args)
2024 Fset_default (symbol, val);
2031 /* Lisp functions for creating and removing buffer-local variables. */
2033 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1,
2034 "vMake Variable Buffer Local: ", /*
2035 Make VARIABLE have a separate value for each buffer.
2036 At any time, the value for the current buffer is in effect.
2037 There is also a default value which is seen in any buffer which has not yet
2039 Using `set' or `setq' to set the variable causes it to have a separate value
2040 for the current buffer if it was previously using the default value.
2041 The function `default-value' gets the default value and `set-default'
2046 Lisp_Object valcontents;
2048 CHECK_SYMBOL (variable);
2051 verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
2053 valcontents = XSYMBOL (variable)->value;
2056 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2058 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2060 case SYMVAL_LISP_MAGIC:
2061 if (!UNBOUNDP (maybe_call_magic_handler
2062 (variable, Qmake_variable_buffer_local, 0)))
2064 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2068 case SYMVAL_VARALIAS:
2069 variable = follow_varalias_pointers (variable,
2070 Qmake_variable_buffer_local);
2071 /* presto change-o! */
2074 case SYMVAL_FIXNUM_FORWARD:
2075 case SYMVAL_BOOLEAN_FORWARD:
2076 case SYMVAL_OBJECT_FORWARD:
2077 case SYMVAL_UNBOUND_MARKER:
2080 case SYMVAL_CURRENT_BUFFER_FORWARD:
2081 case SYMVAL_BUFFER_LOCAL:
2082 /* Already per-each-buffer */
2085 case SYMVAL_SOME_BUFFER_LOCAL:
2087 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
2088 SYMVAL_BUFFER_LOCAL;
2097 struct symbol_value_buffer_local *bfwd
2098 = alloc_lcrecord_type (struct symbol_value_buffer_local,
2099 &lrecord_symbol_value_buffer_local);
2101 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2103 bfwd->default_value = find_symbol_value (variable);
2104 bfwd->current_value = valcontents;
2105 bfwd->current_alist_element = Qnil;
2106 bfwd->current_buffer = Fcurrent_buffer ();
2107 XSETSYMBOL_VALUE_MAGIC (foo, bfwd);
2108 *value_slot_past_magic (variable) = foo;
2109 #if 1 /* #### Yuck! FSFmacs bug-compatibility*/
2110 /* This sets the default-value of any make-variable-buffer-local to nil.
2111 That just sucks. User can just use setq-default to effect that,
2112 but there's no way to do makunbound-default to undo this lossage. */
2113 if (UNBOUNDP (valcontents))
2114 bfwd->default_value = Qnil;
2116 #if 0 /* #### Yuck! */
2117 /* This sets the value to nil in this buffer.
2118 User could use (setq variable nil) to do this.
2119 It isn't as egregious to do this automatically
2120 as it is to do so to the default-value, but it's
2121 still really dubious. */
2122 if (UNBOUNDP (valcontents))
2123 Fset (variable, Qnil);
2129 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1,
2130 "vMake Local Variable: ", /*
2131 Make VARIABLE have a separate value in the current buffer.
2132 Other buffers will continue to share a common default value.
2133 \(The buffer-local value of VARIABLE starts out as the same value
2134 VARIABLE previously had. If VARIABLE was void, it remains void.)
2135 See also `make-variable-buffer-local'.
2137 If the variable is already arranged to become local when set,
2138 this function causes a local value to exist for this buffer,
2139 just as setting the variable would do.
2141 Do not use `make-local-variable' to make a hook variable buffer-local.
2142 Use `make-local-hook' instead.
2146 Lisp_Object valcontents;
2147 struct symbol_value_buffer_local *bfwd;
2149 CHECK_SYMBOL (variable);
2152 verify_ok_for_buffer_local (variable, Qmake_local_variable);
2154 valcontents = XSYMBOL (variable)->value;
2157 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2159 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2161 case SYMVAL_LISP_MAGIC:
2162 if (!UNBOUNDP (maybe_call_magic_handler
2163 (variable, Qmake_local_variable, 0)))
2165 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2169 case SYMVAL_VARALIAS:
2170 variable = follow_varalias_pointers (variable, Qmake_local_variable);
2171 /* presto change-o! */
2174 case SYMVAL_FIXNUM_FORWARD:
2175 case SYMVAL_BOOLEAN_FORWARD:
2176 case SYMVAL_OBJECT_FORWARD:
2177 case SYMVAL_UNBOUND_MARKER:
2180 case SYMVAL_BUFFER_LOCAL:
2181 case SYMVAL_CURRENT_BUFFER_FORWARD:
2183 /* Make sure the symbol has a local value in this particular
2184 buffer, by setting it to the same value it already has. */
2185 Fset (variable, find_symbol_value (variable));
2189 case SYMVAL_SOME_BUFFER_LOCAL:
2191 if (!NILP (buffer_local_alist_element (current_buffer,
2193 (XSYMBOL_VALUE_BUFFER_LOCAL
2195 goto already_local_to_current_buffer;
2197 goto already_local_to_some_other_buffer;
2205 /* Make sure variable is set up to hold per-buffer values */
2206 bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
2207 &lrecord_symbol_value_buffer_local);
2208 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2210 bfwd->current_buffer = Qnil;
2211 bfwd->current_alist_element = Qnil;
2212 bfwd->current_value = valcontents;
2213 /* passing 0 is OK because this should never be a
2214 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2216 bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
2219 if (UNBOUNDP (bfwd->default_value))
2220 bfwd->default_value = Qnil; /* Yuck! */
2223 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
2224 *value_slot_past_magic (variable) = valcontents;
2226 already_local_to_some_other_buffer:
2228 /* Make sure this buffer has its own value of variable */
2229 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2231 if (UNBOUNDP (bfwd->default_value))
2233 /* If default value is unbound, set local value to nil. */
2234 XSETBUFFER (bfwd->current_buffer, current_buffer);
2235 bfwd->current_alist_element = Fcons (variable, Qnil);
2236 current_buffer->local_var_alist =
2237 Fcons (bfwd->current_alist_element, current_buffer->local_var_alist);
2238 store_symval_forwarding (variable, bfwd->current_value, Qnil);
2242 current_buffer->local_var_alist
2243 = Fcons (Fcons (variable, bfwd->default_value),
2244 current_buffer->local_var_alist);
2246 /* Make sure symbol does not think it is set up for this buffer;
2247 force it to look once again for this buffer's value */
2248 if (!NILP (bfwd->current_buffer) &&
2249 current_buffer == XBUFFER (bfwd->current_buffer))
2250 bfwd->current_buffer = Qnil;
2252 already_local_to_current_buffer:
2254 /* If the symbol forwards into a C variable, then swap in the
2255 variable for this buffer immediately. If C code modifies the
2256 variable before we swap in, then that new value will clobber the
2257 default value the next time we swap. */
2258 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2259 if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value))
2261 switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
2263 case SYMVAL_FIXNUM_FORWARD:
2264 case SYMVAL_BOOLEAN_FORWARD:
2265 case SYMVAL_OBJECT_FORWARD:
2266 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2267 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2270 case SYMVAL_UNBOUND_MARKER:
2271 case SYMVAL_CURRENT_BUFFER_FORWARD:
2282 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1,
2283 "vKill Local Variable: ", /*
2284 Make VARIABLE no longer have a separate value in the current buffer.
2285 From now on the default value will apply in this buffer.
2289 Lisp_Object valcontents;
2291 CHECK_SYMBOL (variable);
2294 valcontents = XSYMBOL (variable)->value;
2297 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2300 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2302 case SYMVAL_LISP_MAGIC:
2303 if (!UNBOUNDP (maybe_call_magic_handler
2304 (variable, Qkill_local_variable, 0)))
2306 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2310 case SYMVAL_VARALIAS:
2311 variable = follow_varalias_pointers (variable, Qkill_local_variable);
2312 /* presto change-o! */
2315 case SYMVAL_CURRENT_BUFFER_FORWARD:
2317 const struct symbol_value_forward *fwd
2318 = XSYMBOL_VALUE_FORWARD (valcontents);
2319 int offset = ((char *) symbol_value_forward_forward (fwd)
2320 - (char *) &buffer_local_flags);
2322 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2326 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2327 Lisp_Object in_object, int flags) =
2328 symbol_value_forward_magicfun (fwd);
2329 Lisp_Object oldval = * (Lisp_Object *)
2330 (offset + (char *) XBUFFER (Vbuffer_defaults));
2332 (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
2333 *(Lisp_Object *) (offset + (char *) current_buffer)
2335 current_buffer->local_var_flags &= ~mask;
2340 case SYMVAL_BUFFER_LOCAL:
2341 case SYMVAL_SOME_BUFFER_LOCAL:
2343 /* Get rid of this buffer's alist element, if any */
2344 struct symbol_value_buffer_local *bfwd
2345 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2346 Lisp_Object alist = current_buffer->local_var_alist;
2347 Lisp_Object alist_element
2348 = buffer_local_alist_element (current_buffer, variable, bfwd);
2350 if (!NILP (alist_element))
2351 current_buffer->local_var_alist = Fdelq (alist_element, alist);
2353 /* Make sure symbol does not think it is set up for this buffer;
2354 force it to look once again for this buffer's value */
2355 if (!NILP (bfwd->current_buffer) &&
2356 current_buffer == XBUFFER (bfwd->current_buffer))
2357 bfwd->current_buffer = Qnil;
2359 /* We just changed the value in the current_buffer. If this
2360 variable forwards to a C variable, we need to change the
2361 value of the C variable. set_up_buffer_local_cache()
2362 will do this. It doesn't hurt to do it always,
2363 so just go ahead and do that. */
2364 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2371 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2375 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2376 "vKill Console Local Variable: ", /*
2377 Make VARIABLE no longer have a separate value in the selected console.
2378 From now on the default value will apply in this console.
2382 Lisp_Object valcontents;
2384 CHECK_SYMBOL (variable);
2387 valcontents = XSYMBOL (variable)->value;
2390 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2393 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2395 case SYMVAL_LISP_MAGIC:
2396 if (!UNBOUNDP (maybe_call_magic_handler
2397 (variable, Qkill_console_local_variable, 0)))
2399 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2403 case SYMVAL_VARALIAS:
2404 variable = follow_varalias_pointers (variable,
2405 Qkill_console_local_variable);
2406 /* presto change-o! */
2409 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2411 const struct symbol_value_forward *fwd
2412 = XSYMBOL_VALUE_FORWARD (valcontents);
2413 int offset = ((char *) symbol_value_forward_forward (fwd)
2414 - (char *) &console_local_flags);
2416 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2420 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2421 Lisp_Object in_object, int flags) =
2422 symbol_value_forward_magicfun (fwd);
2423 Lisp_Object oldval = * (Lisp_Object *)
2424 (offset + (char *) XCONSOLE (Vconsole_defaults));
2426 magicfun (variable, &oldval, Vselected_console, 0);
2427 *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
2429 XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
2439 /* Used by specbind to determine what effects it might have. Returns:
2440 * 0 if symbol isn't buffer-local, and wouldn't be after it is set
2441 * <0 if symbol isn't presently buffer-local, but set would make it so
2442 * >0 if symbol is presently buffer-local
2445 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
2447 Lisp_Object valcontents;
2450 valcontents = XSYMBOL (symbol)->value;
2453 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2455 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2457 case SYMVAL_LISP_MAGIC:
2459 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2463 case SYMVAL_VARALIAS:
2464 symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
2465 /* presto change-o! */
2468 case SYMVAL_CURRENT_BUFFER_FORWARD:
2470 const struct symbol_value_forward *fwd
2471 = XSYMBOL_VALUE_FORWARD (valcontents);
2472 int mask = XINT (*((Lisp_Object *)
2473 symbol_value_forward_forward (fwd)));
2474 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
2475 /* Already buffer-local */
2478 /* Would be buffer-local after set */
2481 case SYMVAL_BUFFER_LOCAL:
2482 case SYMVAL_SOME_BUFFER_LOCAL:
2484 struct symbol_value_buffer_local *bfwd
2485 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2487 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
2490 /* Automatically becomes local when set */
2491 return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
2501 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2502 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2504 (symbol, buffer, unbound_value))
2507 CHECK_SYMBOL (symbol);
2508 CHECK_BUFFER (buffer);
2509 value = symbol_value_in_buffer (symbol, buffer);
2510 return UNBOUNDP (value) ? unbound_value : value;
2513 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2514 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2516 (symbol, console, unbound_value))
2519 CHECK_SYMBOL (symbol);
2520 CHECK_CONSOLE (console);
2521 value = symbol_value_in_console (symbol, console);
2522 return UNBOUNDP (value) ? unbound_value : value;
2525 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
2526 If SYMBOL is a built-in variable, return info about this; else return nil.
2527 The returned info will be a symbol, one of
2529 `object' A simple built-in variable.
2530 `const-object' Same, but cannot be set.
2531 `integer' A built-in integer variable.
2532 `const-integer' Same, but cannot be set.
2533 `boolean' A built-in boolean variable.
2534 `const-boolean' Same, but cannot be set.
2535 `const-specifier' Always contains a specifier; e.g. `has-modeline-p'.
2536 `current-buffer' A built-in buffer-local variable.
2537 `const-current-buffer' Same, but cannot be set.
2538 `default-buffer' Forwards to the default value of a built-in
2539 buffer-local variable.
2540 `selected-console' A built-in console-local variable.
2541 `const-selected-console' Same, but cannot be set.
2542 `default-console' Forwards to the default value of a built-in
2543 console-local variable.
2547 REGISTER Lisp_Object valcontents;
2549 CHECK_SYMBOL (symbol);
2552 valcontents = XSYMBOL (symbol)->value;
2555 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2558 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2560 case SYMVAL_LISP_MAGIC:
2561 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2565 case SYMVAL_VARALIAS:
2566 symbol = follow_varalias_pointers (symbol, Qt);
2567 /* presto change-o! */
2570 case SYMVAL_BUFFER_LOCAL:
2571 case SYMVAL_SOME_BUFFER_LOCAL:
2573 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value;
2577 case SYMVAL_FIXNUM_FORWARD: return Qinteger;
2578 case SYMVAL_CONST_FIXNUM_FORWARD: return Qconst_integer;
2579 case SYMVAL_BOOLEAN_FORWARD: return Qboolean;
2580 case SYMVAL_CONST_BOOLEAN_FORWARD: return Qconst_boolean;
2581 case SYMVAL_OBJECT_FORWARD: return Qobject;
2582 case SYMVAL_CONST_OBJECT_FORWARD: return Qconst_object;
2583 case SYMVAL_CONST_SPECIFIER_FORWARD: return Qconst_specifier;
2584 case SYMVAL_DEFAULT_BUFFER_FORWARD: return Qdefault_buffer;
2585 case SYMVAL_CURRENT_BUFFER_FORWARD: return Qcurrent_buffer;
2586 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: return Qconst_current_buffer;
2587 case SYMVAL_DEFAULT_CONSOLE_FORWARD: return Qdefault_console;
2588 case SYMVAL_SELECTED_CONSOLE_FORWARD: return Qselected_console;
2589 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: return Qconst_selected_console;
2590 case SYMVAL_UNBOUND_MARKER: return Qnil;
2593 abort (); return Qnil;
2598 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
2599 Return t if SYMBOL's value is local to BUFFER.
2600 If optional third arg AFTER-SET is true, return t if SYMBOL would be
2601 buffer-local after it is set, regardless of whether it is so presently.
2602 A nil value for BUFFER is *not* the same as (current-buffer), but means
2603 "no buffer". Specifically:
2605 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
2606 the variable is one of the special built-in variables that is always
2607 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
2608 `buffer-undo-list', and others.)
2610 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
2611 the variable has had `make-variable-buffer-local' applied to it.
2613 (symbol, buffer, after_set))
2617 CHECK_SYMBOL (symbol);
2620 buffer = get_buffer (buffer, 1);
2621 local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
2625 local_info = symbol_value_buffer_local_info (symbol, 0);
2628 if (NILP (after_set))
2629 return local_info > 0 ? Qt : Qnil;
2631 return local_info != 0 ? Qt : Qnil;
2636 I've gone ahead and partially implemented this because it's
2637 super-useful for dealing with the compatibility problems in supporting
2638 the old pointer-shape variables, and preventing people from `setq'ing
2639 the new variables. Any other way of handling this problem is way
2640 ugly, likely to be slow, and generally not something I want to waste
2641 my time worrying about.
2643 The interface and/or function name is sure to change before this
2644 gets into its final form. I currently like the way everything is
2645 set up and it has all the features I want it to have, except for
2646 one: I really want to be able to have multiple nested handlers,
2647 to implement an `advice'-like capability. This would allow,
2648 for example, a clean way of implementing `debug-if-set' or
2649 `debug-if-referenced' and such.
2651 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
2652 ************************************************************
2653 **Only** the `set-value', `make-unbound', and `make-local'
2654 handler types are currently implemented. Implementing the
2655 get-value and bound-predicate handlers is somewhat tricky
2656 because there are lots of subfunctions (e.g. find_symbol_value()).
2657 find_symbol_value(), in fact, is called from outside of
2658 this module. You'd have to have it do this:
2660 -- check for a `bound-predicate' handler, call that if so;
2661 if it returns nil, return Qunbound
2662 -- check for a `get-value' handler and call it and return
2665 It gets even trickier when you have to deal with
2666 sub-subfunctions like find_symbol_value_1(), and esp.
2667 when you have to properly handle variable aliases, which
2668 can lead to lots of tricky situations. So I've just
2669 punted on this, since the interface isn't officially
2670 exported and we can get by with just a `set-value'
2673 Actions in unimplemented handler types will correctly
2674 ignore any handlers, and will not fuck anything up or
2677 WARNING WARNING: If you do go and implement another
2678 type of handler, make *sure* to change
2679 would_be_magic_handled() so it knows about this,
2680 or dire things could result.
2681 ************************************************************
2682 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
2684 Real documentation is as follows.
2686 Set a magic handler for VARIABLE.
2687 This allows you to specify arbitrary behavior that results from
2688 accessing or setting a variable. For example, retrieving the
2689 variable's value might actually retrieve the first element off of
2690 a list stored in another variable, and setting the variable's value
2691 might add an element to the front of that list. (This is how the
2692 obsolete variable `unread-command-event' is implemented.)
2694 In general it is NOT good programming practice to use magic variables
2695 in a new package that you are designing. If you feel the need to
2696 do this, it's almost certainly a sign that you should be using a
2697 function instead of a variable. This facility is provided to allow
2698 a package to support obsolete variables and provide compatibility
2699 with similar packages with different variable names and semantics.
2700 By using magic handlers, you can cleanly provide obsoleteness and
2701 compatibility support and separate this support from the core
2702 routines in a package.
2704 VARIABLE should be a symbol naming the variable for which the
2705 magic behavior is provided. HANDLER-TYPE is a symbol specifying
2706 which behavior is being controlled, and HANDLER is the function
2707 that will be called to control this behavior. HARG is a
2708 value that will be passed to HANDLER but is otherwise
2709 uninterpreted. KEEP-EXISTING specifies what to do with existing
2710 handlers of the same type; nil means "erase them all", t means
2711 "keep them but insert at the beginning", the list (t) means
2712 "keep them but insert at the end", a function means "keep
2713 them but insert before the specified function", a list containing
2714 a function means "keep them but insert after the specified
2717 You can specify magic behavior for any type of variable at all,
2718 and for any handler types that are unspecified, the standard
2719 behavior applies. This allows you, for example, to use
2720 `defvaralias' in conjunction with this function. (For that
2721 matter, `defvaralias' could be implemented using this function.)
2723 The behaviors that can be specified in HANDLER-TYPE are
2725 get-value (SYM ARGS FUN HARG HANDLERS)
2726 This means that one of the functions `symbol-value',
2727 `default-value', `symbol-value-in-buffer', or
2728 `symbol-value-in-console' was called on SYM.
2730 set-value (SYM ARGS FUN HARG HANDLERS)
2731 This means that one of the functions `set' or `set-default'
2734 bound-predicate (SYM ARGS FUN HARG HANDLERS)
2735 This means that one of the functions `boundp', `globally-boundp',
2736 or `default-boundp' was called on SYM.
2738 make-unbound (SYM ARGS FUN HARG HANDLERS)
2739 This means that the function `makunbound' was called on SYM.
2741 local-predicate (SYM ARGS FUN HARG HANDLERS)
2742 This means that the function `local-variable-p' was called
2745 make-local (SYM ARGS FUN HARG HANDLERS)
2746 This means that one of the functions `make-local-variable',
2747 `make-variable-buffer-local', `kill-local-variable',
2748 or `kill-console-local-variable' was called on SYM.
2750 The meanings of the arguments are as follows:
2752 SYM is the symbol on which the function was called, and is always
2753 the first argument to the function.
2755 ARGS are the remaining arguments in the original call (i.e. all
2756 but the first). In the case of `set-value' in particular,
2757 the first element of ARGS is the value to which the variable
2758 is being set. In some cases, ARGS is sanitized from what was
2759 actually given. For example, whenever `nil' is passed to an
2760 argument and it means `current-buffer', the current buffer is
2761 substituted instead.
2763 FUN is a symbol indicating which function is being called.
2764 For many of the functions, you can determine the corresponding
2765 function of a different class using
2766 `symbol-function-corresponding-function'.
2768 HARG is the argument that was given in the call
2769 to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
2771 HANDLERS is a structure containing the remaining handlers
2772 for the variable; to call one of them, use
2773 `chain-to-symbol-value-handler'.
2775 NOTE: You may *not* modify the list in ARGS, and if you want to
2776 keep it around after the handler function exits, you must make
2777 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
2780 static enum lisp_magic_handler
2781 decode_magic_handler_type (Lisp_Object symbol)
2783 if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE;
2784 if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE;
2785 if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE;
2786 if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND;
2787 if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE;
2788 if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL;
2790 signal_simple_error ("Unrecognized symbol value handler type", symbol);
2792 return MAGIC_HANDLER_MAX;
2795 static enum lisp_magic_handler
2796 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
2798 if (EQ (funsym, Qsymbol_value)
2799 || EQ (funsym, Qdefault_value)
2800 || EQ (funsym, Qsymbol_value_in_buffer)
2801 || EQ (funsym, Qsymbol_value_in_console))
2802 return MAGIC_HANDLER_GET_VALUE;
2804 if (EQ (funsym, Qset)
2805 || EQ (funsym, Qset_default))
2806 return MAGIC_HANDLER_SET_VALUE;
2808 if (EQ (funsym, Qboundp)
2809 || EQ (funsym, Qglobally_boundp)
2810 || EQ (funsym, Qdefault_boundp))
2811 return MAGIC_HANDLER_BOUND_PREDICATE;
2813 if (EQ (funsym, Qmakunbound))
2814 return MAGIC_HANDLER_MAKE_UNBOUND;
2816 if (EQ (funsym, Qlocal_variable_p))
2817 return MAGIC_HANDLER_LOCAL_PREDICATE;
2819 if (EQ (funsym, Qmake_variable_buffer_local)
2820 || EQ (funsym, Qmake_local_variable))
2821 return MAGIC_HANDLER_MAKE_LOCAL;
2823 if (abort_if_not_found)
2825 signal_simple_error ("Unrecognized symbol-value function", funsym);
2826 return MAGIC_HANDLER_MAX;
2830 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
2832 /* does not take into account variable aliasing. */
2833 Lisp_Object valcontents = XSYMBOL (sym)->value;
2834 enum lisp_magic_handler slot;
2836 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2838 slot = handler_type_from_function_symbol (funsym, 1);
2839 if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND
2840 && slot != MAGIC_HANDLER_MAKE_LOCAL)
2841 /* #### temporary kludge because we haven't implemented
2842 lisp-magic variables completely */
2844 return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
2848 fetch_value_maybe_past_magic (Lisp_Object sym,
2849 Lisp_Object follow_past_lisp_magic)
2851 Lisp_Object value = XSYMBOL (sym)->value;
2852 if (SYMBOL_VALUE_LISP_MAGIC_P (value)
2853 && (EQ (follow_past_lisp_magic, Qt)
2854 || (!NILP (follow_past_lisp_magic)
2855 && !would_be_magic_handled (sym, follow_past_lisp_magic))))
2856 value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed;
2860 static Lisp_Object *
2861 value_slot_past_magic (Lisp_Object sym)
2863 Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
2865 if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
2866 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
2867 return store_pointer;
2871 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
2874 Lisp_Object args[20]; /* should be enough ... */
2876 enum lisp_magic_handler htype;
2877 Lisp_Object legerdemain;
2878 struct symbol_value_lisp_magic *bfwd;
2880 assert (nargs >= 0 && nargs < countof (args));
2881 legerdemain = XSYMBOL (sym)->value;
2882 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2883 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2885 va_start (vargs, nargs);
2886 for (i = 0; i < nargs; i++)
2887 args[i] = va_arg (vargs, Lisp_Object);
2890 htype = handler_type_from_function_symbol (funsym, 1);
2891 if (NILP (bfwd->handler[htype]))
2893 /* #### should be reusing the arglist, not always consing anew.
2894 Repeated handler invocations should not cause repeated consing.
2895 Doesn't matter for now, because this is just a quick implementation
2896 for obsolescence support. */
2897 return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym,
2898 bfwd->harg[htype], Qnil);
2901 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
2903 Don't you dare use this.
2904 If you do, suffer the wrath of Ben, who is likely to rename
2905 this function (or change the semantics of its arguments) without
2906 pity, thereby invalidating your code.
2908 (variable, handler_type, handler, harg, keep_existing))
2910 Lisp_Object valcontents;
2911 struct symbol_value_lisp_magic *bfwd;
2912 enum lisp_magic_handler htype;
2915 /* #### WARNING, only some handler types are implemented. See above.
2916 Actions of other types will ignore a handler if it's there.
2918 #### Also, `chain-to-symbol-value-handler' and
2919 `symbol-function-corresponding-function' are not implemented. */
2920 CHECK_SYMBOL (variable);
2921 CHECK_SYMBOL (handler_type);
2922 htype = decode_magic_handler_type (handler_type);
2923 valcontents = XSYMBOL (variable)->value;
2924 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2926 bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
2927 &lrecord_symbol_value_lisp_magic);
2928 bfwd->magic.type = SYMVAL_LISP_MAGIC;
2929 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2931 bfwd->handler[i] = Qnil;
2932 bfwd->harg[i] = Qnil;
2934 bfwd->shadowed = valcontents;
2935 XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
2938 bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
2939 bfwd->handler[htype] = handler;
2940 bfwd->harg[htype] = harg;
2942 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2943 if (!NILP (bfwd->handler[i]))
2946 if (i == MAGIC_HANDLER_MAX)
2947 /* there are no remaining handlers, so remove the structure. */
2948 XSYMBOL (variable)->value = bfwd->shadowed;
2954 /* functions for working with variable aliases. */
2956 /* Follow the chain of variable aliases for SYMBOL. Return the
2957 resulting symbol, whose value cell is guaranteed not to be a
2958 symbol-value-varalias.
2960 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
2961 If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
2962 never follow; stop right there. Otherwise FUNSYM should be a
2963 recognized symbol-value function symbol; this means, follow
2964 unless there is a special handler for the named function.
2966 OK, there is at least one reason why it's necessary for
2967 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
2968 can always be sure to catch cyclic variable aliasing. If we never
2969 follow past Lisp magic, then if the following is done:
2972 add some magic behavior to a, but not a "get-value" handler
2975 then an attempt to retrieve a's or b's value would cause infinite
2976 looping in `symbol-value'.
2978 We (of course) can't always follow past Lisp magic, because then
2979 we make any variable that is lisp-magic -> varalias behave as if
2980 the lisp-magic is not present at all.
2984 follow_varalias_pointers (Lisp_Object symbol,
2985 Lisp_Object follow_past_lisp_magic)
2987 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
2988 Lisp_Object tortoise, hare, val;
2991 /* quick out just in case */
2992 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value))
2995 /* Compare implementation of indirect_function(). */
2996 for (hare = tortoise = symbol, count = 0;
2997 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic),
2998 SYMBOL_VALUE_VARALIAS_P (val);
2999 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)),
3002 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue;
3005 tortoise = symbol_value_varalias_aliasee
3006 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic
3007 (tortoise, follow_past_lisp_magic)));
3008 if (EQ (hare, tortoise))
3009 return Fsignal (Qcyclic_variable_indirection, list1 (symbol));
3015 DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
3016 Define a variable as an alias for another variable.
3017 Thenceforth, any operations performed on VARIABLE will actually be
3018 performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
3019 If ALIAS is nil, remove any aliases for VARIABLE.
3020 ALIAS can itself be aliased, and the chain of variable aliases
3021 will be followed appropriately.
3022 If VARIABLE already has a value, this value will be shadowed
3023 until the alias is removed, at which point it will be restored.
3024 Currently VARIABLE cannot be a built-in variable, a variable that
3025 has a buffer-local value in any buffer, or the symbols nil or t.
3026 \(ALIAS, however, can be any type of variable.)
3030 struct symbol_value_varalias *bfwd;
3031 Lisp_Object valcontents;
3033 CHECK_SYMBOL (variable);
3034 reject_constant_symbols (variable, Qunbound, 0, Qt);
3036 valcontents = XSYMBOL (variable)->value;
3040 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3042 XSYMBOL (variable)->value =
3043 symbol_value_varalias_shadowed
3044 (XSYMBOL_VALUE_VARALIAS (valcontents));
3049 CHECK_SYMBOL (alias);
3050 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3053 XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
3057 if (SYMBOL_VALUE_MAGIC_P (valcontents)
3058 && !UNBOUNDP (valcontents))
3059 signal_simple_error ("Variable is magic and cannot be aliased", variable);
3060 reject_constant_symbols (variable, Qunbound, 0, Qt);
3062 bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
3063 &lrecord_symbol_value_varalias);
3064 bfwd->magic.type = SYMVAL_VARALIAS;
3065 bfwd->aliasee = alias;
3066 bfwd->shadowed = valcontents;
3068 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
3069 XSYMBOL (variable)->value = valcontents;
3073 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
3074 If VARIABLE is aliased to another variable, return that variable.
3075 VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
3076 Variable aliases are created with `defvaralias'. See also
3077 `indirect-variable'.
3079 (variable, follow_past_lisp_magic))
3081 Lisp_Object valcontents;
3083 CHECK_SYMBOL (variable);
3084 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3086 CHECK_SYMBOL (follow_past_lisp_magic);
3087 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3090 valcontents = fetch_value_maybe_past_magic (variable,
3091 follow_past_lisp_magic);
3093 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3094 return symbol_value_varalias_aliasee
3095 (XSYMBOL_VALUE_VARALIAS (valcontents));
3100 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /*
3101 Return the variable at the end of OBJECT's variable-alias chain.
3102 If OBJECT is a symbol, follow all variable aliases and return
3103 the final (non-aliased) symbol. Variable aliases are created with
3104 the function `defvaralias'.
3105 If OBJECT is not a symbol, just return it.
3106 Signal a cyclic-variable-indirection error if there is a loop in the
3107 variable chain of symbols.
3109 (object, follow_past_lisp_magic))
3111 if (!SYMBOLP (object))
3113 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3115 CHECK_SYMBOL (follow_past_lisp_magic);
3116 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3118 return follow_varalias_pointers (object, follow_past_lisp_magic);
3122 /************************************************************************/
3123 /* initialization */
3124 /************************************************************************/
3126 /* A dumped XEmacs image has a lot more than 1511 symbols. Last
3127 estimate was that there were actually around 6300. So let's try
3128 making this bigger and see if we get better hashing behavior. */
3129 #define OBARRAY_SIZE 16411
3134 #ifndef Qnull_pointer
3135 Lisp_Object Qnull_pointer;
3138 /* some losing systems can't have static vars at function scope... */
3139 static const struct symbol_value_magic guts_of_unbound_marker =
3140 { /* struct symbol_value_magic */
3141 { /* struct lcrecord_header */
3142 { /* struct lrecord_header */
3143 lrecord_type_symbol_value_forward, /* lrecord_type_index */
3145 1, /* c_readonly bit */
3146 1, /* lisp_readonly bit */
3153 SYMVAL_UNBOUND_MARKER
3157 init_symbols_once_early (void)
3159 INIT_LRECORD_IMPLEMENTATION (symbol);
3160 INIT_LRECORD_IMPLEMENTATION (symbol_value_forward);
3161 INIT_LRECORD_IMPLEMENTATION (symbol_value_buffer_local);
3162 INIT_LRECORD_IMPLEMENTATION (symbol_value_lisp_magic);
3163 INIT_LRECORD_IMPLEMENTATION (symbol_value_varalias);
3165 reinit_symbols_once_early ();
3167 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3168 called the first time. */
3169 Qnil = Fmake_symbol (make_string_nocopy ((const Bufbyte *) "nil", 3));
3170 XSYMBOL (Qnil)->name->plist = Qnil;
3171 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
3172 XSYMBOL (Qnil)->plist = Qnil;
3174 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3175 initial_obarray = Vobarray;
3176 staticpro (&initial_obarray);
3177 /* Intern nil in the obarray */
3179 int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
3180 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3184 /* Required to get around a GCC syntax error on certain
3186 const struct symbol_value_magic *tem = &guts_of_unbound_marker;
3188 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3191 XSYMBOL (Qnil)->function = Qunbound;
3193 defsymbol (&Qt, "t");
3194 XSYMBOL (Qt)->value = Qt; /* Veritas aetera */
3198 pdump_wire (&Qunbound);
3199 pdump_wire (&Vquit_flag);
3203 reinit_symbols_once_early (void)
3206 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3209 #ifndef Qnull_pointer
3210 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3211 so the following is actually a no-op. */
3212 XSETOBJ (Qnull_pointer, 0);
3217 defsymbol_massage_name_1 (Lisp_Object *location, const char *name, int dump_p,
3218 int multiword_predicate_p)
3221 int len = strlen (name) - 1;
3224 if (multiword_predicate_p)
3225 assert (len + 1 < sizeof (temp));
3227 assert (len < sizeof (temp));
3228 strcpy (temp, name + 1); /* Remove initial Q */
3229 if (multiword_predicate_p)
3231 strcpy (temp + len - 1, "_p");
3234 for (i = 0; i < len; i++)
3237 *location = Fintern (make_string ((const Bufbyte *) temp, len), Qnil);
3239 staticpro (location);
3241 staticpro_nodump (location);
3245 defsymbol_massage_name_nodump (Lisp_Object *location, const char *name)
3247 defsymbol_massage_name_1 (location, name, 0, 0);
3251 defsymbol_massage_name (Lisp_Object *location, const char *name)
3253 defsymbol_massage_name_1 (location, name, 1, 0);
3257 defsymbol_massage_multiword_predicate_nodump (Lisp_Object *location,
3260 defsymbol_massage_name_1 (location, name, 0, 1);
3264 defsymbol_massage_multiword_predicate (Lisp_Object *location, const char *name)
3266 defsymbol_massage_name_1 (location, name, 1, 1);
3270 defsymbol_nodump (Lisp_Object *location, const char *name)
3272 *location = Fintern (make_string_nocopy ((const Bufbyte *) name,
3275 staticpro_nodump (location);
3279 defsymbol (Lisp_Object *location, const char *name)
3281 *location = Fintern (make_string_nocopy ((const Bufbyte *) name,
3284 staticpro (location);
3288 defkeyword (Lisp_Object *location, const char *name)
3290 defsymbol (location, name);
3291 Fset (*location, *location);
3295 defkeyword_massage_name (Lisp_Object *location, const char *name)
3298 int len = strlen (name);
3300 assert (len < sizeof (temp));
3301 strcpy (temp, name);
3302 temp[1] = ':'; /* it's an underscore in the C variable */
3304 defsymbol_massage_name (location, temp);
3305 Fset (*location, *location);
3309 /* Check that nobody spazzed writing a DEFUN. */
3311 check_sane_subr (Lisp_Subr *subr, Lisp_Object sym)
3313 assert (subr->min_args >= 0);
3314 assert (subr->min_args <= SUBR_MAX_ARGS);
3316 if (subr->max_args != MANY &&
3317 subr->max_args != UNEVALLED)
3319 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3320 assert (subr->max_args <= SUBR_MAX_ARGS);
3321 assert (subr->min_args <= subr->max_args);
3324 assert (UNBOUNDP (XSYMBOL (sym)->function));
3327 #define check_sane_subr(subr, sym) /* nothing */
3332 * If we are not in a pure undumped Emacs, we need to make a duplicate of
3333 * the subr. This is because the only time this function will be called
3334 * in a running Emacs is when a dynamically loaded module is adding a
3335 * subr, and we need to make sure that the subr is in allocated, Lisp-
3336 * accessible memory. The address assigned to the static subr struct
3337 * in the shared object will be a trampoline address, so we need to create
3338 * a copy here to ensure that a real address is used.
3340 * Once we have copied everything across, we re-use the original static
3341 * structure to store a pointer to the newly allocated one. This will be
3342 * used in emodules.c by emodules_doc_subr() to find a pointer to the
3343 * allocated object so that we can set its doc string properly.
3345 * NOTE: We don't actually use the DOC pointer here any more, but we did
3346 * in an earlier implementation of module support. There is no harm in
3347 * setting it here in case we ever need it in future implementations.
3348 * subr->doc will point to the new subr structure that was allocated.
3349 * Code can then get this value from the static subr structure and use
3352 * FIXME: Should newsubr be staticpro()'ed? I don't think so but I need
3355 #define check_module_subr() \
3357 if (initialized) { \
3358 Lisp_Subr *newsubr = (Lisp_Subr *) xmalloc (sizeof (Lisp_Subr)); \
3359 memcpy (newsubr, subr, sizeof (Lisp_Subr)); \
3360 subr->doc = (const char *)newsubr; \
3364 #else /* ! HAVE_SHLIB */
3365 #define check_module_subr()
3369 defsubr (Lisp_Subr *subr)
3371 Lisp_Object sym = intern (subr_name (subr));
3374 check_sane_subr (subr, sym);
3375 check_module_subr ();
3377 XSETSUBR (fun, subr);
3378 XSYMBOL (sym)->function = fun;
3381 /* Define a lisp macro using a Lisp_Subr. */
3383 defsubr_macro (Lisp_Subr *subr)
3385 Lisp_Object sym = intern (subr_name (subr));
3388 check_sane_subr (subr, sym);
3389 check_module_subr();
3391 XSETSUBR (fun, subr);
3392 XSYMBOL (sym)->function = Fcons (Qmacro, fun);
3396 deferror_1 (Lisp_Object *symbol, const char *name, const char *messuhhj,
3397 Lisp_Object inherits_from, int massage_p)
3401 defsymbol_massage_name (symbol, name);
3403 defsymbol (symbol, name);
3405 assert (SYMBOLP (inherits_from));
3406 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3407 Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3408 /* NOT build_translated_string (). This function is called at load time
3409 and the string needs to get translated at run time. (This happens
3410 in the function (display-error) in cmdloop.el.) */
3411 Fput (*symbol, Qerror_message, build_string (messuhhj));
3415 deferror (Lisp_Object *symbol, const char *name, const char *messuhhj,
3416 Lisp_Object inherits_from)
3418 deferror_1 (symbol, name, messuhhj, inherits_from, 0);
3422 deferror_massage_name (Lisp_Object *symbol, const char *name,
3423 const char *messuhhj, Lisp_Object inherits_from)
3425 deferror_1 (symbol, name, messuhhj, inherits_from, 1);
3429 deferror_massage_name_and_message (Lisp_Object *symbol, const char *name,
3430 Lisp_Object inherits_from)
3434 int len = strlen (name) - 1;
3436 assert (len < sizeof (temp));
3437 strcpy (temp, name + 1); /* Remove initial Q */
3438 temp[0] = toupper (temp[0]);
3439 for (i = 0; i < len; i++)
3443 deferror_1 (symbol, name, temp, inherits_from, 1);
3447 syms_of_symbols (void)
3449 DEFSYMBOL (Qvariable_documentation);
3450 DEFSYMBOL (Qvariable_domain); /* I18N3 */
3451 DEFSYMBOL (Qad_advice_info);
3452 DEFSYMBOL (Qad_activate);
3454 DEFSYMBOL (Qget_value);
3455 DEFSYMBOL (Qset_value);
3456 DEFSYMBOL (Qbound_predicate);
3457 DEFSYMBOL (Qmake_unbound);
3458 DEFSYMBOL (Qlocal_predicate);
3459 DEFSYMBOL (Qmake_local);
3461 DEFSYMBOL (Qboundp);
3462 DEFSYMBOL (Qglobally_boundp);
3463 DEFSYMBOL (Qmakunbound);
3464 DEFSYMBOL (Qsymbol_value);
3466 DEFSYMBOL (Qsetq_default);
3467 DEFSYMBOL (Qdefault_boundp);
3468 DEFSYMBOL (Qdefault_value);
3469 DEFSYMBOL (Qset_default);
3470 DEFSYMBOL (Qmake_variable_buffer_local);
3471 DEFSYMBOL (Qmake_local_variable);
3472 DEFSYMBOL (Qkill_local_variable);
3473 DEFSYMBOL (Qkill_console_local_variable);
3474 DEFSYMBOL (Qsymbol_value_in_buffer);
3475 DEFSYMBOL (Qsymbol_value_in_console);
3476 DEFSYMBOL (Qlocal_variable_p);
3478 DEFSYMBOL (Qconst_integer);
3479 DEFSYMBOL (Qconst_boolean);
3480 DEFSYMBOL (Qconst_object);
3481 DEFSYMBOL (Qconst_specifier);
3482 DEFSYMBOL (Qdefault_buffer);
3483 DEFSYMBOL (Qcurrent_buffer);
3484 DEFSYMBOL (Qconst_current_buffer);
3485 DEFSYMBOL (Qdefault_console);
3486 DEFSYMBOL (Qselected_console);
3487 DEFSYMBOL (Qconst_selected_console);
3490 DEFSUBR (Fintern_soft);
3491 DEFSUBR (Funintern);
3492 DEFSUBR (Fmapatoms);
3493 DEFSUBR (Fapropos_internal);
3495 DEFSUBR (Fsymbol_function);
3496 DEFSUBR (Fsymbol_plist);
3497 DEFSUBR (Fsymbol_name);
3498 DEFSUBR (Fmakunbound);
3499 DEFSUBR (Ffmakunbound);
3501 DEFSUBR (Fglobally_boundp);
3504 DEFSUBR (Fdefine_function);
3505 Ffset (intern ("defalias"), intern ("define-function"));
3506 DEFSUBR (Fsetplist);
3507 DEFSUBR (Fsymbol_value_in_buffer);
3508 DEFSUBR (Fsymbol_value_in_console);
3509 DEFSUBR (Fbuilt_in_variable_type);
3510 DEFSUBR (Fsymbol_value);
3512 DEFSUBR (Fdefault_boundp);
3513 DEFSUBR (Fdefault_value);
3514 DEFSUBR (Fset_default);
3515 DEFSUBR (Fsetq_default);
3516 DEFSUBR (Fmake_variable_buffer_local);
3517 DEFSUBR (Fmake_local_variable);
3518 DEFSUBR (Fkill_local_variable);
3519 DEFSUBR (Fkill_console_local_variable);
3520 DEFSUBR (Flocal_variable_p);
3521 DEFSUBR (Fdefvaralias);
3522 DEFSUBR (Fvariable_alias);
3523 DEFSUBR (Findirect_variable);
3524 DEFSUBR (Fdontusethis_set_symbol_value_handler);
3527 /* Create and initialize a Lisp variable whose value is forwarded to C data */
3529 defvar_magic (const char *symbol_name, const struct symbol_value_forward *magic)
3533 #if defined(HAVE_SHLIB)
3535 * As with defsubr(), this will only be called in a dumped Emacs when
3536 * we are adding variables from a dynamically loaded module. That means
3537 * we can't use purespace. Take that into account.
3540 sym = Fintern (build_string (symbol_name), Qnil);
3543 sym = Fintern (make_string_nocopy ((const Bufbyte *) symbol_name,
3544 strlen (symbol_name)), Qnil);
3546 XSETOBJ (XSYMBOL (sym)->value, magic);
3550 vars_of_symbols (void)
3552 DEFVAR_LISP ("obarray", &Vobarray /*
3553 Symbol table for use by `intern' and `read'.
3554 It is a vector whose length ought to be prime for best results.
3555 The vector's contents don't make sense if examined from Lisp programs;
3556 to find all the symbols in an obarray, use `mapatoms'.
3558 /* obarray has been initialized long before */