1 /* "intern" and friends -- moved here from lread.c and data.c
2 Copyright (C) 1985-1989, 1992-1994 Free Software Foundation, Inc.
3 Copyright (C) 1995 Ben Wing.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: FSF 19.30. */
24 /* This file has been Mule-ized. */
28 The value cell of a symbol can contain a simple value or one of
29 various symbol-value-magic objects. Some of these objects can
30 chain into other kinds of objects. Here is a table of possibilities:
34 1c) symbol-value-forward, excluding Qunbound
35 2) symbol-value-buffer-local -> 1a or 1b or 1c
36 3) symbol-value-lisp-magic -> 1a or 1b or 1c
37 4) symbol-value-lisp-magic -> symbol-value-buffer-local -> 1a or 1b or 1c
38 5) symbol-value-varalias
39 6) symbol-value-lisp-magic -> symbol-value-varalias
41 The "chain" of a symbol-value-buffer-local is its current_value slot.
43 The "chain" of a symbol-value-lisp-magic is its shadowed slot, which
44 applies for handler types without associated handlers.
46 All other fields in all the structures (including the "shadowed" slot
47 in a symbol-value-varalias) can *only* contain a simple value or Qunbound.
51 /* #### Ugh, though, this file does awful things with symbol-value-magic
52 objects. This ought to be cleaned up. */
57 #include "buffer.h" /* for Vbuffer_defaults */
61 Lisp_Object Qad_advice_info, Qad_activate;
63 Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound;
64 Lisp_Object Qlocal_predicate, Qmake_local;
66 Lisp_Object Qboundp, Qglobally_boundp, Qmakunbound;
67 Lisp_Object Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value;
68 Lisp_Object Qset_default, Qsetq_default;
69 Lisp_Object Qmake_variable_buffer_local, Qmake_local_variable;
70 Lisp_Object Qkill_local_variable, Qkill_console_local_variable;
71 Lisp_Object Qsymbol_value_in_buffer, Qsymbol_value_in_console;
72 Lisp_Object Qlocal_variable_p;
74 Lisp_Object Qconst_integer, Qconst_boolean, Qconst_object;
75 Lisp_Object Qconst_specifier;
76 Lisp_Object Qdefault_buffer, Qcurrent_buffer, Qconst_current_buffer;
77 Lisp_Object Qdefault_console, Qselected_console, Qconst_selected_console;
79 static Lisp_Object maybe_call_magic_handler (Lisp_Object sym,
82 static Lisp_Object fetch_value_maybe_past_magic (Lisp_Object sym,
83 Lisp_Object follow_past_lisp_magic);
84 static Lisp_Object *value_slot_past_magic (Lisp_Object sym);
85 static Lisp_Object follow_varalias_pointers (Lisp_Object symbol,
86 Lisp_Object follow_past_lisp_magic);
90 mark_symbol (Lisp_Object obj)
92 Lisp_Symbol *sym = XSYMBOL (obj);
95 mark_object (sym->value);
96 mark_object (sym->function);
97 XSETSTRING (pname, sym->name);
99 if (!symbol_next (sym))
103 mark_object (sym->plist);
104 /* Mark the rest of the symbols in the obarray hash-chain */
105 sym = symbol_next (sym);
106 XSETSYMBOL (obj, sym);
111 static const struct lrecord_description symbol_description[] = {
112 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, next) },
113 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, name) },
114 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, value) },
115 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, function) },
116 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, plist) },
120 /* 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'.
454 obarray = check_obarray (obarray);
456 map_obarray (obarray, mapatoms_1, &function);
461 /**********************************************************************/
463 /**********************************************************************/
465 struct appropos_mapper_closure
468 Lisp_Object predicate;
469 Lisp_Object accumulation;
473 apropos_mapper (Lisp_Object symbol, void *arg)
475 struct appropos_mapper_closure *closure =
476 (struct appropos_mapper_closure *) arg;
477 Bytecount match = fast_lisp_string_match (closure->regexp,
478 Fsymbol_name (symbol));
481 (NILP (closure->predicate) ||
482 !NILP (call1 (closure->predicate, symbol))))
483 closure->accumulation = Fcons (symbol, closure->accumulation);
488 DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /*
489 Show all symbols whose names contain match for REGEXP.
490 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL)
491 is done for each symbol and a symbol is mentioned only if that
493 Return list of symbols found.
497 struct appropos_mapper_closure closure;
499 CHECK_STRING (regexp);
501 closure.regexp = regexp;
502 closure.predicate = predicate;
503 closure.accumulation = Qnil;
504 map_obarray (Vobarray, apropos_mapper, &closure);
505 closure.accumulation = Fsort (closure.accumulation, Qstring_lessp);
506 return closure.accumulation;
510 /* Extract and set components of symbols */
512 static void set_up_buffer_local_cache (Lisp_Object sym,
513 struct symbol_value_buffer_local *bfwd,
515 Lisp_Object new_alist_el,
518 DEFUN ("boundp", Fboundp, 1, 1, 0, /*
519 Return t if SYMBOL's value is not void.
523 CHECK_SYMBOL (symbol);
524 return UNBOUNDP (find_symbol_value (symbol)) ? Qnil : Qt;
527 DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /*
528 Return t if SYMBOL has a global (non-bound) value.
529 This is for the byte-compiler; you really shouldn't be using this.
533 CHECK_SYMBOL (symbol);
534 return UNBOUNDP (top_level_value (symbol)) ? Qnil : Qt;
537 DEFUN ("fboundp", Ffboundp, 1, 1, 0, /*
538 Return t if SYMBOL's function definition is not void.
542 CHECK_SYMBOL (symbol);
543 return UNBOUNDP (XSYMBOL (symbol)->function) ? Qnil : Qt;
546 /* Return non-zero if SYM's value or function (the current contents of
547 which should be passed in as VAL) is constant, i.e. unsettable. */
550 symbol_is_constant (Lisp_Object sym, Lisp_Object val)
552 /* #### - I wonder if it would be better to just have a new magic value
553 type and make nil, t, and all keywords have that same magic
554 constant_symbol value. This test is awfully specific about what is
555 constant and what isn't. --Stig */
556 if (EQ (sym, Qnil) ||
560 if (SYMBOL_VALUE_MAGIC_P (val))
561 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
563 case SYMVAL_CONST_OBJECT_FORWARD:
564 case SYMVAL_CONST_SPECIFIER_FORWARD:
565 case SYMVAL_CONST_FIXNUM_FORWARD:
566 case SYMVAL_CONST_BOOLEAN_FORWARD:
567 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
568 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
570 default: break; /* Warning suppression */
573 /* We don't return true for keywords here because they are handled
574 specially by reject_constant_symbols(). */
578 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
579 non-zero) to NEWVAL. Make sure this is allowed.
580 FOLLOW_PAST_LISP_MAGIC specifies whether we delve past
581 symbol-value-lisp-magic objects. */
584 reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p,
585 Lisp_Object follow_past_lisp_magic)
588 (function_p ? XSYMBOL (sym)->function
589 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
591 if (SYMBOL_VALUE_MAGIC_P (val) &&
592 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
593 signal_simple_error ("Use `set-specifier' to change a specifier's value",
596 if (symbol_is_constant (sym, val)
597 || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)))
598 signal_error (Qsetting_constant,
599 UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
602 /* Verify that it's ok to make SYM buffer-local. This rejects
603 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC
604 specifies whether we delve into symbol-value-lisp-magic objects.
605 (Should be a symbol indicating what action is being taken; that way,
606 we don't delve if there's a handler for that action, but do otherwise.) */
609 verify_ok_for_buffer_local (Lisp_Object sym,
610 Lisp_Object follow_past_lisp_magic)
612 Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic);
614 if (symbol_is_constant (sym, val))
616 if (SYMBOL_VALUE_MAGIC_P (val))
617 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
619 case SYMVAL_DEFAULT_BUFFER_FORWARD:
620 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
621 /* #### It's theoretically possible for it to be reasonable
622 to have both console-local and buffer-local variables,
623 but I don't want to consider that right now. */
624 case SYMVAL_SELECTED_CONSOLE_FORWARD:
626 default: break; /* Warning suppression */
632 signal_error (Qerror,
633 list2 (build_string ("Symbol may not be buffer-local"), sym));
636 DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /*
637 Make SYMBOL's value be void.
641 Fset (symbol, Qunbound);
645 DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /*
646 Make SYMBOL's function definition be void.
650 CHECK_SYMBOL (symbol);
651 reject_constant_symbols (symbol, Qunbound, 1, Qt);
652 XSYMBOL (symbol)->function = Qunbound;
656 DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /*
657 Return SYMBOL's function definition. Error if that is void.
661 CHECK_SYMBOL (symbol);
662 if (UNBOUNDP (XSYMBOL (symbol)->function))
663 signal_void_function_error (symbol);
664 return XSYMBOL (symbol)->function;
667 DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /*
668 Return SYMBOL's property list.
672 CHECK_SYMBOL (symbol);
673 return XSYMBOL (symbol)->plist;
676 DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /*
677 Return SYMBOL's name, a string.
683 CHECK_SYMBOL (symbol);
684 XSETSTRING (name, XSYMBOL (symbol)->name);
688 DEFUN ("fset", Ffset, 2, 2, 0, /*
689 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
693 /* This function can GC */
694 CHECK_SYMBOL (symbol);
695 reject_constant_symbols (symbol, newdef, 1, Qt);
696 if (!NILP (Vautoload_queue) && !UNBOUNDP (XSYMBOL (symbol)->function))
697 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
699 XSYMBOL (symbol)->function = newdef;
700 /* Handle automatic advice activation */
701 if (CONSP (XSYMBOL (symbol)->plist) &&
702 !NILP (Fget (symbol, Qad_advice_info, Qnil)))
704 call2 (Qad_activate, symbol, Qnil);
705 newdef = XSYMBOL (symbol)->function;
711 DEFUN ("define-function", Fdefine_function, 2, 2, 0, /*
712 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
713 Associates the function with the current load file, if any.
717 /* This function can GC */
718 Ffset (symbol, newdef);
719 LOADHIST_ATTACH (symbol);
724 DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
725 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
729 CHECK_SYMBOL (symbol);
730 #if 0 /* Inserted for debugging 6/28/1997 -slb */
731 /* Somebody is setting a property list of integer 0, who? */
732 /* Not this way apparently. */
733 if (EQ(newplist, Qzero)) abort();
736 XSYMBOL (symbol)->plist = newplist;
741 /**********************************************************************/
743 /**********************************************************************/
745 /* If the contents of the value cell of a symbol is one of the following
746 three types of objects, then the symbol is "magic" in that setting
747 and retrieving its value doesn't just set or retrieve the raw
748 contents of the value cell. None of these objects can escape to
749 the user level, so there is no loss of generality.
751 If a symbol is "unbound", then the contents of its value cell is
752 Qunbound. Despite appearances, this is *not* a symbol, but is a
753 symbol-value-forward object. This is so that printing it results
754 in "INTERNAL OBJECT (XEmacs bug?)", in case it leaks to Lisp, somehow.
756 Logically all of the following objects are "symbol-value-magic"
757 objects, and there are some games played w.r.t. this (#### this
758 should be cleaned up). SYMBOL_VALUE_MAGIC_P is true for all of
759 the object types. XSYMBOL_VALUE_MAGIC_TYPE returns the type of
760 symbol-value-magic object. There are more than three types
761 returned by this macro: in particular, symbol-value-forward
762 has eight subtypes, and symbol-value-buffer-local has two. See
765 1. symbol-value-forward
767 symbol-value-forward is used for variables whose actual contents
768 are stored in a C variable of some sort, and for Qunbound. The
769 lcheader.next field (which is only used to chain together free
770 lcrecords) holds a pointer to the actual C variable. Included
771 in this type are "buffer-local" variables that are actually
772 stored in the buffer object itself; in this case, the "pointer"
773 is an offset into the struct buffer structure.
775 The subtypes are as follows:
777 SYMVAL_OBJECT_FORWARD:
778 (declare with DEFVAR_LISP)
779 The value of this variable is stored in a C variable of type
780 "Lisp_Object". Setting this variable sets the C variable.
781 Accessing this variable retrieves a value from the C variable.
782 These variables can be buffer-local -- in this case, the
783 raw symbol-value field gets converted into a
784 symbol-value-buffer-local, whose "current_value" slot contains
785 the symbol-value-forward. (See below.)
787 SYMVAL_FIXNUM_FORWARD:
788 SYMVAL_BOOLEAN_FORWARD:
789 (declare with DEFVAR_INT or DEFVAR_BOOL)
790 Similar to SYMVAL_OBJECT_FORWARD except that the C variable
791 is of type "int" and is an integer or boolean, respectively.
793 SYMVAL_CONST_OBJECT_FORWARD:
794 SYMVAL_CONST_FIXNUM_FORWARD:
795 SYMVAL_CONST_BOOLEAN_FORWARD:
796 (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
798 Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
799 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
802 SYMVAL_CONST_SPECIFIER_FORWARD:
803 (declare with DEFVAR_SPECIFIER)
804 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that the error
805 message you get when attempting to set the value says to use
806 `set-specifier' instead.
808 SYMVAL_CURRENT_BUFFER_FORWARD:
809 (declare with DEFVAR_BUFFER_LOCAL)
810 This is used for built-in buffer-local variables -- i.e.
811 Lisp variables whose value is stored in the "struct buffer".
812 Variables of this sort always forward into C "Lisp_Object"
813 fields (although there's no reason in principle that other
814 types for ints and booleans couldn't be added). Note that
815 some of these variables are automatically local in each
816 buffer, while some are only local when they become set
817 (similar to `make-variable-buffer-local'). In these latter
818 cases, of course, the default value shows through in all
819 buffers in which the variable doesn't have a local value.
820 This is implemented by making sure the "struct buffer" field
821 always contains the correct value (whether it's local or
822 a default) and maintaining a mask in the "struct buffer"
823 indicating which fields are local. When `set-default' is
824 called on a variable that's not always local to all buffers,
825 it loops through each buffer and sets the corresponding
826 field in each buffer without a local value for the field,
827 according to the mask.
829 Calling `make-local-variable' on a variable of this sort
830 only has the effect of maybe changing the current buffer's mask.
831 Calling `make-variable-buffer-local' on a variable of this
832 sort has no effect at all.
834 SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
835 (declare with DEFVAR_CONST_BUFFER_LOCAL)
836 Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
839 SYMVAL_DEFAULT_BUFFER_FORWARD:
840 (declare with DEFVAR_BUFFER_DEFAULTS)
841 This is used for the Lisp variables that contain the
842 default values of built-in buffer-local variables. Setting
843 or referencing one of these variables forwards into a slot
844 in the special struct buffer Vbuffer_defaults.
846 SYMVAL_UNBOUND_MARKER:
847 This is used for only one object, Qunbound.
849 SYMVAL_SELECTED_CONSOLE_FORWARD:
850 (declare with DEFVAR_CONSOLE_LOCAL)
851 This is used for built-in console-local variables -- i.e.
852 Lisp variables whose value is stored in the "struct console".
853 These work just like built-in buffer-local variables.
854 However, calling `make-local-variable' or
855 `make-variable-buffer-local' on one of these variables
856 is currently disallowed because that would entail having
857 both console-local and buffer-local variables, which is
858 trickier to implement.
860 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
861 (declare with DEFVAR_CONST_CONSOLE_LOCAL)
862 Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
865 SYMVAL_DEFAULT_CONSOLE_FORWARD:
866 (declare with DEFVAR_CONSOLE_DEFAULTS)
867 This is used for the Lisp variables that contain the
868 default values of built-in console-local variables. Setting
869 or referencing one of these variables forwards into a slot
870 in the special struct console Vconsole_defaults.
873 2. symbol-value-buffer-local
875 symbol-value-buffer-local is used for variables that have had
876 `make-local-variable' or `make-variable-buffer-local' applied
877 to them. This object contains an alist mapping buffers to
878 values. In addition, the object contains a "current value",
879 which is the value in some buffer. Whenever you access the
880 variable with `symbol-value' or set it with `set' or `setq',
881 things are switched around so that the "current value"
882 refers to the current buffer, if it wasn't already. This
883 way, repeated references to a variable in the same buffer
884 are almost as efficient as if the variable weren't buffer
885 local. Note that the alist may not be up-to-date w.r.t.
886 the buffer whose value is current, as the "current value"
887 cache is normally only flushed into the alist when the
888 buffer it refers to changes.
890 Note also that it is possible for `make-local-variable'
891 or `make-variable-buffer-local' to be called on a variable
892 that forwards into a C variable (i.e. a variable whose
893 value cell is a symbol-value-forward). In this case,
894 the value cell becomes a symbol-value-buffer-local (as
895 always), and the symbol-value-forward moves into
896 the "current value" cell in this object. Also, in
897 this case the "current value" *always* refers to the
898 current buffer, so that the values of the C variable
899 always is the correct value for the current buffer.
900 set_buffer_internal() automatically updates the current-value
901 cells of all buffer-local variables that forward into C
902 variables. (There is a list of all buffer-local variables
903 that is maintained for this and other purposes.)
905 Note that only certain types of `symbol-value-forward' objects
906 can find their way into the "current value" cell of a
907 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
908 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
909 SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot
910 be buffer-local because they are unsettable;
911 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
912 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
913 does not have much of an effect (it's already buffer-local); and
914 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
915 that's not currently implemented.
918 3. symbol-value-varalias
920 A symbol-value-varalias object is used for variables that
921 are aliases for other variables. This object contains
922 the symbol that this variable is aliased to.
923 symbol-value-varalias objects cannot occur anywhere within
924 a symbol-value-buffer-local object, and most of the
925 low-level functions below do not accept them; you need
926 to call follow_varalias_pointers to get the actual
927 symbol to operate on. */
930 mark_symbol_value_buffer_local (Lisp_Object obj)
932 struct symbol_value_buffer_local *bfwd;
934 #ifdef ERROR_CHECK_TYPECHECK
935 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
936 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
939 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
940 mark_object (bfwd->default_value);
941 mark_object (bfwd->current_value);
942 mark_object (bfwd->current_buffer);
943 return bfwd->current_alist_element;
947 mark_symbol_value_lisp_magic (Lisp_Object obj)
949 struct symbol_value_lisp_magic *bfwd;
952 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
954 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
955 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
957 mark_object (bfwd->handler[i]);
958 mark_object (bfwd->harg[i]);
960 return bfwd->shadowed;
964 mark_symbol_value_varalias (Lisp_Object obj)
966 struct symbol_value_varalias *bfwd;
968 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
970 bfwd = XSYMBOL_VALUE_VARALIAS (obj);
971 mark_object (bfwd->shadowed);
972 return bfwd->aliasee;
975 /* Should never, ever be called. (except by an external debugger) */
977 print_symbol_value_magic (Lisp_Object obj,
978 Lisp_Object printcharfun, int escapeflag)
981 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s type %d) 0x%lx>",
982 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
983 XSYMBOL_VALUE_MAGIC_TYPE (obj),
985 write_c_string (buf, printcharfun);
988 static const struct lrecord_description symbol_value_forward_description[] = {
992 static const struct lrecord_description symbol_value_buffer_local_description[] = {
993 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, default_value) },
994 { XD_LO_RESET_NIL, offsetof (struct symbol_value_buffer_local, current_value), 3 },
998 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
999 { XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 },
1003 static const struct lrecord_description symbol_value_varalias_description[] = {
1004 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, aliasee) },
1005 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, shadowed) },
1009 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
1010 symbol_value_forward,
1012 print_symbol_value_magic, 0, 0, 0,
1013 symbol_value_forward_description,
1014 struct symbol_value_forward);
1016 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
1017 symbol_value_buffer_local,
1018 mark_symbol_value_buffer_local,
1019 print_symbol_value_magic, 0, 0, 0,
1020 symbol_value_buffer_local_description,
1021 struct symbol_value_buffer_local);
1023 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
1024 symbol_value_lisp_magic,
1025 mark_symbol_value_lisp_magic,
1026 print_symbol_value_magic, 0, 0, 0,
1027 symbol_value_lisp_magic_description,
1028 struct symbol_value_lisp_magic);
1030 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
1031 symbol_value_varalias,
1032 mark_symbol_value_varalias,
1033 print_symbol_value_magic, 0, 0, 0,
1034 symbol_value_varalias_description,
1035 struct symbol_value_varalias);
1038 /* Getting and setting values of symbols */
1040 /* Given the raw contents of a symbol value cell, return the Lisp value of
1041 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
1042 symbol-value-lisp-magic, or symbol-value-varalias.
1044 BUFFER specifies a buffer, and is used for built-in buffer-local
1045 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
1046 Note that such variables are never encapsulated in a
1047 symbol-value-buffer-local structure.
1049 CONSOLE specifies a console, and is used for built-in console-local
1050 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
1051 Note that such variables are (currently) never encapsulated in a
1052 symbol-value-buffer-local structure.
1056 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
1057 struct console *console)
1059 const struct symbol_value_forward *fwd;
1061 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1064 fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1065 switch (fwd->magic.type)
1067 case SYMVAL_FIXNUM_FORWARD:
1068 case SYMVAL_CONST_FIXNUM_FORWARD:
1069 return make_int (*((int *)symbol_value_forward_forward (fwd)));
1071 case SYMVAL_BOOLEAN_FORWARD:
1072 case SYMVAL_CONST_BOOLEAN_FORWARD:
1073 return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
1075 case SYMVAL_OBJECT_FORWARD:
1076 case SYMVAL_CONST_OBJECT_FORWARD:
1077 case SYMVAL_CONST_SPECIFIER_FORWARD:
1078 return *((Lisp_Object *)symbol_value_forward_forward (fwd));
1080 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1081 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1082 + ((char *)symbol_value_forward_forward (fwd)
1083 - (char *)&buffer_local_flags))));
1086 case SYMVAL_CURRENT_BUFFER_FORWARD:
1087 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1089 return (*((Lisp_Object *)((char *)buffer
1090 + ((char *)symbol_value_forward_forward (fwd)
1091 - (char *)&buffer_local_flags))));
1093 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1094 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1095 + ((char *)symbol_value_forward_forward (fwd)
1096 - (char *)&console_local_flags))));
1098 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1099 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1101 return (*((Lisp_Object *)((char *)console
1102 + ((char *)symbol_value_forward_forward (fwd)
1103 - (char *)&console_local_flags))));
1105 case SYMVAL_UNBOUND_MARKER:
1111 return Qnil; /* suppress compiler warning */
1114 /* Set the value of default-buffer-local variable SYM to VALUE. */
1117 set_default_buffer_slot_variable (Lisp_Object sym,
1120 /* Handle variables like case-fold-search that have special slots in
1121 the buffer. Make them work apparently like buffer_local variables.
1123 /* At this point, the value cell may not contain a symbol-value-varalias
1124 or symbol-value-buffer-local, and if there's a handler, we should
1125 have already called it. */
1126 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1127 const struct symbol_value_forward *fwd
1128 = XSYMBOL_VALUE_FORWARD (valcontents);
1129 int offset = ((char *) symbol_value_forward_forward (fwd)
1130 - (char *) &buffer_local_flags);
1131 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1132 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1133 int flags) = symbol_value_forward_magicfun (fwd);
1135 *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
1138 if (mask > 0) /* Not always per-buffer */
1142 /* Set value in each buffer which hasn't shadowed the default */
1143 LIST_LOOP_2 (elt, Vbuffer_alist)
1145 struct buffer *b = XBUFFER (XCDR (elt));
1146 if (!(b->local_var_flags & mask))
1149 magicfun (sym, &value, make_buffer (b), 0);
1150 *((Lisp_Object *) (offset + (char *) b)) = value;
1156 /* Set the value of default-console-local variable SYM to VALUE. */
1159 set_default_console_slot_variable (Lisp_Object sym,
1162 /* Handle variables like case-fold-search that have special slots in
1163 the console. Make them work apparently like console_local variables.
1165 /* At this point, the value cell may not contain a symbol-value-varalias
1166 or symbol-value-buffer-local, and if there's a handler, we should
1167 have already called it. */
1168 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1169 const struct symbol_value_forward *fwd
1170 = XSYMBOL_VALUE_FORWARD (valcontents);
1171 int offset = ((char *) symbol_value_forward_forward (fwd)
1172 - (char *) &console_local_flags);
1173 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1174 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1175 int flags) = symbol_value_forward_magicfun (fwd);
1177 *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
1180 if (mask > 0) /* Not always per-console */
1182 Lisp_Object console;
1184 /* Set value in each console which hasn't shadowed the default */
1185 LIST_LOOP_2 (console, Vconsole_list)
1187 struct console *d = XCONSOLE (console);
1188 if (!(d->local_var_flags & mask))
1191 magicfun (sym, &value, console, 0);
1192 *((Lisp_Object *) (offset + (char *) d)) = value;
1198 /* Store NEWVAL into SYM.
1200 SYM's value slot may *not* be types (5) or (6) above,
1201 i.e. no symbol-value-varalias objects. (You should have
1202 forwarded past all of these.)
1204 SYM should not be an unsettable symbol or a symbol with
1205 a magic `set-value' handler (unless you want to explicitly
1206 ignore this handler).
1208 OVALUE is the current value of SYM, but forwarded past any
1209 symbol-value-buffer-local and symbol-value-lisp-magic objects.
1210 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1211 the contents of its current-value cell.) NEWVAL may only be
1212 a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
1213 this function will only modify its current-value cell, which should
1214 already be set up to point to the current buffer.
1218 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
1221 if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
1223 Lisp_Object *store_pointer = value_slot_past_magic (sym);
1225 if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
1227 &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
1229 assert (UNBOUNDP (*store_pointer)
1230 || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1231 *store_pointer = newval;
1235 const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue);
1236 int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
1237 Lisp_Object in_object, int flags)
1238 = symbol_value_forward_magicfun (fwd);
1240 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue))
1242 case SYMVAL_FIXNUM_FORWARD:
1245 magicfun (sym, &newval, Qnil, 0);
1246 *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
1249 case SYMVAL_BOOLEAN_FORWARD:
1251 magicfun (sym, &newval, Qnil, 0);
1252 *((int *) symbol_value_forward_forward (fwd))
1256 case SYMVAL_OBJECT_FORWARD:
1258 magicfun (sym, &newval, Qnil, 0);
1259 *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
1262 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1263 set_default_buffer_slot_variable (sym, newval);
1266 case SYMVAL_CURRENT_BUFFER_FORWARD:
1268 magicfun (sym, &newval, make_buffer (current_buffer), 0);
1269 *((Lisp_Object *) ((char *) current_buffer
1270 + ((char *) symbol_value_forward_forward (fwd)
1271 - (char *) &buffer_local_flags)))
1275 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1276 set_default_console_slot_variable (sym, newval);
1279 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1281 magicfun (sym, &newval, Vselected_console, 0);
1282 *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console)
1283 + ((char *) symbol_value_forward_forward (fwd)
1284 - (char *) &console_local_flags)))
1294 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1295 BFWD, locate and return a pointer to the element in BUFFER's
1296 local_var_alist for SYMBOL. The return value will be Qnil if
1297 BUFFER does not have its own value for SYMBOL (i.e. the default
1298 value is seen in that buffer).
1302 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
1303 struct symbol_value_buffer_local *bfwd)
1305 if (!NILP (bfwd->current_buffer) &&
1306 XBUFFER (bfwd->current_buffer) == buffer)
1307 /* This is just an optimization of the below. */
1308 return bfwd->current_alist_element;
1310 return assq_no_quit (symbol, buffer->local_var_alist);
1313 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1314 symbol-value-buffer-local of a per-buffer variable -- i.e. the
1315 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1316 slot -- may be out of date.]
1318 Write out any cached value in buffer-local variable SYMBOL's
1319 buffer-local structure, which is passed in as BFWD.
1323 write_out_buffer_local_cache (Lisp_Object symbol,
1324 struct symbol_value_buffer_local *bfwd)
1326 if (!NILP (bfwd->current_buffer))
1328 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1329 uses it, and that type cannot be inside a symbol-value-buffer-local */
1330 Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0);
1331 if (NILP (bfwd->current_alist_element))
1332 /* current_value may be updated more recently than default_value */
1333 bfwd->default_value = cval;
1335 Fsetcdr (bfwd->current_alist_element, cval);
1339 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1340 Set up BFWD's cache for validity in buffer BUF. This assumes that
1341 the cache is currently in a consistent state (this can include
1342 not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1344 If the cache is already set up for BUF, this function does nothing
1347 Otherwise, if SYM forwards out to a C variable, this also forwards
1348 SYM's value in BUF out to the variable. Therefore, you generally
1349 only want to call this when BUF is, or is about to become, the
1352 (Otherwise, you can just retrieve the value without changing the
1353 cache, at the expense of slower retrieval.)
1357 set_up_buffer_local_cache (Lisp_Object sym,
1358 struct symbol_value_buffer_local *bfwd,
1360 Lisp_Object new_alist_el,
1363 Lisp_Object new_val;
1365 if (!NILP (bfwd->current_buffer)
1366 && buf == XBUFFER (bfwd->current_buffer))
1367 /* Cache is already set up. */
1370 /* Flush out the old cache. */
1371 write_out_buffer_local_cache (sym, bfwd);
1373 /* Retrieve the new alist element and new value. */
1374 if (NILP (new_alist_el)
1376 new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1378 if (NILP (new_alist_el))
1379 new_val = bfwd->default_value;
1381 new_val = Fcdr (new_alist_el);
1383 bfwd->current_alist_element = new_alist_el;
1384 XSETBUFFER (bfwd->current_buffer, buf);
1386 /* Now store the value into the current-value slot.
1387 We don't simply write it there, because the current-value
1388 slot might be a forwarding pointer, in which case we need
1389 to instead write the value into the C variable.
1391 We might also want to call a magic function.
1393 So instead, we call this function. */
1394 store_symval_forwarding (sym, bfwd->current_value, new_val);
1399 kill_buffer_local_variables (struct buffer *buf)
1401 Lisp_Object prev = Qnil;
1404 /* Any which are supposed to be permanent,
1405 make local again, with the same values they had. */
1407 for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
1409 Lisp_Object sym = XCAR (XCAR (alist));
1410 struct symbol_value_buffer_local *bfwd;
1411 /* Variables with a symbol-value-varalias should not be here
1412 (we should have forwarded past them) and there must be a
1413 symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
1414 just forward past it; if the variable has a handler, it was
1416 Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
1418 assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
1419 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
1421 if (!NILP (Fget (sym, Qpermanent_local, Qnil)))
1422 /* prev points to the last alist element that is still
1423 staying around, so *only* update it now. This didn't
1424 used to be the case; this bug has been around since
1425 mly's rewrite two years ago! */
1429 /* Really truly kill it. */
1431 XCDR (prev) = XCDR (alist);
1433 buf->local_var_alist = XCDR (alist);
1435 /* We just effectively changed the value for this variable
1438 /* (1) If the cache is caching BUF, invalidate the cache. */
1439 if (!NILP (bfwd->current_buffer) &&
1440 buf == XBUFFER (bfwd->current_buffer))
1441 bfwd->current_buffer = Qnil;
1443 /* (2) If we changed the value in current_buffer and this
1444 variable forwards to a C variable, we need to change the
1445 value of the C variable. set_up_buffer_local_cache()
1446 will do this. It doesn't hurt to do it whenever
1447 BUF == current_buffer, so just go ahead and do that. */
1448 if (buf == current_buffer)
1449 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
1455 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1456 struct console *con, int swap_it_in,
1457 Lisp_Object symcons, int set_it_p)
1459 Lisp_Object valcontents;
1462 valcontents = XSYMBOL (sym)->value;
1465 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1468 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1470 case SYMVAL_LISP_MAGIC:
1472 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1476 case SYMVAL_VARALIAS:
1477 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1479 /* presto change-o! */
1482 case SYMVAL_BUFFER_LOCAL:
1483 case SYMVAL_SOME_BUFFER_LOCAL:
1485 struct symbol_value_buffer_local *bfwd
1486 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1490 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1491 valcontents = bfwd->current_value;
1495 if (!NILP (bfwd->current_buffer) &&
1496 buf == XBUFFER (bfwd->current_buffer))
1497 valcontents = bfwd->current_value;
1498 else if (NILP (symcons))
1501 valcontents = assq_no_quit (sym, buf->local_var_alist);
1502 if (NILP (valcontents))
1503 valcontents = bfwd->default_value;
1505 valcontents = XCDR (valcontents);
1508 valcontents = XCDR (symcons);
1516 return do_symval_forwarding (valcontents, buf, con);
1520 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1521 bound. Note that it must not be possible to QUIT within this
1525 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
1532 buf = current_buffer;
1535 CHECK_BUFFER (buffer);
1536 buf = XBUFFER (buffer);
1539 return find_symbol_value_1 (sym, buf,
1540 /* If it bombs out at startup due to a
1541 Lisp error, this may be nil. */
1542 CONSOLEP (Vselected_console)
1543 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
1547 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1552 console = Vselected_console;
1554 CHECK_CONSOLE (console);
1556 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1560 /* Return the current value of SYM. The difference between this function
1561 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1562 this updates the CURRENT_VALUE slot of buffer-local variables to
1563 point to the current buffer, while symbol_value_in_buffer doesn't. */
1566 find_symbol_value (Lisp_Object sym)
1568 /* WARNING: This function can be called when current_buffer is 0
1569 and Vselected_console is Qnil, early in initialization. */
1570 struct console *con;
1571 Lisp_Object valcontents;
1575 valcontents = XSYMBOL (sym)->value;
1576 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1579 if (CONSOLEP (Vselected_console))
1580 con = XCONSOLE (Vselected_console);
1583 /* This can also get called while we're preparing to shutdown.
1584 #### What should really happen in that case? Should we
1585 actually fix things so we can't get here in that case? */
1587 assert (!initialized || preparing_for_armageddon);
1592 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
1595 /* This is an optimized function for quick lookup of buffer local symbols
1596 by avoiding O(n) search. This will work when either:
1597 a) We have already found the symbol e.g. by traversing local_var_alist.
1599 b) We know that the symbol will not be found in the current buffer's
1600 list of local variables.
1601 In the former case, find_it_p is 1 and symbol_cons is the element from
1602 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1605 This function is called from set_buffer_internal which does both of these
1609 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1611 /* WARNING: This function can be called when current_buffer is 0
1612 and Vselected_console is Qnil, early in initialization. */
1613 struct console *con;
1614 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1617 if (CONSOLEP (Vselected_console))
1618 con = XCONSOLE (Vselected_console);
1621 /* This can also get called while we're preparing to shutdown.
1622 #### What should really happen in that case? Should we
1623 actually fix things so we can't get here in that case? */
1625 assert (!initialized || preparing_for_armageddon);
1630 return find_symbol_value_1 (sym, current_buffer, con, 1,
1631 find_it_p ? symbol_cons : Qnil,
1635 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1636 Return SYMBOL's value. Error if that is void.
1640 Lisp_Object val = find_symbol_value (symbol);
1643 return Fsignal (Qvoid_variable, list1 (symbol));
1648 DEFUN ("set", Fset, 2, 2, 0, /*
1649 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1653 REGISTER Lisp_Object valcontents;
1655 /* remember, we're called by Fmakunbound() as well */
1657 CHECK_SYMBOL (symbol);
1660 sym = XSYMBOL (symbol);
1661 valcontents = sym->value;
1663 if (EQ (symbol, Qnil) ||
1665 SYMBOL_IS_KEYWORD (symbol))
1666 reject_constant_symbols (symbol, newval, 0,
1667 UNBOUNDP (newval) ? Qmakunbound : Qset);
1669 if (!SYMBOL_VALUE_MAGIC_P (valcontents) || UNBOUNDP (valcontents))
1671 sym->value = newval;
1675 reject_constant_symbols (symbol, newval, 0,
1676 UNBOUNDP (newval) ? Qmakunbound : Qset);
1678 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1680 case SYMVAL_LISP_MAGIC:
1682 if (UNBOUNDP (newval))
1684 maybe_call_magic_handler (symbol, Qmakunbound, 0);
1685 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = Qunbound;
1689 maybe_call_magic_handler (symbol, Qset, 1, newval);
1690 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = newval;
1694 case SYMVAL_VARALIAS:
1695 symbol = follow_varalias_pointers (symbol,
1697 ? Qmakunbound : Qset);
1698 /* presto change-o! */
1701 case SYMVAL_FIXNUM_FORWARD:
1702 case SYMVAL_BOOLEAN_FORWARD:
1703 case SYMVAL_OBJECT_FORWARD:
1704 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1705 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1706 if (UNBOUNDP (newval))
1707 signal_error (Qerror,
1708 list2 (build_string ("Cannot makunbound"), symbol));
1711 /* case SYMVAL_UNBOUND_MARKER: break; */
1713 case SYMVAL_CURRENT_BUFFER_FORWARD:
1715 const struct symbol_value_forward *fwd
1716 = XSYMBOL_VALUE_FORWARD (valcontents);
1717 int mask = XINT (*((Lisp_Object *)
1718 symbol_value_forward_forward (fwd)));
1720 /* Setting this variable makes it buffer-local */
1721 current_buffer->local_var_flags |= mask;
1725 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1727 const struct symbol_value_forward *fwd
1728 = XSYMBOL_VALUE_FORWARD (valcontents);
1729 int mask = XINT (*((Lisp_Object *)
1730 symbol_value_forward_forward (fwd)));
1732 /* Setting this variable makes it console-local */
1733 XCONSOLE (Vselected_console)->local_var_flags |= mask;
1737 case SYMVAL_BUFFER_LOCAL:
1738 case SYMVAL_SOME_BUFFER_LOCAL:
1740 /* If we want to examine or set the value and
1741 CURRENT-BUFFER is current, we just examine or set
1742 CURRENT-VALUE. If CURRENT-BUFFER is not current, we
1743 store the current CURRENT-VALUE value into
1744 CURRENT-ALIST- ELEMENT, then find the appropriate alist
1745 element for the buffer now current and set up
1746 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
1747 of that element, and store into CURRENT-BUFFER.
1749 If we are setting the variable and the current buffer does
1750 not have an alist entry for this variable, an alist entry is
1753 Note that CURRENT-VALUE can be a forwarding pointer.
1754 Each time it is examined or set, forwarding must be
1756 struct symbol_value_buffer_local *bfwd
1757 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1758 int some_buffer_local_p =
1759 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
1760 /* What value are we caching right now? */
1761 Lisp_Object aelt = bfwd->current_alist_element;
1763 if (!NILP (bfwd->current_buffer) &&
1764 current_buffer == XBUFFER (bfwd->current_buffer)
1765 && ((some_buffer_local_p)
1766 ? 1 /* doesn't automatically become local */
1767 : !NILP (aelt) /* already local */
1770 /* Cache is valid */
1771 valcontents = bfwd->current_value;
1775 /* If the current buffer is not the buffer whose binding is
1776 currently cached, or if it's a SYMVAL_BUFFER_LOCAL and
1777 we're looking at the default value, the cache is invalid; we
1778 need to write it out, and find the new CURRENT-ALIST-ELEMENT
1781 /* Write out the cached value for the old buffer; copy it
1782 back to its alist element. This works if the current
1783 buffer only sees the default value, too. */
1784 write_out_buffer_local_cache (symbol, bfwd);
1786 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1787 aelt = buffer_local_alist_element (current_buffer, symbol, bfwd);
1790 /* This buffer is still seeing the default value. */
1791 if (!some_buffer_local_p)
1793 /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a
1794 new assoc for a local value and set
1795 CURRENT-ALIST-ELEMENT to point to that. */
1797 do_symval_forwarding (bfwd->current_value,
1799 XCONSOLE (Vselected_console));
1800 aelt = Fcons (symbol, aelt);
1801 current_buffer->local_var_alist
1802 = Fcons (aelt, current_buffer->local_var_alist);
1806 /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
1807 we're currently seeing the default value. */
1811 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1812 bfwd->current_alist_element = aelt;
1813 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
1814 XSETBUFFER (bfwd->current_buffer, current_buffer);
1815 valcontents = bfwd->current_value;
1822 store_symval_forwarding (symbol, valcontents, newval);
1828 /* Access or set a buffer-local symbol's default value. */
1830 /* Return the default value of SYM, but don't check for voidness.
1831 Return Qunbound if it is void. */
1834 default_value (Lisp_Object sym)
1836 Lisp_Object valcontents;
1841 valcontents = XSYMBOL (sym)->value;
1844 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1847 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1849 case SYMVAL_LISP_MAGIC:
1851 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1855 case SYMVAL_VARALIAS:
1856 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1857 /* presto change-o! */
1860 case SYMVAL_UNBOUND_MARKER:
1863 case SYMVAL_CURRENT_BUFFER_FORWARD:
1865 const struct symbol_value_forward *fwd
1866 = XSYMBOL_VALUE_FORWARD (valcontents);
1867 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1868 + ((char *)symbol_value_forward_forward (fwd)
1869 - (char *)&buffer_local_flags))));
1872 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1874 const struct symbol_value_forward *fwd
1875 = XSYMBOL_VALUE_FORWARD (valcontents);
1876 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1877 + ((char *)symbol_value_forward_forward (fwd)
1878 - (char *)&console_local_flags))));
1881 case SYMVAL_BUFFER_LOCAL:
1882 case SYMVAL_SOME_BUFFER_LOCAL:
1884 struct symbol_value_buffer_local *bfwd =
1885 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1887 /* Handle user-created local variables. */
1888 /* If var is set up for a buffer that lacks a local value for it,
1889 the current value is nominally the default value.
1890 But the current value slot may be more up to date, since
1891 ordinary setq stores just that slot. So use that. */
1892 if (NILP (bfwd->current_alist_element))
1893 return do_symval_forwarding (bfwd->current_value, current_buffer,
1894 XCONSOLE (Vselected_console));
1896 return bfwd->default_value;
1899 /* For other variables, get the current value. */
1900 return do_symval_forwarding (valcontents, current_buffer,
1901 XCONSOLE (Vselected_console));
1904 RETURN_NOT_REACHED (Qnil) /* suppress compiler warning */
1907 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /*
1908 Return t if SYMBOL has a non-void default value.
1909 This is the value that is seen in buffers that do not have their own values
1914 return UNBOUNDP (default_value (symbol)) ? Qnil : Qt;
1917 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /*
1918 Return SYMBOL's default value.
1919 This is the value that is seen in buffers that do not have their own values
1920 for this variable. The default value is meaningful for variables with
1921 local bindings in certain buffers.
1925 Lisp_Object value = default_value (symbol);
1927 return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (symbol)) : value;
1930 DEFUN ("set-default", Fset_default, 2, 2, 0, /*
1931 Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.
1932 The default value is seen in buffers that do not have their own values
1937 Lisp_Object valcontents;
1939 CHECK_SYMBOL (symbol);
1942 valcontents = XSYMBOL (symbol)->value;
1945 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1946 return Fset (symbol, value);
1948 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1950 case SYMVAL_LISP_MAGIC:
1951 RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (symbol, Qset_default, 1,
1953 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1957 case SYMVAL_VARALIAS:
1958 symbol = follow_varalias_pointers (symbol, Qset_default);
1959 /* presto change-o! */
1962 case SYMVAL_CURRENT_BUFFER_FORWARD:
1963 set_default_buffer_slot_variable (symbol, value);
1966 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1967 set_default_console_slot_variable (symbol, value);
1970 case SYMVAL_BUFFER_LOCAL:
1971 case SYMVAL_SOME_BUFFER_LOCAL:
1973 /* Store new value into the DEFAULT-VALUE slot */
1974 struct symbol_value_buffer_local *bfwd
1975 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1977 bfwd->default_value = value;
1978 /* If current-buffer doesn't shadow default_value,
1979 * we must set the CURRENT-VALUE slot too */
1980 if (NILP (bfwd->current_alist_element))
1981 store_symval_forwarding (symbol, bfwd->current_value, value);
1986 return Fset (symbol, value);
1990 DEFUN ("setq-default", Fsetq_default, 0, UNEVALLED, 0, /*
1991 Set the default value of variable SYMBOL to VALUE.
1992 SYMBOL, the variable name, is literal (not evaluated);
1993 VALUE is an expression and it is evaluated.
1994 The default value of a variable is seen in buffers
1995 that do not have their own values for the variable.
1997 More generally, you can use multiple variables and values, as in
1998 (setq-default SYMBOL VALUE SYMBOL VALUE...)
1999 This sets each SYMBOL's default value to the corresponding VALUE.
2000 The VALUE for the Nth SYMBOL can refer to the new default values
2001 of previous SYMBOLs.
2005 /* This function can GC */
2006 Lisp_Object symbol, tail, val = Qnil;
2008 struct gcpro gcpro1;
2010 GET_LIST_LENGTH (args, nargs);
2012 if (nargs & 1) /* Odd number of arguments? */
2013 Fsignal (Qwrong_number_of_arguments,
2014 list2 (Qsetq_default, make_int (nargs)));
2018 PROPERTY_LIST_LOOP (tail, symbol, val, args)
2021 Fset_default (symbol, val);
2028 /* Lisp functions for creating and removing buffer-local variables. */
2030 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1,
2031 "vMake Variable Buffer Local: ", /*
2032 Make VARIABLE have a separate value for each buffer.
2033 At any time, the value for the current buffer is in effect.
2034 There is also a default value which is seen in any buffer which has not yet
2036 Using `set' or `setq' to set the variable causes it to have a separate value
2037 for the current buffer if it was previously using the default value.
2038 The function `default-value' gets the default value and `set-default'
2043 Lisp_Object valcontents;
2045 CHECK_SYMBOL (variable);
2048 verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
2050 valcontents = XSYMBOL (variable)->value;
2053 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2055 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2057 case SYMVAL_LISP_MAGIC:
2058 if (!UNBOUNDP (maybe_call_magic_handler
2059 (variable, Qmake_variable_buffer_local, 0)))
2061 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2065 case SYMVAL_VARALIAS:
2066 variable = follow_varalias_pointers (variable,
2067 Qmake_variable_buffer_local);
2068 /* presto change-o! */
2071 case SYMVAL_FIXNUM_FORWARD:
2072 case SYMVAL_BOOLEAN_FORWARD:
2073 case SYMVAL_OBJECT_FORWARD:
2074 case SYMVAL_UNBOUND_MARKER:
2077 case SYMVAL_CURRENT_BUFFER_FORWARD:
2078 case SYMVAL_BUFFER_LOCAL:
2079 /* Already per-each-buffer */
2082 case SYMVAL_SOME_BUFFER_LOCAL:
2084 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
2085 SYMVAL_BUFFER_LOCAL;
2094 struct symbol_value_buffer_local *bfwd
2095 = alloc_lcrecord_type (struct symbol_value_buffer_local,
2096 &lrecord_symbol_value_buffer_local);
2098 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2100 bfwd->default_value = find_symbol_value (variable);
2101 bfwd->current_value = valcontents;
2102 bfwd->current_alist_element = Qnil;
2103 bfwd->current_buffer = Fcurrent_buffer ();
2104 XSETSYMBOL_VALUE_MAGIC (foo, bfwd);
2105 *value_slot_past_magic (variable) = foo;
2106 #if 1 /* #### Yuck! FSFmacs bug-compatibility*/
2107 /* This sets the default-value of any make-variable-buffer-local to nil.
2108 That just sucks. User can just use setq-default to effect that,
2109 but there's no way to do makunbound-default to undo this lossage. */
2110 if (UNBOUNDP (valcontents))
2111 bfwd->default_value = Qnil;
2113 #if 0 /* #### Yuck! */
2114 /* This sets the value to nil in this buffer.
2115 User could use (setq variable nil) to do this.
2116 It isn't as egregious to do this automatically
2117 as it is to do so to the default-value, but it's
2118 still really dubious. */
2119 if (UNBOUNDP (valcontents))
2120 Fset (variable, Qnil);
2126 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1,
2127 "vMake Local Variable: ", /*
2128 Make VARIABLE have a separate value in the current buffer.
2129 Other buffers will continue to share a common default value.
2130 \(The buffer-local value of VARIABLE starts out as the same value
2131 VARIABLE previously had. If VARIABLE was void, it remains void.)
2132 See also `make-variable-buffer-local'.
2134 If the variable is already arranged to become local when set,
2135 this function causes a local value to exist for this buffer,
2136 just as setting the variable would do.
2138 Do not use `make-local-variable' to make a hook variable buffer-local.
2139 Use `make-local-hook' instead.
2143 Lisp_Object valcontents;
2144 struct symbol_value_buffer_local *bfwd;
2146 CHECK_SYMBOL (variable);
2149 verify_ok_for_buffer_local (variable, Qmake_local_variable);
2151 valcontents = XSYMBOL (variable)->value;
2154 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2156 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2158 case SYMVAL_LISP_MAGIC:
2159 if (!UNBOUNDP (maybe_call_magic_handler
2160 (variable, Qmake_local_variable, 0)))
2162 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2166 case SYMVAL_VARALIAS:
2167 variable = follow_varalias_pointers (variable, Qmake_local_variable);
2168 /* presto change-o! */
2171 case SYMVAL_FIXNUM_FORWARD:
2172 case SYMVAL_BOOLEAN_FORWARD:
2173 case SYMVAL_OBJECT_FORWARD:
2174 case SYMVAL_UNBOUND_MARKER:
2177 case SYMVAL_BUFFER_LOCAL:
2178 case SYMVAL_CURRENT_BUFFER_FORWARD:
2180 /* Make sure the symbol has a local value in this particular
2181 buffer, by setting it to the same value it already has. */
2182 Fset (variable, find_symbol_value (variable));
2186 case SYMVAL_SOME_BUFFER_LOCAL:
2188 if (!NILP (buffer_local_alist_element (current_buffer,
2190 (XSYMBOL_VALUE_BUFFER_LOCAL
2192 goto already_local_to_current_buffer;
2194 goto already_local_to_some_other_buffer;
2202 /* Make sure variable is set up to hold per-buffer values */
2203 bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
2204 &lrecord_symbol_value_buffer_local);
2205 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2207 bfwd->current_buffer = Qnil;
2208 bfwd->current_alist_element = Qnil;
2209 bfwd->current_value = valcontents;
2210 /* passing 0 is OK because this should never be a
2211 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2213 bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
2216 if (UNBOUNDP (bfwd->default_value))
2217 bfwd->default_value = Qnil; /* Yuck! */
2220 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
2221 *value_slot_past_magic (variable) = valcontents;
2223 already_local_to_some_other_buffer:
2225 /* Make sure this buffer has its own value of variable */
2226 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2228 if (UNBOUNDP (bfwd->default_value))
2230 /* If default value is unbound, set local value to nil. */
2231 XSETBUFFER (bfwd->current_buffer, current_buffer);
2232 bfwd->current_alist_element = Fcons (variable, Qnil);
2233 current_buffer->local_var_alist =
2234 Fcons (bfwd->current_alist_element, current_buffer->local_var_alist);
2235 store_symval_forwarding (variable, bfwd->current_value, Qnil);
2239 current_buffer->local_var_alist
2240 = Fcons (Fcons (variable, bfwd->default_value),
2241 current_buffer->local_var_alist);
2243 /* Make sure symbol does not think it is set up for this buffer;
2244 force it to look once again for this buffer's value */
2245 if (!NILP (bfwd->current_buffer) &&
2246 current_buffer == XBUFFER (bfwd->current_buffer))
2247 bfwd->current_buffer = Qnil;
2249 already_local_to_current_buffer:
2251 /* If the symbol forwards into a C variable, then swap in the
2252 variable for this buffer immediately. If C code modifies the
2253 variable before we swap in, then that new value will clobber the
2254 default value the next time we swap. */
2255 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2256 if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value))
2258 switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
2260 case SYMVAL_FIXNUM_FORWARD:
2261 case SYMVAL_BOOLEAN_FORWARD:
2262 case SYMVAL_OBJECT_FORWARD:
2263 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2264 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2267 case SYMVAL_UNBOUND_MARKER:
2268 case SYMVAL_CURRENT_BUFFER_FORWARD:
2279 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1,
2280 "vKill Local Variable: ", /*
2281 Make VARIABLE no longer have a separate value in the current buffer.
2282 From now on the default value will apply in this buffer.
2286 Lisp_Object valcontents;
2288 CHECK_SYMBOL (variable);
2291 valcontents = XSYMBOL (variable)->value;
2294 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2297 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2299 case SYMVAL_LISP_MAGIC:
2300 if (!UNBOUNDP (maybe_call_magic_handler
2301 (variable, Qkill_local_variable, 0)))
2303 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2307 case SYMVAL_VARALIAS:
2308 variable = follow_varalias_pointers (variable, Qkill_local_variable);
2309 /* presto change-o! */
2312 case SYMVAL_CURRENT_BUFFER_FORWARD:
2314 const struct symbol_value_forward *fwd
2315 = XSYMBOL_VALUE_FORWARD (valcontents);
2316 int offset = ((char *) symbol_value_forward_forward (fwd)
2317 - (char *) &buffer_local_flags);
2319 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2323 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2324 Lisp_Object in_object, int flags) =
2325 symbol_value_forward_magicfun (fwd);
2326 Lisp_Object oldval = * (Lisp_Object *)
2327 (offset + (char *) XBUFFER (Vbuffer_defaults));
2329 (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
2330 *(Lisp_Object *) (offset + (char *) current_buffer)
2332 current_buffer->local_var_flags &= ~mask;
2337 case SYMVAL_BUFFER_LOCAL:
2338 case SYMVAL_SOME_BUFFER_LOCAL:
2340 /* Get rid of this buffer's alist element, if any */
2341 struct symbol_value_buffer_local *bfwd
2342 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2343 Lisp_Object alist = current_buffer->local_var_alist;
2344 Lisp_Object alist_element
2345 = buffer_local_alist_element (current_buffer, variable, bfwd);
2347 if (!NILP (alist_element))
2348 current_buffer->local_var_alist = Fdelq (alist_element, alist);
2350 /* Make sure symbol does not think it is set up for this buffer;
2351 force it to look once again for this buffer's value */
2352 if (!NILP (bfwd->current_buffer) &&
2353 current_buffer == XBUFFER (bfwd->current_buffer))
2354 bfwd->current_buffer = Qnil;
2356 /* We just changed the value in the current_buffer. If this
2357 variable forwards to a C variable, we need to change the
2358 value of the C variable. set_up_buffer_local_cache()
2359 will do this. It doesn't hurt to do it always,
2360 so just go ahead and do that. */
2361 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2368 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2372 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2373 "vKill Console Local Variable: ", /*
2374 Make VARIABLE no longer have a separate value in the selected console.
2375 From now on the default value will apply in this console.
2379 Lisp_Object valcontents;
2381 CHECK_SYMBOL (variable);
2384 valcontents = XSYMBOL (variable)->value;
2387 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2390 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2392 case SYMVAL_LISP_MAGIC:
2393 if (!UNBOUNDP (maybe_call_magic_handler
2394 (variable, Qkill_console_local_variable, 0)))
2396 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2400 case SYMVAL_VARALIAS:
2401 variable = follow_varalias_pointers (variable,
2402 Qkill_console_local_variable);
2403 /* presto change-o! */
2406 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2408 const struct symbol_value_forward *fwd
2409 = XSYMBOL_VALUE_FORWARD (valcontents);
2410 int offset = ((char *) symbol_value_forward_forward (fwd)
2411 - (char *) &console_local_flags);
2413 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2417 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2418 Lisp_Object in_object, int flags) =
2419 symbol_value_forward_magicfun (fwd);
2420 Lisp_Object oldval = * (Lisp_Object *)
2421 (offset + (char *) XCONSOLE (Vconsole_defaults));
2423 magicfun (variable, &oldval, Vselected_console, 0);
2424 *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
2426 XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
2436 /* Used by specbind to determine what effects it might have. Returns:
2437 * 0 if symbol isn't buffer-local, and wouldn't be after it is set
2438 * <0 if symbol isn't presently buffer-local, but set would make it so
2439 * >0 if symbol is presently buffer-local
2442 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
2444 Lisp_Object valcontents;
2447 valcontents = XSYMBOL (symbol)->value;
2450 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2452 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2454 case SYMVAL_LISP_MAGIC:
2456 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2460 case SYMVAL_VARALIAS:
2461 symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
2462 /* presto change-o! */
2465 case SYMVAL_CURRENT_BUFFER_FORWARD:
2467 const struct symbol_value_forward *fwd
2468 = XSYMBOL_VALUE_FORWARD (valcontents);
2469 int mask = XINT (*((Lisp_Object *)
2470 symbol_value_forward_forward (fwd)));
2471 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
2472 /* Already buffer-local */
2475 /* Would be buffer-local after set */
2478 case SYMVAL_BUFFER_LOCAL:
2479 case SYMVAL_SOME_BUFFER_LOCAL:
2481 struct symbol_value_buffer_local *bfwd
2482 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2484 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
2487 /* Automatically becomes local when set */
2488 return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
2498 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2499 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2501 (symbol, buffer, unbound_value))
2504 CHECK_SYMBOL (symbol);
2505 CHECK_BUFFER (buffer);
2506 value = symbol_value_in_buffer (symbol, buffer);
2507 return UNBOUNDP (value) ? unbound_value : value;
2510 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2511 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2513 (symbol, console, unbound_value))
2516 CHECK_SYMBOL (symbol);
2517 CHECK_CONSOLE (console);
2518 value = symbol_value_in_console (symbol, console);
2519 return UNBOUNDP (value) ? unbound_value : value;
2522 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
2523 If SYMBOL is a built-in variable, return info about this; else return nil.
2524 The returned info will be a symbol, one of
2526 `object' A simple built-in variable.
2527 `const-object' Same, but cannot be set.
2528 `integer' A built-in integer variable.
2529 `const-integer' Same, but cannot be set.
2530 `boolean' A built-in boolean variable.
2531 `const-boolean' Same, but cannot be set.
2532 `const-specifier' Always contains a specifier; e.g. `has-modeline-p'.
2533 `current-buffer' A built-in buffer-local variable.
2534 `const-current-buffer' Same, but cannot be set.
2535 `default-buffer' Forwards to the default value of a built-in
2536 buffer-local variable.
2537 `selected-console' A built-in console-local variable.
2538 `const-selected-console' Same, but cannot be set.
2539 `default-console' Forwards to the default value of a built-in
2540 console-local variable.
2544 REGISTER Lisp_Object valcontents;
2546 CHECK_SYMBOL (symbol);
2549 valcontents = XSYMBOL (symbol)->value;
2552 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2555 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2557 case SYMVAL_LISP_MAGIC:
2558 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2562 case SYMVAL_VARALIAS:
2563 symbol = follow_varalias_pointers (symbol, Qt);
2564 /* presto change-o! */
2567 case SYMVAL_BUFFER_LOCAL:
2568 case SYMVAL_SOME_BUFFER_LOCAL:
2570 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value;
2574 case SYMVAL_FIXNUM_FORWARD: return Qinteger;
2575 case SYMVAL_CONST_FIXNUM_FORWARD: return Qconst_integer;
2576 case SYMVAL_BOOLEAN_FORWARD: return Qboolean;
2577 case SYMVAL_CONST_BOOLEAN_FORWARD: return Qconst_boolean;
2578 case SYMVAL_OBJECT_FORWARD: return Qobject;
2579 case SYMVAL_CONST_OBJECT_FORWARD: return Qconst_object;
2580 case SYMVAL_CONST_SPECIFIER_FORWARD: return Qconst_specifier;
2581 case SYMVAL_DEFAULT_BUFFER_FORWARD: return Qdefault_buffer;
2582 case SYMVAL_CURRENT_BUFFER_FORWARD: return Qcurrent_buffer;
2583 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: return Qconst_current_buffer;
2584 case SYMVAL_DEFAULT_CONSOLE_FORWARD: return Qdefault_console;
2585 case SYMVAL_SELECTED_CONSOLE_FORWARD: return Qselected_console;
2586 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: return Qconst_selected_console;
2587 case SYMVAL_UNBOUND_MARKER: return Qnil;
2590 abort (); return Qnil;
2595 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
2596 Return t if SYMBOL's value is local to BUFFER.
2597 If optional third arg AFTER-SET is true, return t if SYMBOL would be
2598 buffer-local after it is set, regardless of whether it is so presently.
2599 A nil value for BUFFER is *not* the same as (current-buffer), but means
2600 "no buffer". Specifically:
2602 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
2603 the variable is one of the special built-in variables that is always
2604 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
2605 `buffer-undo-list', and others.)
2607 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
2608 the variable has had `make-variable-buffer-local' applied to it.
2610 (symbol, buffer, after_set))
2614 CHECK_SYMBOL (symbol);
2617 buffer = get_buffer (buffer, 1);
2618 local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
2622 local_info = symbol_value_buffer_local_info (symbol, 0);
2625 if (NILP (after_set))
2626 return local_info > 0 ? Qt : Qnil;
2628 return local_info != 0 ? Qt : Qnil;
2633 I've gone ahead and partially implemented this because it's
2634 super-useful for dealing with the compatibility problems in supporting
2635 the old pointer-shape variables, and preventing people from `setq'ing
2636 the new variables. Any other way of handling this problem is way
2637 ugly, likely to be slow, and generally not something I want to waste
2638 my time worrying about.
2640 The interface and/or function name is sure to change before this
2641 gets into its final form. I currently like the way everything is
2642 set up and it has all the features I want it to have, except for
2643 one: I really want to be able to have multiple nested handlers,
2644 to implement an `advice'-like capability. This would allow,
2645 for example, a clean way of implementing `debug-if-set' or
2646 `debug-if-referenced' and such.
2648 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
2649 ************************************************************
2650 **Only** the `set-value', `make-unbound', and `make-local'
2651 handler types are currently implemented. Implementing the
2652 get-value and bound-predicate handlers is somewhat tricky
2653 because there are lots of subfunctions (e.g. find_symbol_value()).
2654 find_symbol_value(), in fact, is called from outside of
2655 this module. You'd have to have it do this:
2657 -- check for a `bound-predicate' handler, call that if so;
2658 if it returns nil, return Qunbound
2659 -- check for a `get-value' handler and call it and return
2662 It gets even trickier when you have to deal with
2663 sub-subfunctions like find_symbol_value_1(), and esp.
2664 when you have to properly handle variable aliases, which
2665 can lead to lots of tricky situations. So I've just
2666 punted on this, since the interface isn't officially
2667 exported and we can get by with just a `set-value'
2670 Actions in unimplemented handler types will correctly
2671 ignore any handlers, and will not fuck anything up or
2674 WARNING WARNING: If you do go and implement another
2675 type of handler, make *sure* to change
2676 would_be_magic_handled() so it knows about this,
2677 or dire things could result.
2678 ************************************************************
2679 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
2681 Real documentation is as follows.
2683 Set a magic handler for VARIABLE.
2684 This allows you to specify arbitrary behavior that results from
2685 accessing or setting a variable. For example, retrieving the
2686 variable's value might actually retrieve the first element off of
2687 a list stored in another variable, and setting the variable's value
2688 might add an element to the front of that list. (This is how the
2689 obsolete variable `unread-command-event' is implemented.)
2691 In general it is NOT good programming practice to use magic variables
2692 in a new package that you are designing. If you feel the need to
2693 do this, it's almost certainly a sign that you should be using a
2694 function instead of a variable. This facility is provided to allow
2695 a package to support obsolete variables and provide compatibility
2696 with similar packages with different variable names and semantics.
2697 By using magic handlers, you can cleanly provide obsoleteness and
2698 compatibility support and separate this support from the core
2699 routines in a package.
2701 VARIABLE should be a symbol naming the variable for which the
2702 magic behavior is provided. HANDLER-TYPE is a symbol specifying
2703 which behavior is being controlled, and HANDLER is the function
2704 that will be called to control this behavior. HARG is a
2705 value that will be passed to HANDLER but is otherwise
2706 uninterpreted. KEEP-EXISTING specifies what to do with existing
2707 handlers of the same type; nil means "erase them all", t means
2708 "keep them but insert at the beginning", the list (t) means
2709 "keep them but insert at the end", a function means "keep
2710 them but insert before the specified function", a list containing
2711 a function means "keep them but insert after the specified
2714 You can specify magic behavior for any type of variable at all,
2715 and for any handler types that are unspecified, the standard
2716 behavior applies. This allows you, for example, to use
2717 `defvaralias' in conjunction with this function. (For that
2718 matter, `defvaralias' could be implemented using this function.)
2720 The behaviors that can be specified in HANDLER-TYPE are
2722 get-value (SYM ARGS FUN HARG HANDLERS)
2723 This means that one of the functions `symbol-value',
2724 `default-value', `symbol-value-in-buffer', or
2725 `symbol-value-in-console' was called on SYM.
2727 set-value (SYM ARGS FUN HARG HANDLERS)
2728 This means that one of the functions `set' or `set-default'
2731 bound-predicate (SYM ARGS FUN HARG HANDLERS)
2732 This means that one of the functions `boundp', `globally-boundp',
2733 or `default-boundp' was called on SYM.
2735 make-unbound (SYM ARGS FUN HARG HANDLERS)
2736 This means that the function `makunbound' was called on SYM.
2738 local-predicate (SYM ARGS FUN HARG HANDLERS)
2739 This means that the function `local-variable-p' was called
2742 make-local (SYM ARGS FUN HARG HANDLERS)
2743 This means that one of the functions `make-local-variable',
2744 `make-variable-buffer-local', `kill-local-variable',
2745 or `kill-console-local-variable' was called on SYM.
2747 The meanings of the arguments are as follows:
2749 SYM is the symbol on which the function was called, and is always
2750 the first argument to the function.
2752 ARGS are the remaining arguments in the original call (i.e. all
2753 but the first). In the case of `set-value' in particular,
2754 the first element of ARGS is the value to which the variable
2755 is being set. In some cases, ARGS is sanitized from what was
2756 actually given. For example, whenever `nil' is passed to an
2757 argument and it means `current-buffer', the current buffer is
2758 substituted instead.
2760 FUN is a symbol indicating which function is being called.
2761 For many of the functions, you can determine the corresponding
2762 function of a different class using
2763 `symbol-function-corresponding-function'.
2765 HARG is the argument that was given in the call
2766 to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
2768 HANDLERS is a structure containing the remaining handlers
2769 for the variable; to call one of them, use
2770 `chain-to-symbol-value-handler'.
2772 NOTE: You may *not* modify the list in ARGS, and if you want to
2773 keep it around after the handler function exits, you must make
2774 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
2777 static enum lisp_magic_handler
2778 decode_magic_handler_type (Lisp_Object symbol)
2780 if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE;
2781 if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE;
2782 if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE;
2783 if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND;
2784 if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE;
2785 if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL;
2787 signal_simple_error ("Unrecognized symbol value handler type", symbol);
2789 return MAGIC_HANDLER_MAX;
2792 static enum lisp_magic_handler
2793 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
2795 if (EQ (funsym, Qsymbol_value)
2796 || EQ (funsym, Qdefault_value)
2797 || EQ (funsym, Qsymbol_value_in_buffer)
2798 || EQ (funsym, Qsymbol_value_in_console))
2799 return MAGIC_HANDLER_GET_VALUE;
2801 if (EQ (funsym, Qset)
2802 || EQ (funsym, Qset_default))
2803 return MAGIC_HANDLER_SET_VALUE;
2805 if (EQ (funsym, Qboundp)
2806 || EQ (funsym, Qglobally_boundp)
2807 || EQ (funsym, Qdefault_boundp))
2808 return MAGIC_HANDLER_BOUND_PREDICATE;
2810 if (EQ (funsym, Qmakunbound))
2811 return MAGIC_HANDLER_MAKE_UNBOUND;
2813 if (EQ (funsym, Qlocal_variable_p))
2814 return MAGIC_HANDLER_LOCAL_PREDICATE;
2816 if (EQ (funsym, Qmake_variable_buffer_local)
2817 || EQ (funsym, Qmake_local_variable))
2818 return MAGIC_HANDLER_MAKE_LOCAL;
2820 if (abort_if_not_found)
2822 signal_simple_error ("Unrecognized symbol-value function", funsym);
2823 return MAGIC_HANDLER_MAX;
2827 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
2829 /* does not take into account variable aliasing. */
2830 Lisp_Object valcontents = XSYMBOL (sym)->value;
2831 enum lisp_magic_handler slot;
2833 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2835 slot = handler_type_from_function_symbol (funsym, 1);
2836 if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND
2837 && slot != MAGIC_HANDLER_MAKE_LOCAL)
2838 /* #### temporary kludge because we haven't implemented
2839 lisp-magic variables completely */
2841 return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
2845 fetch_value_maybe_past_magic (Lisp_Object sym,
2846 Lisp_Object follow_past_lisp_magic)
2848 Lisp_Object value = XSYMBOL (sym)->value;
2849 if (SYMBOL_VALUE_LISP_MAGIC_P (value)
2850 && (EQ (follow_past_lisp_magic, Qt)
2851 || (!NILP (follow_past_lisp_magic)
2852 && !would_be_magic_handled (sym, follow_past_lisp_magic))))
2853 value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed;
2857 static Lisp_Object *
2858 value_slot_past_magic (Lisp_Object sym)
2860 Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
2862 if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
2863 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
2864 return store_pointer;
2868 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
2871 Lisp_Object args[20]; /* should be enough ... */
2873 enum lisp_magic_handler htype;
2874 Lisp_Object legerdemain;
2875 struct symbol_value_lisp_magic *bfwd;
2877 assert (nargs >= 0 && nargs < countof (args));
2878 legerdemain = XSYMBOL (sym)->value;
2879 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2880 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2882 va_start (vargs, nargs);
2883 for (i = 0; i < nargs; i++)
2884 args[i] = va_arg (vargs, Lisp_Object);
2887 htype = handler_type_from_function_symbol (funsym, 1);
2888 if (NILP (bfwd->handler[htype]))
2890 /* #### should be reusing the arglist, not always consing anew.
2891 Repeated handler invocations should not cause repeated consing.
2892 Doesn't matter for now, because this is just a quick implementation
2893 for obsolescence support. */
2894 return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym,
2895 bfwd->harg[htype], Qnil);
2898 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
2900 Don't you dare use this.
2901 If you do, suffer the wrath of Ben, who is likely to rename
2902 this function (or change the semantics of its arguments) without
2903 pity, thereby invalidating your code.
2905 (variable, handler_type, handler, harg, keep_existing))
2907 Lisp_Object valcontents;
2908 struct symbol_value_lisp_magic *bfwd;
2909 enum lisp_magic_handler htype;
2912 /* #### WARNING, only some handler types are implemented. See above.
2913 Actions of other types will ignore a handler if it's there.
2915 #### Also, `chain-to-symbol-value-handler' and
2916 `symbol-function-corresponding-function' are not implemented. */
2917 CHECK_SYMBOL (variable);
2918 CHECK_SYMBOL (handler_type);
2919 htype = decode_magic_handler_type (handler_type);
2920 valcontents = XSYMBOL (variable)->value;
2921 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2923 bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
2924 &lrecord_symbol_value_lisp_magic);
2925 bfwd->magic.type = SYMVAL_LISP_MAGIC;
2926 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2928 bfwd->handler[i] = Qnil;
2929 bfwd->harg[i] = Qnil;
2931 bfwd->shadowed = valcontents;
2932 XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
2935 bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
2936 bfwd->handler[htype] = handler;
2937 bfwd->harg[htype] = harg;
2939 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2940 if (!NILP (bfwd->handler[i]))
2943 if (i == MAGIC_HANDLER_MAX)
2944 /* there are no remaining handlers, so remove the structure. */
2945 XSYMBOL (variable)->value = bfwd->shadowed;
2951 /* functions for working with variable aliases. */
2953 /* Follow the chain of variable aliases for SYMBOL. Return the
2954 resulting symbol, whose value cell is guaranteed not to be a
2955 symbol-value-varalias.
2957 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
2958 If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
2959 never follow; stop right there. Otherwise FUNSYM should be a
2960 recognized symbol-value function symbol; this means, follow
2961 unless there is a special handler for the named function.
2963 OK, there is at least one reason why it's necessary for
2964 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
2965 can always be sure to catch cyclic variable aliasing. If we never
2966 follow past Lisp magic, then if the following is done:
2969 add some magic behavior to a, but not a "get-value" handler
2972 then an attempt to retrieve a's or b's value would cause infinite
2973 looping in `symbol-value'.
2975 We (of course) can't always follow past Lisp magic, because then
2976 we make any variable that is lisp-magic -> varalias behave as if
2977 the lisp-magic is not present at all.
2981 follow_varalias_pointers (Lisp_Object symbol,
2982 Lisp_Object follow_past_lisp_magic)
2984 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
2985 Lisp_Object tortoise, hare, val;
2988 /* quick out just in case */
2989 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value))
2992 /* Compare implementation of indirect_function(). */
2993 for (hare = tortoise = symbol, count = 0;
2994 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic),
2995 SYMBOL_VALUE_VARALIAS_P (val);
2996 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)),
2999 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue;
3002 tortoise = symbol_value_varalias_aliasee
3003 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic
3004 (tortoise, follow_past_lisp_magic)));
3005 if (EQ (hare, tortoise))
3006 return Fsignal (Qcyclic_variable_indirection, list1 (symbol));
3012 DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
3013 Define a variable as an alias for another variable.
3014 Thenceforth, any operations performed on VARIABLE will actually be
3015 performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
3016 If ALIAS is nil, remove any aliases for VARIABLE.
3017 ALIAS can itself be aliased, and the chain of variable aliases
3018 will be followed appropriately.
3019 If VARIABLE already has a value, this value will be shadowed
3020 until the alias is removed, at which point it will be restored.
3021 Currently VARIABLE cannot be a built-in variable, a variable that
3022 has a buffer-local value in any buffer, or the symbols nil or t.
3023 \(ALIAS, however, can be any type of variable.)
3027 struct symbol_value_varalias *bfwd;
3028 Lisp_Object valcontents;
3030 CHECK_SYMBOL (variable);
3031 reject_constant_symbols (variable, Qunbound, 0, Qt);
3033 valcontents = XSYMBOL (variable)->value;
3037 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3039 XSYMBOL (variable)->value =
3040 symbol_value_varalias_shadowed
3041 (XSYMBOL_VALUE_VARALIAS (valcontents));
3046 CHECK_SYMBOL (alias);
3047 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3050 XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
3054 if (SYMBOL_VALUE_MAGIC_P (valcontents)
3055 && !UNBOUNDP (valcontents))
3056 signal_simple_error ("Variable is magic and cannot be aliased", variable);
3057 reject_constant_symbols (variable, Qunbound, 0, Qt);
3059 bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
3060 &lrecord_symbol_value_varalias);
3061 bfwd->magic.type = SYMVAL_VARALIAS;
3062 bfwd->aliasee = alias;
3063 bfwd->shadowed = valcontents;
3065 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
3066 XSYMBOL (variable)->value = valcontents;
3070 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
3071 If VARIABLE is aliased to another variable, return that variable.
3072 VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
3073 Variable aliases are created with `defvaralias'. See also
3074 `indirect-variable'.
3076 (variable, follow_past_lisp_magic))
3078 Lisp_Object valcontents;
3080 CHECK_SYMBOL (variable);
3081 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3083 CHECK_SYMBOL (follow_past_lisp_magic);
3084 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3087 valcontents = fetch_value_maybe_past_magic (variable,
3088 follow_past_lisp_magic);
3090 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3091 return symbol_value_varalias_aliasee
3092 (XSYMBOL_VALUE_VARALIAS (valcontents));
3097 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /*
3098 Return the variable at the end of OBJECT's variable-alias chain.
3099 If OBJECT is a symbol, follow all variable aliases and return
3100 the final (non-aliased) symbol. Variable aliases are created with
3101 the function `defvaralias'.
3102 If OBJECT is not a symbol, just return it.
3103 Signal a cyclic-variable-indirection error if there is a loop in the
3104 variable chain of symbols.
3106 (object, follow_past_lisp_magic))
3108 if (!SYMBOLP (object))
3110 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3112 CHECK_SYMBOL (follow_past_lisp_magic);
3113 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3115 return follow_varalias_pointers (object, follow_past_lisp_magic);
3119 /************************************************************************/
3120 /* initialization */
3121 /************************************************************************/
3123 /* A dumped XEmacs image has a lot more than 1511 symbols. Last
3124 estimate was that there were actually around 6300. So let's try
3125 making this bigger and see if we get better hashing behavior. */
3126 #define OBARRAY_SIZE 16411
3131 #ifndef Qnull_pointer
3132 Lisp_Object Qnull_pointer;
3135 /* some losing systems can't have static vars at function scope... */
3136 static const struct symbol_value_magic guts_of_unbound_marker =
3137 { /* struct symbol_value_magic */
3138 { /* struct lcrecord_header */
3139 { /* struct lrecord_header */
3140 lrecord_type_symbol_value_forward, /* lrecord_type_index */
3142 1, /* c_readonly bit */
3143 1, /* lisp_readonly bit */
3150 SYMVAL_UNBOUND_MARKER
3154 init_symbols_once_early (void)
3156 INIT_LRECORD_IMPLEMENTATION (symbol);
3157 INIT_LRECORD_IMPLEMENTATION (symbol_value_forward);
3158 INIT_LRECORD_IMPLEMENTATION (symbol_value_buffer_local);
3159 INIT_LRECORD_IMPLEMENTATION (symbol_value_lisp_magic);
3160 INIT_LRECORD_IMPLEMENTATION (symbol_value_varalias);
3162 reinit_symbols_once_early ();
3164 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3165 called the first time. */
3166 Qnil = Fmake_symbol (make_string_nocopy ((const Bufbyte *) "nil", 3));
3167 XSYMBOL (Qnil)->name->plist = Qnil;
3168 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
3169 XSYMBOL (Qnil)->plist = Qnil;
3171 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3172 initial_obarray = Vobarray;
3173 staticpro (&initial_obarray);
3174 /* Intern nil in the obarray */
3176 int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
3177 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3181 /* Required to get around a GCC syntax error on certain
3183 const struct symbol_value_magic *tem = &guts_of_unbound_marker;
3185 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3188 XSYMBOL (Qnil)->function = Qunbound;
3190 defsymbol (&Qt, "t");
3191 XSYMBOL (Qt)->value = Qt; /* Veritas aetera */
3195 pdump_wire (&Qunbound);
3196 pdump_wire (&Vquit_flag);
3200 reinit_symbols_once_early (void)
3203 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3206 #ifndef Qnull_pointer
3207 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3208 so the following is actually a no-op. */
3209 XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
3214 defsymbol_nodump (Lisp_Object *location, const char *name)
3216 *location = Fintern (make_string_nocopy ((const Bufbyte *) name,
3219 staticpro_nodump (location);
3223 defsymbol (Lisp_Object *location, const char *name)
3225 *location = Fintern (make_string_nocopy ((const Bufbyte *) name,
3228 staticpro (location);
3232 defkeyword (Lisp_Object *location, const char *name)
3234 defsymbol (location, name);
3235 Fset (*location, *location);
3239 /* Check that nobody spazzed writing a DEFUN. */
3241 check_sane_subr (Lisp_Subr *subr, Lisp_Object sym)
3243 assert (subr->min_args >= 0);
3244 assert (subr->min_args <= SUBR_MAX_ARGS);
3246 if (subr->max_args != MANY &&
3247 subr->max_args != UNEVALLED)
3249 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3250 assert (subr->max_args <= SUBR_MAX_ARGS);
3251 assert (subr->min_args <= subr->max_args);
3254 assert (UNBOUNDP (XSYMBOL (sym)->function));
3257 #define check_sane_subr(subr, sym) /* nothing */
3262 * If we are not in a pure undumped Emacs, we need to make a duplicate of
3263 * the subr. This is because the only time this function will be called
3264 * in a running Emacs is when a dynamically loaded module is adding a
3265 * subr, and we need to make sure that the subr is in allocated, Lisp-
3266 * accessible memory. The address assigned to the static subr struct
3267 * in the shared object will be a trampoline address, so we need to create
3268 * a copy here to ensure that a real address is used.
3270 * Once we have copied everything across, we re-use the original static
3271 * structure to store a pointer to the newly allocated one. This will be
3272 * used in emodules.c by emodules_doc_subr() to find a pointer to the
3273 * allocated object so that we can set its doc string propperly.
3275 * NOTE: We dont actually use the DOC pointer here any more, but we did
3276 * in an earlier implementation of module support. There is no harm in
3277 * setting it here in case we ever need it in future implementations.
3278 * subr->doc will point to the new subr structure that was allocated.
3279 * Code can then get this value from the statis subr structure and use
3282 * FIXME: Should newsubr be staticpro()'ed? I dont think so but I need
3285 #define check_module_subr() \
3287 if (initialized) { \
3288 Lisp_Subr *newsubr = (Lisp_Subr *) xmalloc (sizeof (Lisp_Subr)); \
3289 memcpy (newsubr, subr, sizeof (Lisp_Subr)); \
3290 subr->doc = (const char *)newsubr; \
3294 #else /* ! HAVE_SHLIB */
3295 #define check_module_subr()
3299 defsubr (Lisp_Subr *subr)
3301 Lisp_Object sym = intern (subr_name (subr));
3304 check_sane_subr (subr, sym);
3305 check_module_subr ();
3307 XSETSUBR (fun, subr);
3308 XSYMBOL (sym)->function = fun;
3311 /* Define a lisp macro using a Lisp_Subr. */
3313 defsubr_macro (Lisp_Subr *subr)
3315 Lisp_Object sym = intern (subr_name (subr));
3318 check_sane_subr (subr, sym);
3319 check_module_subr();
3321 XSETSUBR (fun, subr);
3322 XSYMBOL (sym)->function = Fcons (Qmacro, fun);
3326 deferror (Lisp_Object *symbol, const char *name, const char *messuhhj,
3327 Lisp_Object inherits_from)
3330 defsymbol (symbol, name);
3332 assert (SYMBOLP (inherits_from));
3333 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3334 Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3335 /* NOT build_translated_string (). This function is called at load time
3336 and the string needs to get translated at run time. (This happens
3337 in the function (display-error) in cmdloop.el.) */
3338 Fput (*symbol, Qerror_message, build_string (messuhhj));
3342 syms_of_symbols (void)
3344 defsymbol (&Qvariable_documentation, "variable-documentation");
3345 defsymbol (&Qvariable_domain, "variable-domain"); /* I18N3 */
3346 defsymbol (&Qad_advice_info, "ad-advice-info");
3347 defsymbol (&Qad_activate, "ad-activate");
3349 defsymbol (&Qget_value, "get-value");
3350 defsymbol (&Qset_value, "set-value");
3351 defsymbol (&Qbound_predicate, "bound-predicate");
3352 defsymbol (&Qmake_unbound, "make-unbound");
3353 defsymbol (&Qlocal_predicate, "local-predicate");
3354 defsymbol (&Qmake_local, "make-local");
3356 defsymbol (&Qboundp, "boundp");
3357 defsymbol (&Qglobally_boundp, "globally-boundp");
3358 defsymbol (&Qmakunbound, "makunbound");
3359 defsymbol (&Qsymbol_value, "symbol-value");
3360 defsymbol (&Qset, "set");
3361 defsymbol (&Qsetq_default, "setq-default");
3362 defsymbol (&Qdefault_boundp, "default-boundp");
3363 defsymbol (&Qdefault_value, "default-value");
3364 defsymbol (&Qset_default, "set-default");
3365 defsymbol (&Qmake_variable_buffer_local, "make-variable-buffer-local");
3366 defsymbol (&Qmake_local_variable, "make-local-variable");
3367 defsymbol (&Qkill_local_variable, "kill-local-variable");
3368 defsymbol (&Qkill_console_local_variable, "kill-console-local-variable");
3369 defsymbol (&Qsymbol_value_in_buffer, "symbol-value-in-buffer");
3370 defsymbol (&Qsymbol_value_in_console, "symbol-value-in-console");
3371 defsymbol (&Qlocal_variable_p, "local-variable-p");
3373 defsymbol (&Qconst_integer, "const-integer");
3374 defsymbol (&Qconst_boolean, "const-boolean");
3375 defsymbol (&Qconst_object, "const-object");
3376 defsymbol (&Qconst_specifier, "const-specifier");
3377 defsymbol (&Qdefault_buffer, "default-buffer");
3378 defsymbol (&Qcurrent_buffer, "current-buffer");
3379 defsymbol (&Qconst_current_buffer, "const-current-buffer");
3380 defsymbol (&Qdefault_console, "default-console");
3381 defsymbol (&Qselected_console, "selected-console");
3382 defsymbol (&Qconst_selected_console, "const-selected-console");
3385 DEFSUBR (Fintern_soft);
3386 DEFSUBR (Funintern);
3387 DEFSUBR (Fmapatoms);
3388 DEFSUBR (Fapropos_internal);
3390 DEFSUBR (Fsymbol_function);
3391 DEFSUBR (Fsymbol_plist);
3392 DEFSUBR (Fsymbol_name);
3393 DEFSUBR (Fmakunbound);
3394 DEFSUBR (Ffmakunbound);
3396 DEFSUBR (Fglobally_boundp);
3399 DEFSUBR (Fdefine_function);
3400 Ffset (intern ("defalias"), intern ("define-function"));
3401 DEFSUBR (Fsetplist);
3402 DEFSUBR (Fsymbol_value_in_buffer);
3403 DEFSUBR (Fsymbol_value_in_console);
3404 DEFSUBR (Fbuilt_in_variable_type);
3405 DEFSUBR (Fsymbol_value);
3407 DEFSUBR (Fdefault_boundp);
3408 DEFSUBR (Fdefault_value);
3409 DEFSUBR (Fset_default);
3410 DEFSUBR (Fsetq_default);
3411 DEFSUBR (Fmake_variable_buffer_local);
3412 DEFSUBR (Fmake_local_variable);
3413 DEFSUBR (Fkill_local_variable);
3414 DEFSUBR (Fkill_console_local_variable);
3415 DEFSUBR (Flocal_variable_p);
3416 DEFSUBR (Fdefvaralias);
3417 DEFSUBR (Fvariable_alias);
3418 DEFSUBR (Findirect_variable);
3419 DEFSUBR (Fdontusethis_set_symbol_value_handler);
3422 /* Create and initialize a Lisp variable whose value is forwarded to C data */
3424 defvar_magic (const char *symbol_name, const struct symbol_value_forward *magic)
3428 #if defined(HAVE_SHLIB)
3430 * As with defsubr(), this will only be called in a dumped Emacs when
3431 * we are adding variables from a dynamically loaded module. That means
3432 * we can't use purespace. Take that into account.
3435 sym = Fintern (build_string (symbol_name), Qnil);
3438 sym = Fintern (make_string_nocopy ((const Bufbyte *) symbol_name,
3439 strlen (symbol_name)), Qnil);
3441 XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic);
3445 vars_of_symbols (void)
3447 DEFVAR_LISP ("obarray", &Vobarray /*
3448 Symbol table for use by `intern' and `read'.
3449 It is a vector whose length ought to be prime for best results.
3450 The vector's contents don't make sense if examined from Lisp programs;
3451 to find all the symbols in an obarray, use `mapatoms'.
3453 /* obarray has been initialized long before */