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 struct 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(struct Lisp_Symbol, next), 5 },
116 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
117 mark_symbol, print_symbol, 0, 0, 0,
118 symbol_description, struct Lisp_Symbol);
121 /**********************************************************************/
123 /**********************************************************************/
125 /* #### using a vector here is way bogus. Use a hash table instead. */
127 Lisp_Object Vobarray;
129 static Lisp_Object initial_obarray;
131 /* oblookup stores the bucket number here, for the sake of Funintern. */
133 static int oblookup_last_bucket_number;
136 check_obarray (Lisp_Object obarray)
138 while (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
140 /* If Vobarray is now invalid, force it to be valid. */
141 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
143 obarray = wrong_type_argument (Qvectorp, obarray);
149 intern (CONST char *str)
151 Bytecount len = strlen (str);
152 CONST Bufbyte *buf = (CONST Bufbyte *) str;
153 Lisp_Object obarray = Vobarray;
155 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
156 obarray = check_obarray (obarray);
159 Lisp_Object tem = oblookup (obarray, buf, len);
164 return Fintern (make_string (buf, len), obarray);
167 DEFUN ("intern", Fintern, 1, 2, 0, /*
168 Return the canonical symbol whose name is STRING.
169 If there is none, one is created by this function and returned.
170 A second optional argument specifies the obarray to use;
171 it defaults to the value of `obarray'.
175 Lisp_Object object, *ptr;
176 struct Lisp_Symbol *symbol;
179 if (NILP (obarray)) obarray = Vobarray;
180 obarray = check_obarray (obarray);
182 CHECK_STRING (string);
184 len = XSTRING_LENGTH (string);
185 object = oblookup (obarray, XSTRING_DATA (string), len);
190 ptr = &XVECTOR_DATA (obarray)[XINT (object)];
192 object = Fmake_symbol (string);
193 symbol = XSYMBOL (object);
196 symbol_next (symbol) = XSYMBOL (*ptr);
198 symbol_next (symbol) = 0;
201 if (string_byte (symbol_name (symbol), 0) == ':' && EQ (obarray, Vobarray))
203 /* The LISP way is to put keywords in their own package, but we
204 don't have packages, so we do something simpler. Someday,
205 maybe we'll have packages and then this will be reworked.
207 symbol_value (symbol) = object;
213 DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /*
214 Return the canonical symbol named NAME, or nil if none exists.
215 NAME may be a string or a symbol. If it is a symbol, that exact
216 symbol is searched for.
217 A second optional argument specifies the obarray to use;
218 it defaults to the value of `obarray'.
222 /* #### Bug! (intern-soft "nil") returns nil. Perhaps we should
223 add a DEFAULT-IF-NOT-FOUND arg, like in get. */
225 struct Lisp_String *string;
227 if (NILP (obarray)) obarray = Vobarray;
228 obarray = check_obarray (obarray);
233 string = XSTRING (name);
236 string = symbol_name (XSYMBOL (name));
238 tem = oblookup (obarray, string_data (string), string_length (string));
239 if (INTP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
245 DEFUN ("unintern", Funintern, 1, 2, 0, /*
246 Delete the symbol named NAME, if any, from OBARRAY.
247 The value is t if a symbol was found and deleted, nil otherwise.
248 NAME may be a string or a symbol. If it is a symbol, that symbol
249 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
250 OBARRAY defaults to the value of the variable `obarray'
255 struct Lisp_String *string;
258 if (NILP (obarray)) obarray = Vobarray;
259 obarray = check_obarray (obarray);
262 string = symbol_name (XSYMBOL (name));
266 string = XSTRING (name);
269 tem = oblookup (obarray, string_data (string), string_length (string));
272 /* If arg was a symbol, don't delete anything but that symbol itself. */
273 if (SYMBOLP (name) && !EQ (name, tem))
276 hash = oblookup_last_bucket_number;
278 if (EQ (XVECTOR_DATA (obarray)[hash], tem))
280 if (XSYMBOL (tem)->next)
281 XSETSYMBOL (XVECTOR_DATA (obarray)[hash], XSYMBOL (tem)->next);
283 XVECTOR_DATA (obarray)[hash] = Qzero;
287 Lisp_Object tail, following;
289 for (tail = XVECTOR_DATA (obarray)[hash];
290 XSYMBOL (tail)->next;
293 XSETSYMBOL (following, XSYMBOL (tail)->next);
294 if (EQ (following, tem))
296 XSYMBOL (tail)->next = XSYMBOL (following)->next;
304 /* Return the symbol in OBARRAY whose names matches the string
305 of SIZE characters at PTR. If there is no such symbol in OBARRAY,
306 return the index into OBARRAY that the string hashes to.
308 Also store the bucket number in oblookup_last_bucket_number. */
311 oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size)
314 struct Lisp_Symbol *tail;
317 if (!VECTORP (obarray) ||
318 (obsize = XVECTOR_LENGTH (obarray)) == 0)
320 obarray = check_obarray (obarray);
321 obsize = XVECTOR_LENGTH (obarray);
323 hash = hash_string (ptr, size) % obsize;
324 oblookup_last_bucket_number = hash;
325 bucket = XVECTOR_DATA (obarray)[hash];
328 else if (!SYMBOLP (bucket))
329 error ("Bad data in guts of obarray"); /* Like CADR error message */
331 for (tail = XSYMBOL (bucket); ;)
333 if (string_length (tail->name) == size &&
334 !memcmp (string_data (tail->name), ptr, size))
336 XSETSYMBOL (bucket, tail);
339 tail = symbol_next (tail);
343 return make_int (hash);
346 #if 0 /* Emacs 19.34 */
348 hash_string (CONST Bufbyte *ptr, Bytecount len)
350 CONST Bufbyte *p = ptr;
351 CONST Bufbyte *end = p + len;
358 if (c >= 0140) c -= 40;
359 hash = ((hash<<3) + (hash>>28) + c);
361 return hash & 07777777777;
365 /* derived from hashpjw, Dragon Book P436. */
367 hash_string (CONST Bufbyte *ptr, Bytecount len)
374 hash = (hash << 4) + *ptr++;
375 g = hash & 0xf0000000;
377 hash = (hash ^ (g >> 24)) ^ g;
379 return hash & 07777777777;
382 /* Map FN over OBARRAY. The mapping is stopped when FN returns a
385 map_obarray (Lisp_Object obarray,
386 int (*fn) (Lisp_Object, void *), void *arg)
390 CHECK_VECTOR (obarray);
391 for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--)
393 Lisp_Object tail = XVECTOR_DATA (obarray)[i];
397 struct Lisp_Symbol *next;
398 if ((*fn) (tail, arg))
400 next = symbol_next (XSYMBOL (tail));
403 XSETSYMBOL (tail, next);
409 mapatoms_1 (Lisp_Object sym, void *arg)
411 call1 (*(Lisp_Object *)arg, sym);
415 DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /*
416 Call FUNCTION on every symbol in OBARRAY.
417 OBARRAY defaults to the value of `obarray'.
423 obarray = check_obarray (obarray);
425 map_obarray (obarray, mapatoms_1, &function);
430 /**********************************************************************/
432 /**********************************************************************/
434 struct appropos_mapper_closure
437 Lisp_Object predicate;
438 Lisp_Object accumulation;
442 apropos_mapper (Lisp_Object symbol, void *arg)
444 struct appropos_mapper_closure *closure =
445 (struct appropos_mapper_closure *) arg;
446 Bytecount match = fast_lisp_string_match (closure->regexp,
447 Fsymbol_name (symbol));
450 (NILP (closure->predicate) ||
451 !NILP (call1 (closure->predicate, symbol))))
452 closure->accumulation = Fcons (symbol, closure->accumulation);
457 DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /*
458 Show all symbols whose names contain match for REGEXP.
459 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL)
460 is done for each symbol and a symbol is mentioned only if that
462 Return list of symbols found.
466 struct appropos_mapper_closure closure;
468 CHECK_STRING (regexp);
470 closure.regexp = regexp;
471 closure.predicate = predicate;
472 closure.accumulation = Qnil;
473 map_obarray (Vobarray, apropos_mapper, &closure);
474 closure.accumulation = Fsort (closure.accumulation, Qstring_lessp);
475 return closure.accumulation;
479 /* Extract and set components of symbols */
481 static void set_up_buffer_local_cache (Lisp_Object sym,
482 struct symbol_value_buffer_local *bfwd,
484 Lisp_Object new_alist_el,
487 DEFUN ("boundp", Fboundp, 1, 1, 0, /*
488 Return t if SYMBOL's value is not void.
492 CHECK_SYMBOL (symbol);
493 return UNBOUNDP (find_symbol_value (symbol)) ? Qnil : Qt;
496 DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /*
497 Return t if SYMBOL has a global (non-bound) value.
498 This is for the byte-compiler; you really shouldn't be using this.
502 CHECK_SYMBOL (symbol);
503 return UNBOUNDP (top_level_value (symbol)) ? Qnil : Qt;
506 DEFUN ("fboundp", Ffboundp, 1, 1, 0, /*
507 Return t if SYMBOL's function definition is not void.
511 CHECK_SYMBOL (symbol);
512 return UNBOUNDP (XSYMBOL (symbol)->function) ? Qnil : Qt;
515 /* Return non-zero if SYM's value or function (the current contents of
516 which should be passed in as VAL) is constant, i.e. unsettable. */
519 symbol_is_constant (Lisp_Object sym, Lisp_Object val)
521 /* #### - I wonder if it would be better to just have a new magic value
522 type and make nil, t, and all keywords have that same magic
523 constant_symbol value. This test is awfully specific about what is
524 constant and what isn't. --Stig */
525 if (EQ (sym, Qnil) ||
529 if (SYMBOL_VALUE_MAGIC_P (val))
530 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
532 case SYMVAL_CONST_OBJECT_FORWARD:
533 case SYMVAL_CONST_SPECIFIER_FORWARD:
534 case SYMVAL_CONST_FIXNUM_FORWARD:
535 case SYMVAL_CONST_BOOLEAN_FORWARD:
536 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
537 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
539 default: break; /* Warning suppression */
542 /* We don't return true for keywords here because they are handled
543 specially by reject_constant_symbols(). */
547 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
548 non-zero) to NEWVAL. Make sure this is allowed.
549 FOLLOW_PAST_LISP_MAGIC specifies whether we delve past
550 symbol-value-lisp-magic objects. */
553 reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p,
554 Lisp_Object follow_past_lisp_magic)
557 (function_p ? XSYMBOL (sym)->function
558 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
560 if (SYMBOL_VALUE_MAGIC_P (val) &&
561 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
562 signal_simple_error ("Use `set-specifier' to change a specifier's value",
565 if (symbol_is_constant (sym, val)
566 || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)))
567 signal_error (Qsetting_constant,
568 UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
571 /* Verify that it's ok to make SYM buffer-local. This rejects
572 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC
573 specifies whether we delve into symbol-value-lisp-magic objects.
574 (Should be a symbol indicating what action is being taken; that way,
575 we don't delve if there's a handler for that action, but do otherwise.) */
578 verify_ok_for_buffer_local (Lisp_Object sym,
579 Lisp_Object follow_past_lisp_magic)
581 Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic);
583 if (symbol_is_constant (sym, val))
585 if (SYMBOL_VALUE_MAGIC_P (val))
586 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
588 case SYMVAL_DEFAULT_BUFFER_FORWARD:
589 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
590 /* #### It's theoretically possible for it to be reasonable
591 to have both console-local and buffer-local variables,
592 but I don't want to consider that right now. */
593 case SYMVAL_SELECTED_CONSOLE_FORWARD:
595 default: break; /* Warning suppression */
601 signal_error (Qerror,
602 list2 (build_string ("Symbol may not be buffer-local"), sym));
605 DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /*
606 Make SYMBOL's value be void.
610 Fset (symbol, Qunbound);
614 DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /*
615 Make SYMBOL's function definition be void.
619 CHECK_SYMBOL (symbol);
620 reject_constant_symbols (symbol, Qunbound, 1, Qt);
621 XSYMBOL (symbol)->function = Qunbound;
625 DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /*
626 Return SYMBOL's function definition. Error if that is void.
630 CHECK_SYMBOL (symbol);
631 if (UNBOUNDP (XSYMBOL (symbol)->function))
632 signal_void_function_error (symbol);
633 return XSYMBOL (symbol)->function;
636 DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /*
637 Return SYMBOL's property list.
641 CHECK_SYMBOL (symbol);
642 return XSYMBOL (symbol)->plist;
645 DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /*
646 Return SYMBOL's name, a string.
652 CHECK_SYMBOL (symbol);
653 XSETSTRING (name, XSYMBOL (symbol)->name);
657 DEFUN ("fset", Ffset, 2, 2, 0, /*
658 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
662 /* This function can GC */
663 CHECK_SYMBOL (symbol);
664 reject_constant_symbols (symbol, newdef, 1, Qt);
665 if (!NILP (Vautoload_queue) && !UNBOUNDP (XSYMBOL (symbol)->function))
666 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
668 XSYMBOL (symbol)->function = newdef;
669 /* Handle automatic advice activation */
670 if (CONSP (XSYMBOL (symbol)->plist) &&
671 !NILP (Fget (symbol, Qad_advice_info, Qnil)))
673 call2 (Qad_activate, symbol, Qnil);
674 newdef = XSYMBOL (symbol)->function;
680 DEFUN ("define-function", Fdefine_function, 2, 2, 0, /*
681 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
682 Associates the function with the current load file, if any.
686 /* This function can GC */
687 Ffset (symbol, newdef);
688 LOADHIST_ATTACH (symbol);
693 DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
694 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
698 CHECK_SYMBOL (symbol);
699 #if 0 /* Inserted for debugging 6/28/1997 -slb */
700 /* Somebody is setting a property list of integer 0, who? */
701 /* Not this way apparently. */
702 if (EQ(newplist, Qzero)) abort();
705 XSYMBOL (symbol)->plist = newplist;
710 /**********************************************************************/
712 /**********************************************************************/
714 /* If the contents of the value cell of a symbol is one of the following
715 three types of objects, then the symbol is "magic" in that setting
716 and retrieving its value doesn't just set or retrieve the raw
717 contents of the value cell. None of these objects can escape to
718 the user level, so there is no loss of generality.
720 If a symbol is "unbound", then the contents of its value cell is
721 Qunbound. Despite appearances, this is *not* a symbol, but is a
722 symbol-value-forward object. This is so that printing it results
723 in "INTERNAL OBJECT (XEmacs bug?)", in case it leaks to Lisp, somehow.
725 Logically all of the following objects are "symbol-value-magic"
726 objects, and there are some games played w.r.t. this (#### this
727 should be cleaned up). SYMBOL_VALUE_MAGIC_P is true for all of
728 the object types. XSYMBOL_VALUE_MAGIC_TYPE returns the type of
729 symbol-value-magic object. There are more than three types
730 returned by this macro: in particular, symbol-value-forward
731 has eight subtypes, and symbol-value-buffer-local has two. See
734 1. symbol-value-forward
736 symbol-value-forward is used for variables whose actual contents
737 are stored in a C variable of some sort, and for Qunbound. The
738 lcheader.next field (which is only used to chain together free
739 lcrecords) holds a pointer to the actual C variable. Included
740 in this type are "buffer-local" variables that are actually
741 stored in the buffer object itself; in this case, the "pointer"
742 is an offset into the struct buffer structure.
744 The subtypes are as follows:
746 SYMVAL_OBJECT_FORWARD:
747 (declare with DEFVAR_LISP)
748 The value of this variable is stored in a C variable of type
749 "Lisp_Object". Setting this variable sets the C variable.
750 Accessing this variable retrieves a value from the C variable.
751 These variables can be buffer-local -- in this case, the
752 raw symbol-value field gets converted into a
753 symbol-value-buffer-local, whose "current_value" slot contains
754 the symbol-value-forward. (See below.)
756 SYMVAL_FIXNUM_FORWARD:
757 SYMVAL_BOOLEAN_FORWARD:
758 (declare with DEFVAR_INT or DEFVAR_BOOL)
759 Similar to SYMVAL_OBJECT_FORWARD except that the C variable
760 is of type "int" and is an integer or boolean, respectively.
762 SYMVAL_CONST_OBJECT_FORWARD:
763 SYMVAL_CONST_FIXNUM_FORWARD:
764 SYMVAL_CONST_BOOLEAN_FORWARD:
765 (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
767 Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
768 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
771 SYMVAL_CONST_SPECIFIER_FORWARD:
772 (declare with DEFVAR_SPECIFIER)
773 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that error message
774 you get when attempting to set the value says to use
775 `set-specifier' instead.
777 SYMVAL_CURRENT_BUFFER_FORWARD:
778 (declare with DEFVAR_BUFFER_LOCAL)
779 This is used for built-in buffer-local variables -- i.e.
780 Lisp variables whose value is stored in the "struct buffer".
781 Variables of this sort always forward into C "Lisp_Object"
782 fields (although there's no reason in principle that other
783 types for ints and booleans couldn't be added). Note that
784 some of these variables are automatically local in each
785 buffer, while some are only local when they become set
786 (similar to `make-variable-buffer-local'). In these latter
787 cases, of course, the default value shows through in all
788 buffers in which the variable doesn't have a local value.
789 This is implemented by making sure the "struct buffer" field
790 always contains the correct value (whether it's local or
791 a default) and maintaining a mask in the "struct buffer"
792 indicating which fields are local. When `set-default' is
793 called on a variable that's not always local to all buffers,
794 it loops through each buffer and sets the corresponding
795 field in each buffer without a local value for the field,
796 according to the mask.
798 Calling `make-local-variable' on a variable of this sort
799 only has the effect of maybe changing the current buffer's mask.
800 Calling `make-variable-buffer-local' on a variable of this
801 sort has no effect at all.
803 SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
804 (declare with DEFVAR_CONST_BUFFER_LOCAL)
805 Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
808 SYMVAL_DEFAULT_BUFFER_FORWARD:
809 (declare with DEFVAR_BUFFER_DEFAULTS)
810 This is used for the Lisp variables that contain the
811 default values of built-in buffer-local variables. Setting
812 or referencing one of these variables forwards into a slot
813 in the special struct buffer Vbuffer_defaults.
815 SYMVAL_UNBOUND_MARKER:
816 This is used for only one object, Qunbound.
818 SYMVAL_SELECTED_CONSOLE_FORWARD:
819 (declare with DEFVAR_CONSOLE_LOCAL)
820 This is used for built-in console-local variables -- i.e.
821 Lisp variables whose value is stored in the "struct console".
822 These work just like built-in buffer-local variables.
823 However, calling `make-local-variable' or
824 `make-variable-buffer-local' on one of these variables
825 is currently disallowed because that would entail having
826 both console-local and buffer-local variables, which is
827 trickier to implement.
829 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
830 (declare with DEFVAR_CONST_CONSOLE_LOCAL)
831 Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
834 SYMVAL_DEFAULT_CONSOLE_FORWARD:
835 (declare with DEFVAR_CONSOLE_DEFAULTS)
836 This is used for the Lisp variables that contain the
837 default values of built-in console-local variables. Setting
838 or referencing one of these variables forwards into a slot
839 in the special struct console Vconsole_defaults.
842 2. symbol-value-buffer-local
844 symbol-value-buffer-local is used for variables that have had
845 `make-local-variable' or `make-variable-buffer-local' applied
846 to them. This object contains an alist mapping buffers to
847 values. In addition, the object contains a "current value",
848 which is the value in some buffer. Whenever you access the
849 variable with `symbol-value' or set it with `set' or `setq',
850 things are switched around so that the "current value"
851 refers to the current buffer, if it wasn't already. This
852 way, repeated references to a variable in the same buffer
853 are almost as efficient as if the variable weren't buffer
854 local. Note that the alist may not be up-to-date w.r.t.
855 the buffer whose value is current, as the "current value"
856 cache is normally only flushed into the alist when the
857 buffer it refers to changes.
859 Note also that it is possible for `make-local-variable'
860 or `make-variable-buffer-local' to be called on a variable
861 that forwards into a C variable (i.e. a variable whose
862 value cell is a symbol-value-forward). In this case,
863 the value cell becomes a symbol-value-buffer-local (as
864 always), and the symbol-value-forward moves into
865 the "current value" cell in this object. Also, in
866 this case the "current value" *always* refers to the
867 current buffer, so that the values of the C variable
868 always is the correct value for the current buffer.
869 set_buffer_internal() automatically updates the current-value
870 cells of all buffer-local variables that forward into C
871 variables. (There is a list of all buffer-local variables
872 that is maintained for this and other purposes.)
874 Note that only certain types of `symbol-value-forward' objects
875 can find their way into the "current value" cell of a
876 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
877 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
878 SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot
879 be buffer-local because they are unsettable;
880 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
881 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
882 does not have much of an effect (it's already buffer-local); and
883 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
884 that's not currently implemented.
887 3. symbol-value-varalias
889 A symbol-value-varalias object is used for variables that
890 are aliases for other variables. This object contains
891 the symbol that this variable is aliased to.
892 symbol-value-varalias objects cannot occur anywhere within
893 a symbol-value-buffer-local object, and most of the
894 low-level functions below do not accept them; you need
895 to call follow_varalias_pointers to get the actual
896 symbol to operate on. */
899 mark_symbol_value_buffer_local (Lisp_Object obj)
901 struct symbol_value_buffer_local *bfwd;
903 #ifdef ERROR_CHECK_TYPECHECK
904 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
905 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
908 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
909 mark_object (bfwd->default_value);
910 mark_object (bfwd->current_value);
911 mark_object (bfwd->current_buffer);
912 return bfwd->current_alist_element;
916 mark_symbol_value_lisp_magic (Lisp_Object obj)
918 struct symbol_value_lisp_magic *bfwd;
921 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
923 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
924 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
926 mark_object (bfwd->handler[i]);
927 mark_object (bfwd->harg[i]);
929 return bfwd->shadowed;
933 mark_symbol_value_varalias (Lisp_Object obj)
935 struct symbol_value_varalias *bfwd;
937 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
939 bfwd = XSYMBOL_VALUE_VARALIAS (obj);
940 mark_object (bfwd->shadowed);
941 return bfwd->aliasee;
944 /* Should never, ever be called. (except by an external debugger) */
946 print_symbol_value_magic (Lisp_Object obj,
947 Lisp_Object printcharfun, int escapeflag)
950 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s type %d) 0x%lx>",
951 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
952 XSYMBOL_VALUE_MAGIC_TYPE (obj),
954 write_c_string (buf, printcharfun);
957 static const struct lrecord_description symbol_value_forward_description[] = {
961 static const struct lrecord_description symbol_value_buffer_local_description[] = {
962 { XD_LISP_OBJECT, offsetof(struct symbol_value_buffer_local, default_value), 1 },
963 { XD_LO_RESET_NIL, offsetof(struct symbol_value_buffer_local, current_value), 3 },
967 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
968 { XD_LISP_OBJECT, offsetof(struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 },
972 static const struct lrecord_description symbol_value_varalias_description[] = {
973 { XD_LISP_OBJECT, offsetof(struct symbol_value_varalias, aliasee), 2 },
977 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
978 symbol_value_forward,
979 this_one_is_unmarkable,
980 print_symbol_value_magic, 0, 0, 0,
981 symbol_value_forward_description,
982 struct symbol_value_forward);
984 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
985 symbol_value_buffer_local,
986 mark_symbol_value_buffer_local,
987 print_symbol_value_magic, 0, 0, 0,
988 symbol_value_buffer_local_description,
989 struct symbol_value_buffer_local);
991 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
992 symbol_value_lisp_magic,
993 mark_symbol_value_lisp_magic,
994 print_symbol_value_magic, 0, 0, 0,
995 symbol_value_lisp_magic_description,
996 struct symbol_value_lisp_magic);
998 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
999 symbol_value_varalias,
1000 mark_symbol_value_varalias,
1001 print_symbol_value_magic, 0, 0, 0,
1002 symbol_value_varalias_description,
1003 struct symbol_value_varalias);
1006 /* Getting and setting values of symbols */
1008 /* Given the raw contents of a symbol value cell, return the Lisp value of
1009 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
1010 symbol-value-lisp-magic, or symbol-value-varalias.
1012 BUFFER specifies a buffer, and is used for built-in buffer-local
1013 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
1014 Note that such variables are never encapsulated in a
1015 symbol-value-buffer-local structure.
1017 CONSOLE specifies a console, and is used for built-in console-local
1018 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
1019 Note that such variables are (currently) never encapsulated in a
1020 symbol-value-buffer-local structure.
1024 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
1025 struct console *console)
1027 CONST struct symbol_value_forward *fwd;
1029 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1032 fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1033 switch (fwd->magic.type)
1035 case SYMVAL_FIXNUM_FORWARD:
1036 case SYMVAL_CONST_FIXNUM_FORWARD:
1037 return make_int (*((int *)symbol_value_forward_forward (fwd)));
1039 case SYMVAL_BOOLEAN_FORWARD:
1040 case SYMVAL_CONST_BOOLEAN_FORWARD:
1041 return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
1043 case SYMVAL_OBJECT_FORWARD:
1044 case SYMVAL_CONST_OBJECT_FORWARD:
1045 case SYMVAL_CONST_SPECIFIER_FORWARD:
1046 return *((Lisp_Object *)symbol_value_forward_forward (fwd));
1048 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1049 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1050 + ((char *)symbol_value_forward_forward (fwd)
1051 - (char *)&buffer_local_flags))));
1054 case SYMVAL_CURRENT_BUFFER_FORWARD:
1055 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1057 return (*((Lisp_Object *)((char *)buffer
1058 + ((char *)symbol_value_forward_forward (fwd)
1059 - (char *)&buffer_local_flags))));
1061 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1062 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1063 + ((char *)symbol_value_forward_forward (fwd)
1064 - (char *)&console_local_flags))));
1066 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1067 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1069 return (*((Lisp_Object *)((char *)console
1070 + ((char *)symbol_value_forward_forward (fwd)
1071 - (char *)&console_local_flags))));
1073 case SYMVAL_UNBOUND_MARKER:
1079 return Qnil; /* suppress compiler warning */
1082 /* Set the value of default-buffer-local variable SYM to VALUE. */
1085 set_default_buffer_slot_variable (Lisp_Object sym,
1088 /* Handle variables like case-fold-search that have special slots in
1089 the buffer. Make them work apparently like buffer_local variables.
1091 /* At this point, the value cell may not contain a symbol-value-varalias
1092 or symbol-value-buffer-local, and if there's a handler, we should
1093 have already called it. */
1094 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1095 CONST struct symbol_value_forward *fwd
1096 = XSYMBOL_VALUE_FORWARD (valcontents);
1097 int offset = ((char *) symbol_value_forward_forward (fwd)
1098 - (char *) &buffer_local_flags);
1099 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1100 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1101 int flags) = symbol_value_forward_magicfun (fwd);
1103 *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
1106 if (mask > 0) /* Not always per-buffer */
1110 /* Set value in each buffer which hasn't shadowed the default */
1111 LIST_LOOP_2 (elt, Vbuffer_alist)
1113 struct buffer *b = XBUFFER (XCDR (elt));
1114 if (!(b->local_var_flags & mask))
1117 magicfun (sym, &value, make_buffer (b), 0);
1118 *((Lisp_Object *) (offset + (char *) b)) = value;
1124 /* Set the value of default-console-local variable SYM to VALUE. */
1127 set_default_console_slot_variable (Lisp_Object sym,
1130 /* Handle variables like case-fold-search that have special slots in
1131 the console. Make them work apparently like console_local variables.
1133 /* At this point, the value cell may not contain a symbol-value-varalias
1134 or symbol-value-buffer-local, and if there's a handler, we should
1135 have already called it. */
1136 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1137 CONST struct symbol_value_forward *fwd
1138 = XSYMBOL_VALUE_FORWARD (valcontents);
1139 int offset = ((char *) symbol_value_forward_forward (fwd)
1140 - (char *) &console_local_flags);
1141 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1142 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1143 int flags) = symbol_value_forward_magicfun (fwd);
1145 *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
1148 if (mask > 0) /* Not always per-console */
1150 Lisp_Object console;
1152 /* Set value in each console which hasn't shadowed the default */
1153 LIST_LOOP_2 (console, Vconsole_list)
1155 struct console *d = XCONSOLE (console);
1156 if (!(d->local_var_flags & mask))
1159 magicfun (sym, &value, console, 0);
1160 *((Lisp_Object *) (offset + (char *) d)) = value;
1166 /* Store NEWVAL into SYM.
1168 SYM's value slot may *not* be types (5) or (6) above,
1169 i.e. no symbol-value-varalias objects. (You should have
1170 forwarded past all of these.)
1172 SYM should not be an unsettable symbol or a symbol with
1173 a magic `set-value' handler (unless you want to explicitly
1174 ignore this handler).
1176 OVALUE is the current value of SYM, but forwarded past any
1177 symbol-value-buffer-local and symbol-value-lisp-magic objects.
1178 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1179 the contents of its current-value cell.) NEWVAL may only be
1180 a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
1181 this function will only modify its current-value cell, which should
1182 already be set up to point to the current buffer.
1186 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
1189 if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
1191 Lisp_Object *store_pointer = value_slot_past_magic (sym);
1193 if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
1195 &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
1197 assert (UNBOUNDP (*store_pointer)
1198 || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1199 *store_pointer = newval;
1203 CONST struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue);
1204 int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
1205 Lisp_Object in_object, int flags)
1206 = symbol_value_forward_magicfun (fwd);
1208 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue))
1210 case SYMVAL_FIXNUM_FORWARD:
1213 magicfun (sym, &newval, Qnil, 0);
1214 *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
1217 case SYMVAL_BOOLEAN_FORWARD:
1219 magicfun (sym, &newval, Qnil, 0);
1220 *((int *) symbol_value_forward_forward (fwd))
1224 case SYMVAL_OBJECT_FORWARD:
1226 magicfun (sym, &newval, Qnil, 0);
1227 *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
1230 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1231 set_default_buffer_slot_variable (sym, newval);
1234 case SYMVAL_CURRENT_BUFFER_FORWARD:
1236 magicfun (sym, &newval, make_buffer (current_buffer), 0);
1237 *((Lisp_Object *) ((char *) current_buffer
1238 + ((char *) symbol_value_forward_forward (fwd)
1239 - (char *) &buffer_local_flags)))
1243 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1244 set_default_console_slot_variable (sym, newval);
1247 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1249 magicfun (sym, &newval, Vselected_console, 0);
1250 *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console)
1251 + ((char *) symbol_value_forward_forward (fwd)
1252 - (char *) &console_local_flags)))
1262 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1263 BFWD, locate and return a pointer to the element in BUFFER's
1264 local_var_alist for SYMBOL. The return value will be Qnil if
1265 BUFFER does not have its own value for SYMBOL (i.e. the default
1266 value is seen in that buffer).
1270 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
1271 struct symbol_value_buffer_local *bfwd)
1273 if (!NILP (bfwd->current_buffer) &&
1274 XBUFFER (bfwd->current_buffer) == buffer)
1275 /* This is just an optimization of the below. */
1276 return bfwd->current_alist_element;
1278 return assq_no_quit (symbol, buffer->local_var_alist);
1281 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1282 symbol-value-buffer-local of a per-buffer variable -- i.e. the
1283 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1284 slot -- may be out of date.]
1286 Write out any cached value in buffer-local variable SYMBOL's
1287 buffer-local structure, which is passed in as BFWD.
1291 write_out_buffer_local_cache (Lisp_Object symbol,
1292 struct symbol_value_buffer_local *bfwd)
1294 if (!NILP (bfwd->current_buffer))
1296 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1297 uses it, and that type cannot be inside a symbol-value-buffer-local */
1298 Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0);
1299 if (NILP (bfwd->current_alist_element))
1300 /* current_value may be updated more recently than default_value */
1301 bfwd->default_value = cval;
1303 Fsetcdr (bfwd->current_alist_element, cval);
1307 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1308 Set up BFWD's cache for validity in buffer BUF. This assumes that
1309 the cache is currently in a consistent state (this can include
1310 not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1312 If the cache is already set up for BUF, this function does nothing
1315 Otherwise, if SYM forwards out to a C variable, this also forwards
1316 SYM's value in BUF out to the variable. Therefore, you generally
1317 only want to call this when BUF is, or is about to become, the
1320 (Otherwise, you can just retrieve the value without changing the
1321 cache, at the expense of slower retrieval.)
1325 set_up_buffer_local_cache (Lisp_Object sym,
1326 struct symbol_value_buffer_local *bfwd,
1328 Lisp_Object new_alist_el,
1331 Lisp_Object new_val;
1333 if (!NILP (bfwd->current_buffer)
1334 && buf == XBUFFER (bfwd->current_buffer))
1335 /* Cache is already set up. */
1338 /* Flush out the old cache. */
1339 write_out_buffer_local_cache (sym, bfwd);
1341 /* Retrieve the new alist element and new value. */
1342 if (NILP (new_alist_el)
1344 new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1346 if (NILP (new_alist_el))
1347 new_val = bfwd->default_value;
1349 new_val = Fcdr (new_alist_el);
1351 bfwd->current_alist_element = new_alist_el;
1352 XSETBUFFER (bfwd->current_buffer, buf);
1354 /* Now store the value into the current-value slot.
1355 We don't simply write it there, because the current-value
1356 slot might be a forwarding pointer, in which case we need
1357 to instead write the value into the C variable.
1359 We might also want to call a magic function.
1361 So instead, we call this function. */
1362 store_symval_forwarding (sym, bfwd->current_value, new_val);
1367 kill_buffer_local_variables (struct buffer *buf)
1369 Lisp_Object prev = Qnil;
1372 /* Any which are supposed to be permanent,
1373 make local again, with the same values they had. */
1375 for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
1377 Lisp_Object sym = XCAR (XCAR (alist));
1378 struct symbol_value_buffer_local *bfwd;
1379 /* Variables with a symbol-value-varalias should not be here
1380 (we should have forwarded past them) and there must be a
1381 symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
1382 just forward past it; if the variable has a handler, it was
1384 Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
1386 assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
1387 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
1389 if (!NILP (Fget (sym, Qpermanent_local, Qnil)))
1390 /* prev points to the last alist element that is still
1391 staying around, so *only* update it now. This didn't
1392 used to be the case; this bug has been around since
1393 mly's rewrite two years ago! */
1397 /* Really truly kill it. */
1399 XCDR (prev) = XCDR (alist);
1401 buf->local_var_alist = XCDR (alist);
1403 /* We just effectively changed the value for this variable
1406 /* (1) If the cache is caching BUF, invalidate the cache. */
1407 if (!NILP (bfwd->current_buffer) &&
1408 buf == XBUFFER (bfwd->current_buffer))
1409 bfwd->current_buffer = Qnil;
1411 /* (2) If we changed the value in current_buffer and this
1412 variable forwards to a C variable, we need to change the
1413 value of the C variable. set_up_buffer_local_cache()
1414 will do this. It doesn't hurt to do it whenever
1415 BUF == current_buffer, so just go ahead and do that. */
1416 if (buf == current_buffer)
1417 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
1423 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1424 struct console *con, int swap_it_in,
1425 Lisp_Object symcons, int set_it_p)
1427 Lisp_Object valcontents;
1430 valcontents = XSYMBOL (sym)->value;
1433 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1436 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1438 case SYMVAL_LISP_MAGIC:
1440 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1444 case SYMVAL_VARALIAS:
1445 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1447 /* presto change-o! */
1450 case SYMVAL_BUFFER_LOCAL:
1451 case SYMVAL_SOME_BUFFER_LOCAL:
1453 struct symbol_value_buffer_local *bfwd
1454 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1458 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1459 valcontents = bfwd->current_value;
1463 if (!NILP (bfwd->current_buffer) &&
1464 buf == XBUFFER (bfwd->current_buffer))
1465 valcontents = bfwd->current_value;
1466 else if (NILP (symcons))
1469 valcontents = assq_no_quit (sym, buf->local_var_alist);
1470 if (NILP (valcontents))
1471 valcontents = bfwd->default_value;
1473 valcontents = XCDR (valcontents);
1476 valcontents = XCDR (symcons);
1484 return do_symval_forwarding (valcontents, buf, con);
1488 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1489 bound. Note that it must not be possible to QUIT within this
1493 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
1500 buf = current_buffer;
1503 CHECK_BUFFER (buffer);
1504 buf = XBUFFER (buffer);
1507 return find_symbol_value_1 (sym, buf,
1508 /* If it bombs out at startup due to a
1509 Lisp error, this may be nil. */
1510 CONSOLEP (Vselected_console)
1511 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
1515 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1520 console = Vselected_console;
1522 CHECK_CONSOLE (console);
1524 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1528 /* Return the current value of SYM. The difference between this function
1529 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1530 this updates the CURRENT_VALUE slot of buffer-local variables to
1531 point to the current buffer, while symbol_value_in_buffer doesn't. */
1534 find_symbol_value (Lisp_Object sym)
1536 /* WARNING: This function can be called when current_buffer is 0
1537 and Vselected_console is Qnil, early in initialization. */
1538 struct console *con;
1539 Lisp_Object valcontents;
1543 valcontents = XSYMBOL (sym)->value;
1544 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1547 if (CONSOLEP (Vselected_console))
1548 con = XCONSOLE (Vselected_console);
1551 /* This can also get called while we're preparing to shutdown.
1552 #### What should really happen in that case? Should we
1553 actually fix things so we can't get here in that case? */
1555 assert (!initialized || preparing_for_armageddon);
1560 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
1563 /* This is an optimized function for quick lookup of buffer local symbols
1564 by avoiding O(n) search. This will work when either:
1565 a) We have already found the symbol e.g. by traversing local_var_alist.
1567 b) We know that the symbol will not be found in the current buffer's
1568 list of local variables.
1569 In the former case, find_it_p is 1 and symbol_cons is the element from
1570 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1573 This function is called from set_buffer_internal which does both of these
1577 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1579 /* WARNING: This function can be called when current_buffer is 0
1580 and Vselected_console is Qnil, early in initialization. */
1581 struct console *con;
1582 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1585 if (CONSOLEP (Vselected_console))
1586 con = XCONSOLE (Vselected_console);
1589 /* This can also get called while we're preparing to shutdown.
1590 #### What should really happen in that case? Should we
1591 actually fix things so we can't get here in that case? */
1593 assert (!initialized || preparing_for_armageddon);
1598 return find_symbol_value_1 (sym, current_buffer, con, 1,
1599 find_it_p ? symbol_cons : Qnil,
1603 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1604 Return SYMBOL's value. Error if that is void.
1608 Lisp_Object val = find_symbol_value (symbol);
1611 return Fsignal (Qvoid_variable, list1 (symbol));
1616 DEFUN ("set", Fset, 2, 2, 0, /*
1617 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1621 REGISTER Lisp_Object valcontents;
1622 struct Lisp_Symbol *sym;
1623 /* remember, we're called by Fmakunbound() as well */
1625 CHECK_SYMBOL (symbol);
1628 sym = XSYMBOL (symbol);
1629 valcontents = sym->value;
1631 if (EQ (symbol, Qnil) ||
1633 SYMBOL_IS_KEYWORD (symbol))
1634 reject_constant_symbols (symbol, newval, 0,
1635 UNBOUNDP (newval) ? Qmakunbound : Qset);
1637 if (!SYMBOL_VALUE_MAGIC_P (valcontents) || UNBOUNDP (valcontents))
1639 sym->value = newval;
1643 reject_constant_symbols (symbol, newval, 0,
1644 UNBOUNDP (newval) ? Qmakunbound : Qset);
1648 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1650 case SYMVAL_LISP_MAGIC:
1654 if (UNBOUNDP (newval))
1655 retval = maybe_call_magic_handler (symbol, Qmakunbound, 0);
1657 retval = maybe_call_magic_handler (symbol, Qset, 1, newval);
1658 if (!UNBOUNDP (retval))
1660 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1665 case SYMVAL_VARALIAS:
1666 symbol = follow_varalias_pointers (symbol,
1668 ? Qmakunbound : Qset);
1669 /* presto change-o! */
1672 case SYMVAL_FIXNUM_FORWARD:
1673 case SYMVAL_BOOLEAN_FORWARD:
1674 case SYMVAL_OBJECT_FORWARD:
1675 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1676 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1677 if (UNBOUNDP (newval))
1678 signal_error (Qerror,
1679 list2 (build_string ("Cannot makunbound"), symbol));
1682 /* case SYMVAL_UNBOUND_MARKER: break; */
1684 case SYMVAL_CURRENT_BUFFER_FORWARD:
1686 CONST struct symbol_value_forward *fwd
1687 = XSYMBOL_VALUE_FORWARD (valcontents);
1688 int mask = XINT (*((Lisp_Object *)
1689 symbol_value_forward_forward (fwd)));
1691 /* Setting this variable makes it buffer-local */
1692 current_buffer->local_var_flags |= mask;
1696 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1698 CONST struct symbol_value_forward *fwd
1699 = XSYMBOL_VALUE_FORWARD (valcontents);
1700 int mask = XINT (*((Lisp_Object *)
1701 symbol_value_forward_forward (fwd)));
1703 /* Setting this variable makes it console-local */
1704 XCONSOLE (Vselected_console)->local_var_flags |= mask;
1708 case SYMVAL_BUFFER_LOCAL:
1709 case SYMVAL_SOME_BUFFER_LOCAL:
1711 /* If we want to examine or set the value and
1712 CURRENT-BUFFER is current, we just examine or set
1713 CURRENT-VALUE. If CURRENT-BUFFER is not current, we
1714 store the current CURRENT-VALUE value into
1715 CURRENT-ALIST- ELEMENT, then find the appropriate alist
1716 element for the buffer now current and set up
1717 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
1718 of that element, and store into CURRENT-BUFFER.
1720 If we are setting the variable and the current buffer does
1721 not have an alist entry for this variable, an alist entry is
1724 Note that CURRENT-VALUE can be a forwarding pointer.
1725 Each time it is examined or set, forwarding must be
1727 struct symbol_value_buffer_local *bfwd
1728 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1729 int some_buffer_local_p =
1730 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
1731 /* What value are we caching right now? */
1732 Lisp_Object aelt = bfwd->current_alist_element;
1734 if (!NILP (bfwd->current_buffer) &&
1735 current_buffer == XBUFFER (bfwd->current_buffer)
1736 && ((some_buffer_local_p)
1737 ? 1 /* doesn't automatically become local */
1738 : !NILP (aelt) /* already local */
1741 /* Cache is valid */
1742 valcontents = bfwd->current_value;
1746 /* If the current buffer is not the buffer whose binding is
1747 currently cached, or if it's a SYMVAL_BUFFER_LOCAL and
1748 we're looking at the default value, the cache is invalid; we
1749 need to write it out, and find the new CURRENT-ALIST-ELEMENT
1752 /* Write out the cached value for the old buffer; copy it
1753 back to its alist element. This works if the current
1754 buffer only sees the default value, too. */
1755 write_out_buffer_local_cache (symbol, bfwd);
1757 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1758 aelt = buffer_local_alist_element (current_buffer, symbol, bfwd);
1761 /* This buffer is still seeing the default value. */
1762 if (!some_buffer_local_p)
1764 /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a
1765 new assoc for a local value and set
1766 CURRENT-ALIST-ELEMENT to point to that. */
1768 do_symval_forwarding (bfwd->current_value,
1770 XCONSOLE (Vselected_console));
1771 aelt = Fcons (symbol, aelt);
1772 current_buffer->local_var_alist
1773 = Fcons (aelt, current_buffer->local_var_alist);
1777 /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
1778 we're currently seeing the default value. */
1782 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1783 bfwd->current_alist_element = aelt;
1784 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
1785 XSETBUFFER (bfwd->current_buffer, current_buffer);
1786 valcontents = bfwd->current_value;
1793 store_symval_forwarding (symbol, valcontents, newval);
1799 /* Access or set a buffer-local symbol's default value. */
1801 /* Return the default value of SYM, but don't check for voidness.
1802 Return Qunbound if it is void. */
1805 default_value (Lisp_Object sym)
1807 Lisp_Object valcontents;
1812 valcontents = XSYMBOL (sym)->value;
1815 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1818 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1820 case SYMVAL_LISP_MAGIC:
1822 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1826 case SYMVAL_VARALIAS:
1827 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1828 /* presto change-o! */
1831 case SYMVAL_UNBOUND_MARKER:
1834 case SYMVAL_CURRENT_BUFFER_FORWARD:
1836 CONST struct symbol_value_forward *fwd
1837 = XSYMBOL_VALUE_FORWARD (valcontents);
1838 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1839 + ((char *)symbol_value_forward_forward (fwd)
1840 - (char *)&buffer_local_flags))));
1843 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1845 CONST struct symbol_value_forward *fwd
1846 = XSYMBOL_VALUE_FORWARD (valcontents);
1847 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1848 + ((char *)symbol_value_forward_forward (fwd)
1849 - (char *)&console_local_flags))));
1852 case SYMVAL_BUFFER_LOCAL:
1853 case SYMVAL_SOME_BUFFER_LOCAL:
1855 struct symbol_value_buffer_local *bfwd =
1856 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1858 /* Handle user-created local variables. */
1859 /* If var is set up for a buffer that lacks a local value for it,
1860 the current value is nominally the default value.
1861 But the current value slot may be more up to date, since
1862 ordinary setq stores just that slot. So use that. */
1863 if (NILP (bfwd->current_alist_element))
1864 return do_symval_forwarding (bfwd->current_value, current_buffer,
1865 XCONSOLE (Vselected_console));
1867 return bfwd->default_value;
1870 /* For other variables, get the current value. */
1871 return do_symval_forwarding (valcontents, current_buffer,
1872 XCONSOLE (Vselected_console));
1875 RETURN_NOT_REACHED (Qnil) /* suppress compiler warning */
1878 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /*
1879 Return t if SYMBOL has a non-void default value.
1880 This is the value that is seen in buffers that do not have their own values
1885 return UNBOUNDP (default_value (symbol)) ? Qnil : Qt;
1888 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /*
1889 Return SYMBOL's default value.
1890 This is the value that is seen in buffers that do not have their own values
1891 for this variable. The default value is meaningful for variables with
1892 local bindings in certain buffers.
1896 Lisp_Object value = default_value (symbol);
1898 return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (symbol)) : value;
1901 DEFUN ("set-default", Fset_default, 2, 2, 0, /*
1902 Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.
1903 The default value is seen in buffers that do not have their own values
1908 Lisp_Object valcontents;
1910 CHECK_SYMBOL (symbol);
1913 valcontents = XSYMBOL (symbol)->value;
1916 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1917 return Fset (symbol, value);
1919 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1921 case SYMVAL_LISP_MAGIC:
1922 RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (symbol, Qset_default, 1,
1924 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1928 case SYMVAL_VARALIAS:
1929 symbol = follow_varalias_pointers (symbol, Qset_default);
1930 /* presto change-o! */
1933 case SYMVAL_CURRENT_BUFFER_FORWARD:
1934 set_default_buffer_slot_variable (symbol, value);
1937 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1938 set_default_console_slot_variable (symbol, value);
1941 case SYMVAL_BUFFER_LOCAL:
1942 case SYMVAL_SOME_BUFFER_LOCAL:
1944 /* Store new value into the DEFAULT-VALUE slot */
1945 struct symbol_value_buffer_local *bfwd
1946 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1948 bfwd->default_value = value;
1949 /* If current-buffer doesn't shadow default_value,
1950 * we must set the CURRENT-VALUE slot too */
1951 if (NILP (bfwd->current_alist_element))
1952 store_symval_forwarding (symbol, bfwd->current_value, value);
1957 return Fset (symbol, value);
1961 DEFUN ("setq-default", Fsetq_default, 0, UNEVALLED, 0, /*
1962 Set the default value of variable SYMBOL to VALUE.
1963 SYMBOL, the variable name, is literal (not evaluated);
1964 VALUE is an expression and it is evaluated.
1965 The default value of a variable is seen in buffers
1966 that do not have their own values for the variable.
1968 More generally, you can use multiple variables and values, as in
1969 (setq-default SYMBOL VALUE SYMBOL VALUE...)
1970 This sets each SYMBOL's default value to the corresponding VALUE.
1971 The VALUE for the Nth SYMBOL can refer to the new default values
1972 of previous SYMBOLs.
1976 /* This function can GC */
1977 Lisp_Object symbol, tail, val = Qnil;
1979 struct gcpro gcpro1;
1981 GET_LIST_LENGTH (args, nargs);
1983 if (nargs & 1) /* Odd number of arguments? */
1984 Fsignal (Qwrong_number_of_arguments,
1985 list2 (Qsetq_default, make_int (nargs)));
1989 PROPERTY_LIST_LOOP (tail, symbol, val, args)
1992 Fset_default (symbol, val);
1999 /* Lisp functions for creating and removing buffer-local variables. */
2001 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1,
2002 "vMake Variable Buffer Local: ", /*
2003 Make VARIABLE have a separate value for each buffer.
2004 At any time, the value for the current buffer is in effect.
2005 There is also a default value which is seen in any buffer which has not yet
2007 Using `set' or `setq' to set the variable causes it to have a separate value
2008 for the current buffer if it was previously using the default value.
2009 The function `default-value' gets the default value and `set-default'
2014 Lisp_Object valcontents;
2016 CHECK_SYMBOL (variable);
2019 verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
2021 valcontents = XSYMBOL (variable)->value;
2024 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2026 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2028 case SYMVAL_LISP_MAGIC:
2029 if (!UNBOUNDP (maybe_call_magic_handler
2030 (variable, Qmake_variable_buffer_local, 0)))
2032 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2036 case SYMVAL_VARALIAS:
2037 variable = follow_varalias_pointers (variable,
2038 Qmake_variable_buffer_local);
2039 /* presto change-o! */
2042 case SYMVAL_FIXNUM_FORWARD:
2043 case SYMVAL_BOOLEAN_FORWARD:
2044 case SYMVAL_OBJECT_FORWARD:
2045 case SYMVAL_UNBOUND_MARKER:
2048 case SYMVAL_CURRENT_BUFFER_FORWARD:
2049 case SYMVAL_BUFFER_LOCAL:
2050 /* Already per-each-buffer */
2053 case SYMVAL_SOME_BUFFER_LOCAL:
2055 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
2056 SYMVAL_BUFFER_LOCAL;
2065 struct symbol_value_buffer_local *bfwd
2066 = alloc_lcrecord_type (struct symbol_value_buffer_local,
2067 &lrecord_symbol_value_buffer_local);
2069 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2071 bfwd->default_value = find_symbol_value (variable);
2072 bfwd->current_value = valcontents;
2073 bfwd->current_alist_element = Qnil;
2074 bfwd->current_buffer = Fcurrent_buffer ();
2075 XSETSYMBOL_VALUE_MAGIC (foo, bfwd);
2076 *value_slot_past_magic (variable) = foo;
2077 #if 1 /* #### Yuck! FSFmacs bug-compatibility*/
2078 /* This sets the default-value of any make-variable-buffer-local to nil.
2079 That just sucks. User can just use setq-default to effect that,
2080 but there's no way to do makunbound-default to undo this lossage. */
2081 if (UNBOUNDP (valcontents))
2082 bfwd->default_value = Qnil;
2084 #if 0 /* #### Yuck! */
2085 /* This sets the value to nil in this buffer.
2086 User could use (setq variable nil) to do this.
2087 It isn't as egregious to do this automatically
2088 as it is to do so to the default-value, but it's
2089 still really dubious. */
2090 if (UNBOUNDP (valcontents))
2091 Fset (variable, Qnil);
2097 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1,
2098 "vMake Local Variable: ", /*
2099 Make VARIABLE have a separate value in the current buffer.
2100 Other buffers will continue to share a common default value.
2101 \(The buffer-local value of VARIABLE starts out as the same value
2102 VARIABLE previously had. If VARIABLE was void, it remains void.)
2103 See also `make-variable-buffer-local'.
2105 If the variable is already arranged to become local when set,
2106 this function causes a local value to exist for this buffer,
2107 just as setting the variable would do.
2109 Do not use `make-local-variable' to make a hook variable buffer-local.
2110 Use `make-local-hook' instead.
2114 Lisp_Object valcontents;
2115 struct symbol_value_buffer_local *bfwd;
2117 CHECK_SYMBOL (variable);
2120 verify_ok_for_buffer_local (variable, Qmake_local_variable);
2122 valcontents = XSYMBOL (variable)->value;
2125 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2127 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2129 case SYMVAL_LISP_MAGIC:
2130 if (!UNBOUNDP (maybe_call_magic_handler
2131 (variable, Qmake_local_variable, 0)))
2133 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2137 case SYMVAL_VARALIAS:
2138 variable = follow_varalias_pointers (variable, Qmake_local_variable);
2139 /* presto change-o! */
2142 case SYMVAL_FIXNUM_FORWARD:
2143 case SYMVAL_BOOLEAN_FORWARD:
2144 case SYMVAL_OBJECT_FORWARD:
2145 case SYMVAL_UNBOUND_MARKER:
2148 case SYMVAL_BUFFER_LOCAL:
2149 case SYMVAL_CURRENT_BUFFER_FORWARD:
2151 /* Make sure the symbol has a local value in this particular
2152 buffer, by setting it to the same value it already has. */
2153 Fset (variable, find_symbol_value (variable));
2157 case SYMVAL_SOME_BUFFER_LOCAL:
2159 if (!NILP (buffer_local_alist_element (current_buffer,
2161 (XSYMBOL_VALUE_BUFFER_LOCAL
2163 goto already_local_to_current_buffer;
2165 goto already_local_to_some_other_buffer;
2173 /* Make sure variable is set up to hold per-buffer values */
2174 bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
2175 &lrecord_symbol_value_buffer_local);
2176 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2178 bfwd->current_buffer = Qnil;
2179 bfwd->current_alist_element = Qnil;
2180 bfwd->current_value = valcontents;
2181 /* passing 0 is OK because this should never be a
2182 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2184 bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
2187 if (UNBOUNDP (bfwd->default_value))
2188 bfwd->default_value = Qnil; /* Yuck! */
2191 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
2192 *value_slot_past_magic (variable) = valcontents;
2194 already_local_to_some_other_buffer:
2196 /* Make sure this buffer has its own value of variable */
2197 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2199 if (UNBOUNDP (bfwd->default_value))
2201 /* If default value is unbound, set local value to nil. */
2202 XSETBUFFER (bfwd->current_buffer, current_buffer);
2203 bfwd->current_alist_element = Fcons (variable, Qnil);
2204 current_buffer->local_var_alist =
2205 Fcons (bfwd->current_alist_element, current_buffer->local_var_alist);
2206 store_symval_forwarding (variable, bfwd->current_value, Qnil);
2210 current_buffer->local_var_alist
2211 = Fcons (Fcons (variable, bfwd->default_value),
2212 current_buffer->local_var_alist);
2214 /* Make sure symbol does not think it is set up for this buffer;
2215 force it to look once again for this buffer's value */
2216 if (!NILP (bfwd->current_buffer) &&
2217 current_buffer == XBUFFER (bfwd->current_buffer))
2218 bfwd->current_buffer = Qnil;
2220 already_local_to_current_buffer:
2222 /* If the symbol forwards into a C variable, then swap in the
2223 variable for this buffer immediately. If C code modifies the
2224 variable before we swap in, then that new value will clobber the
2225 default value the next time we swap. */
2226 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2227 if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value))
2229 switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
2231 case SYMVAL_FIXNUM_FORWARD:
2232 case SYMVAL_BOOLEAN_FORWARD:
2233 case SYMVAL_OBJECT_FORWARD:
2234 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2235 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2238 case SYMVAL_UNBOUND_MARKER:
2239 case SYMVAL_CURRENT_BUFFER_FORWARD:
2250 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1,
2251 "vKill Local Variable: ", /*
2252 Make VARIABLE no longer have a separate value in the current buffer.
2253 From now on the default value will apply in this buffer.
2257 Lisp_Object valcontents;
2259 CHECK_SYMBOL (variable);
2262 valcontents = XSYMBOL (variable)->value;
2265 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2268 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2270 case SYMVAL_LISP_MAGIC:
2271 if (!UNBOUNDP (maybe_call_magic_handler
2272 (variable, Qkill_local_variable, 0)))
2274 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2278 case SYMVAL_VARALIAS:
2279 variable = follow_varalias_pointers (variable, Qkill_local_variable);
2280 /* presto change-o! */
2283 case SYMVAL_CURRENT_BUFFER_FORWARD:
2285 CONST struct symbol_value_forward *fwd
2286 = XSYMBOL_VALUE_FORWARD (valcontents);
2287 int offset = ((char *) symbol_value_forward_forward (fwd)
2288 - (char *) &buffer_local_flags);
2290 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2294 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2295 Lisp_Object in_object, int flags) =
2296 symbol_value_forward_magicfun (fwd);
2297 Lisp_Object oldval = * (Lisp_Object *)
2298 (offset + (char *) XBUFFER (Vbuffer_defaults));
2300 (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
2301 *(Lisp_Object *) (offset + (char *) current_buffer)
2303 current_buffer->local_var_flags &= ~mask;
2308 case SYMVAL_BUFFER_LOCAL:
2309 case SYMVAL_SOME_BUFFER_LOCAL:
2311 /* Get rid of this buffer's alist element, if any */
2312 struct symbol_value_buffer_local *bfwd
2313 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2314 Lisp_Object alist = current_buffer->local_var_alist;
2315 Lisp_Object alist_element
2316 = buffer_local_alist_element (current_buffer, variable, bfwd);
2318 if (!NILP (alist_element))
2319 current_buffer->local_var_alist = Fdelq (alist_element, alist);
2321 /* Make sure symbol does not think it is set up for this buffer;
2322 force it to look once again for this buffer's value */
2323 if (!NILP (bfwd->current_buffer) &&
2324 current_buffer == XBUFFER (bfwd->current_buffer))
2325 bfwd->current_buffer = Qnil;
2327 /* We just changed the value in the current_buffer. If this
2328 variable forwards to a C variable, we need to change the
2329 value of the C variable. set_up_buffer_local_cache()
2330 will do this. It doesn't hurt to do it always,
2331 so just go ahead and do that. */
2332 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2339 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2343 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2344 "vKill Console Local Variable: ", /*
2345 Make VARIABLE no longer have a separate value in the selected console.
2346 From now on the default value will apply in this console.
2350 Lisp_Object valcontents;
2352 CHECK_SYMBOL (variable);
2355 valcontents = XSYMBOL (variable)->value;
2358 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2361 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2363 case SYMVAL_LISP_MAGIC:
2364 if (!UNBOUNDP (maybe_call_magic_handler
2365 (variable, Qkill_console_local_variable, 0)))
2367 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2371 case SYMVAL_VARALIAS:
2372 variable = follow_varalias_pointers (variable,
2373 Qkill_console_local_variable);
2374 /* presto change-o! */
2377 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2379 CONST struct symbol_value_forward *fwd
2380 = XSYMBOL_VALUE_FORWARD (valcontents);
2381 int offset = ((char *) symbol_value_forward_forward (fwd)
2382 - (char *) &console_local_flags);
2384 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2388 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2389 Lisp_Object in_object, int flags) =
2390 symbol_value_forward_magicfun (fwd);
2391 Lisp_Object oldval = * (Lisp_Object *)
2392 (offset + (char *) XCONSOLE (Vconsole_defaults));
2394 magicfun (variable, &oldval, Vselected_console, 0);
2395 *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
2397 XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
2407 /* Used by specbind to determine what effects it might have. Returns:
2408 * 0 if symbol isn't buffer-local, and wouldn't be after it is set
2409 * <0 if symbol isn't presently buffer-local, but set would make it so
2410 * >0 if symbol is presently buffer-local
2413 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
2415 Lisp_Object valcontents;
2418 valcontents = XSYMBOL (symbol)->value;
2421 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2423 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2425 case SYMVAL_LISP_MAGIC:
2427 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2431 case SYMVAL_VARALIAS:
2432 symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
2433 /* presto change-o! */
2436 case SYMVAL_CURRENT_BUFFER_FORWARD:
2438 CONST struct symbol_value_forward *fwd
2439 = XSYMBOL_VALUE_FORWARD (valcontents);
2440 int mask = XINT (*((Lisp_Object *)
2441 symbol_value_forward_forward (fwd)));
2442 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
2443 /* Already buffer-local */
2446 /* Would be buffer-local after set */
2449 case SYMVAL_BUFFER_LOCAL:
2450 case SYMVAL_SOME_BUFFER_LOCAL:
2452 struct symbol_value_buffer_local *bfwd
2453 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2455 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
2458 /* Automatically becomes local when set */
2459 return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
2469 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2470 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2472 (symbol, buffer, unbound_value))
2475 CHECK_SYMBOL (symbol);
2476 CHECK_BUFFER (buffer);
2477 value = symbol_value_in_buffer (symbol, buffer);
2478 return UNBOUNDP (value) ? unbound_value : value;
2481 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2482 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2484 (symbol, console, unbound_value))
2487 CHECK_SYMBOL (symbol);
2488 CHECK_CONSOLE (console);
2489 value = symbol_value_in_console (symbol, console);
2490 return UNBOUNDP (value) ? unbound_value : value;
2493 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
2494 If SYMBOL is a built-in variable, return info about this; else return nil.
2495 The returned info will be a symbol, one of
2497 `object' A simple built-in variable.
2498 `const-object' Same, but cannot be set.
2499 `integer' A built-in integer variable.
2500 `const-integer' Same, but cannot be set.
2501 `boolean' A built-in boolean variable.
2502 `const-boolean' Same, but cannot be set.
2503 `const-specifier' Always contains a specifier; e.g. `has-modeline-p'.
2504 `current-buffer' A built-in buffer-local variable.
2505 `const-current-buffer' Same, but cannot be set.
2506 `default-buffer' Forwards to the default value of a built-in
2507 buffer-local variable.
2508 `selected-console' A built-in console-local variable.
2509 `const-selected-console' Same, but cannot be set.
2510 `default-console' Forwards to the default value of a built-in
2511 console-local variable.
2515 REGISTER Lisp_Object valcontents;
2517 CHECK_SYMBOL (symbol);
2520 valcontents = XSYMBOL (symbol)->value;
2523 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2526 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2528 case SYMVAL_LISP_MAGIC:
2529 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2533 case SYMVAL_VARALIAS:
2534 symbol = follow_varalias_pointers (symbol, Qt);
2535 /* presto change-o! */
2538 case SYMVAL_BUFFER_LOCAL:
2539 case SYMVAL_SOME_BUFFER_LOCAL:
2541 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value;
2545 case SYMVAL_FIXNUM_FORWARD: return Qinteger;
2546 case SYMVAL_CONST_FIXNUM_FORWARD: return Qconst_integer;
2547 case SYMVAL_BOOLEAN_FORWARD: return Qboolean;
2548 case SYMVAL_CONST_BOOLEAN_FORWARD: return Qconst_boolean;
2549 case SYMVAL_OBJECT_FORWARD: return Qobject;
2550 case SYMVAL_CONST_OBJECT_FORWARD: return Qconst_object;
2551 case SYMVAL_CONST_SPECIFIER_FORWARD: return Qconst_specifier;
2552 case SYMVAL_DEFAULT_BUFFER_FORWARD: return Qdefault_buffer;
2553 case SYMVAL_CURRENT_BUFFER_FORWARD: return Qcurrent_buffer;
2554 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: return Qconst_current_buffer;
2555 case SYMVAL_DEFAULT_CONSOLE_FORWARD: return Qdefault_console;
2556 case SYMVAL_SELECTED_CONSOLE_FORWARD: return Qselected_console;
2557 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: return Qconst_selected_console;
2558 case SYMVAL_UNBOUND_MARKER: return Qnil;
2561 abort (); return Qnil;
2566 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
2567 Return t if SYMBOL's value is local to BUFFER.
2568 If optional third arg AFTER-SET is true, return t if SYMBOL would be
2569 buffer-local after it is set, regardless of whether it is so presently.
2570 A nil value for BUFFER is *not* the same as (current-buffer), but means
2571 "no buffer". Specifically:
2573 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
2574 the variable is one of the special built-in variables that is always
2575 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
2576 `buffer-undo-list', and others.)
2578 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
2579 the variable has had `make-variable-buffer-local' applied to it.
2581 (symbol, buffer, after_set))
2585 CHECK_SYMBOL (symbol);
2588 buffer = get_buffer (buffer, 1);
2589 local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
2593 local_info = symbol_value_buffer_local_info (symbol, 0);
2596 if (NILP (after_set))
2597 return local_info > 0 ? Qt : Qnil;
2599 return local_info != 0 ? Qt : Qnil;
2604 I've gone ahead and partially implemented this because it's
2605 super-useful for dealing with the compatibility problems in supporting
2606 the old pointer-shape variables, and preventing people from `setq'ing
2607 the new variables. Any other way of handling this problem is way
2608 ugly, likely to be slow, and generally not something I want to waste
2609 my time worrying about.
2611 The interface and/or function name is sure to change before this
2612 gets into its final form. I currently like the way everything is
2613 set up and it has all the features I want it to have, except for
2614 one: I really want to be able to have multiple nested handlers,
2615 to implement an `advice'-like capability. This would allow,
2616 for example, a clean way of implementing `debug-if-set' or
2617 `debug-if-referenced' and such.
2619 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
2620 ************************************************************
2621 **Only** the `set-value', `make-unbound', and `make-local'
2622 handler types are currently implemented. Implementing the
2623 get-value and bound-predicate handlers is somewhat tricky
2624 because there are lots of subfunctions (e.g. find_symbol_value()).
2625 find_symbol_value(), in fact, is called from outside of
2626 this module. You'd have to have it do this:
2628 -- check for a `bound-predicate' handler, call that if so;
2629 if it returns nil, return Qunbound
2630 -- check for a `get-value' handler and call it and return
2633 It gets even trickier when you have to deal with
2634 sub-subfunctions like find_symbol_value_1(), and esp.
2635 when you have to properly handle variable aliases, which
2636 can lead to lots of tricky situations. So I've just
2637 punted on this, since the interface isn't officially
2638 exported and we can get by with just a `set-value'
2641 Actions in unimplemented handler types will correctly
2642 ignore any handlers, and will not fuck anything up or
2645 WARNING WARNING: If you do go and implement another
2646 type of handler, make *sure* to change
2647 would_be_magic_handled() so it knows about this,
2648 or dire things could result.
2649 ************************************************************
2650 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
2652 Real documentation is as follows.
2654 Set a magic handler for VARIABLE.
2655 This allows you to specify arbitrary behavior that results from
2656 accessing or setting a variable. For example, retrieving the
2657 variable's value might actually retrieve the first element off of
2658 a list stored in another variable, and setting the variable's value
2659 might add an element to the front of that list. (This is how the
2660 obsolete variable `unread-command-event' is implemented.)
2662 In general it is NOT good programming practice to use magic variables
2663 in a new package that you are designing. If you feel the need to
2664 do this, it's almost certainly a sign that you should be using a
2665 function instead of a variable. This facility is provided to allow
2666 a package to support obsolete variables and provide compatibility
2667 with similar packages with different variable names and semantics.
2668 By using magic handlers, you can cleanly provide obsoleteness and
2669 compatibility support and separate this support from the core
2670 routines in a package.
2672 VARIABLE should be a symbol naming the variable for which the
2673 magic behavior is provided. HANDLER-TYPE is a symbol specifying
2674 which behavior is being controlled, and HANDLER is the function
2675 that will be called to control this behavior. HARG is a
2676 value that will be passed to HANDLER but is otherwise
2677 uninterpreted. KEEP-EXISTING specifies what to do with existing
2678 handlers of the same type; nil means "erase them all", t means
2679 "keep them but insert at the beginning", the list (t) means
2680 "keep them but insert at the end", a function means "keep
2681 them but insert before the specified function", a list containing
2682 a function means "keep them but insert after the specified
2685 You can specify magic behavior for any type of variable at all,
2686 and for any handler types that are unspecified, the standard
2687 behavior applies. This allows you, for example, to use
2688 `defvaralias' in conjunction with this function. (For that
2689 matter, `defvaralias' could be implemented using this function.)
2691 The behaviors that can be specified in HANDLER-TYPE are
2693 get-value (SYM ARGS FUN HARG HANDLERS)
2694 This means that one of the functions `symbol-value',
2695 `default-value', `symbol-value-in-buffer', or
2696 `symbol-value-in-console' was called on SYM.
2698 set-value (SYM ARGS FUN HARG HANDLERS)
2699 This means that one of the functions `set' or `set-default'
2702 bound-predicate (SYM ARGS FUN HARG HANDLERS)
2703 This means that one of the functions `boundp', `globally-boundp',
2704 or `default-boundp' was called on SYM.
2706 make-unbound (SYM ARGS FUN HARG HANDLERS)
2707 This means that the function `makunbound' was called on SYM.
2709 local-predicate (SYM ARGS FUN HARG HANDLERS)
2710 This means that the function `local-variable-p' was called
2713 make-local (SYM ARGS FUN HARG HANDLERS)
2714 This means that one of the functions `make-local-variable',
2715 `make-variable-buffer-local', `kill-local-variable',
2716 or `kill-console-local-variable' was called on SYM.
2718 The meanings of the arguments are as follows:
2720 SYM is the symbol on which the function was called, and is always
2721 the first argument to the function.
2723 ARGS are the remaining arguments in the original call (i.e. all
2724 but the first). In the case of `set-value' in particular,
2725 the first element of ARGS is the value to which the variable
2726 is being set. In some cases, ARGS is sanitized from what was
2727 actually given. For example, whenever `nil' is passed to an
2728 argument and it means `current-buffer', the current buffer is
2729 substituted instead.
2731 FUN is a symbol indicating which function is being called.
2732 For many of the functions, you can determine the corresponding
2733 function of a different class using
2734 `symbol-function-corresponding-function'.
2736 HARG is the argument that was given in the call
2737 to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
2739 HANDLERS is a structure containing the remaining handlers
2740 for the variable; to call one of them, use
2741 `chain-to-symbol-value-handler'.
2743 NOTE: You may *not* modify the list in ARGS, and if you want to
2744 keep it around after the handler function exits, you must make
2745 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
2748 static enum lisp_magic_handler
2749 decode_magic_handler_type (Lisp_Object symbol)
2751 if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE;
2752 if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE;
2753 if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE;
2754 if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND;
2755 if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE;
2756 if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL;
2758 signal_simple_error ("Unrecognized symbol value handler type", symbol);
2760 return MAGIC_HANDLER_MAX;
2763 static enum lisp_magic_handler
2764 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
2766 if (EQ (funsym, Qsymbol_value)
2767 || EQ (funsym, Qdefault_value)
2768 || EQ (funsym, Qsymbol_value_in_buffer)
2769 || EQ (funsym, Qsymbol_value_in_console))
2770 return MAGIC_HANDLER_GET_VALUE;
2772 if (EQ (funsym, Qset)
2773 || EQ (funsym, Qset_default))
2774 return MAGIC_HANDLER_SET_VALUE;
2776 if (EQ (funsym, Qboundp)
2777 || EQ (funsym, Qglobally_boundp)
2778 || EQ (funsym, Qdefault_boundp))
2779 return MAGIC_HANDLER_BOUND_PREDICATE;
2781 if (EQ (funsym, Qmakunbound))
2782 return MAGIC_HANDLER_MAKE_UNBOUND;
2784 if (EQ (funsym, Qlocal_variable_p))
2785 return MAGIC_HANDLER_LOCAL_PREDICATE;
2787 if (EQ (funsym, Qmake_variable_buffer_local)
2788 || EQ (funsym, Qmake_local_variable))
2789 return MAGIC_HANDLER_MAKE_LOCAL;
2791 if (abort_if_not_found)
2793 signal_simple_error ("Unrecognized symbol-value function", funsym);
2794 return MAGIC_HANDLER_MAX;
2798 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
2800 /* does not take into account variable aliasing. */
2801 Lisp_Object valcontents = XSYMBOL (sym)->value;
2802 enum lisp_magic_handler slot;
2804 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2806 slot = handler_type_from_function_symbol (funsym, 1);
2807 if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND
2808 && slot != MAGIC_HANDLER_MAKE_LOCAL)
2809 /* #### temporary kludge because we haven't implemented
2810 lisp-magic variables completely */
2812 return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
2816 fetch_value_maybe_past_magic (Lisp_Object sym,
2817 Lisp_Object follow_past_lisp_magic)
2819 Lisp_Object value = XSYMBOL (sym)->value;
2820 if (SYMBOL_VALUE_LISP_MAGIC_P (value)
2821 && (EQ (follow_past_lisp_magic, Qt)
2822 || (!NILP (follow_past_lisp_magic)
2823 && !would_be_magic_handled (sym, follow_past_lisp_magic))))
2824 value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed;
2828 static Lisp_Object *
2829 value_slot_past_magic (Lisp_Object sym)
2831 Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
2833 if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
2834 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
2835 return store_pointer;
2839 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
2842 Lisp_Object args[20]; /* should be enough ... */
2844 enum lisp_magic_handler htype;
2845 Lisp_Object legerdemain;
2846 struct symbol_value_lisp_magic *bfwd;
2848 assert (nargs >= 0 && nargs < 20);
2849 legerdemain = XSYMBOL (sym)->value;
2850 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2851 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2853 va_start (vargs, nargs);
2854 for (i = 0; i < nargs; i++)
2855 args[i] = va_arg (vargs, Lisp_Object);
2858 htype = handler_type_from_function_symbol (funsym, 1);
2859 if (NILP (bfwd->handler[htype]))
2861 /* #### should be reusing the arglist, not always consing anew.
2862 Repeated handler invocations should not cause repeated consing.
2863 Doesn't matter for now, because this is just a quick implementation
2864 for obsolescence support. */
2865 return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym,
2866 bfwd->harg[htype], Qnil);
2869 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
2871 Don't you dare use this.
2872 If you do, suffer the wrath of Ben, who is likely to rename
2873 this function (or change the semantics of its arguments) without
2874 pity, thereby invalidating your code.
2876 (variable, handler_type, handler, harg, keep_existing))
2878 Lisp_Object valcontents;
2879 struct symbol_value_lisp_magic *bfwd;
2880 enum lisp_magic_handler htype;
2883 /* #### WARNING, only some handler types are implemented. See above.
2884 Actions of other types will ignore a handler if it's there.
2886 #### Also, `chain-to-symbol-value-handler' and
2887 `symbol-function-corresponding-function' are not implemented. */
2888 CHECK_SYMBOL (variable);
2889 CHECK_SYMBOL (handler_type);
2890 htype = decode_magic_handler_type (handler_type);
2891 valcontents = XSYMBOL (variable)->value;
2892 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2894 bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
2895 &lrecord_symbol_value_lisp_magic);
2896 bfwd->magic.type = SYMVAL_LISP_MAGIC;
2897 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2899 bfwd->handler[i] = Qnil;
2900 bfwd->harg[i] = Qnil;
2902 bfwd->shadowed = valcontents;
2903 XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
2906 bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
2907 bfwd->handler[htype] = handler;
2908 bfwd->harg[htype] = harg;
2910 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2911 if (!NILP (bfwd->handler[i]))
2914 if (i == MAGIC_HANDLER_MAX)
2915 /* there are no remaining handlers, so remove the structure. */
2916 XSYMBOL (variable)->value = bfwd->shadowed;
2922 /* functions for working with variable aliases. */
2924 /* Follow the chain of variable aliases for SYMBOL. Return the
2925 resulting symbol, whose value cell is guaranteed not to be a
2926 symbol-value-varalias.
2928 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
2929 If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
2930 never follow; stop right there. Otherwise FUNSYM should be a
2931 recognized symbol-value function symbol; this means, follow
2932 unless there is a special handler for the named function.
2934 OK, there is at least one reason why it's necessary for
2935 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
2936 can always be sure to catch cyclic variable aliasing. If we never
2937 follow past Lisp magic, then if the following is done:
2940 add some magic behavior to a, but not a "get-value" handler
2943 then an attempt to retrieve a's or b's value would cause infinite
2944 looping in `symbol-value'.
2946 We (of course) can't always follow past Lisp magic, because then
2947 we make any variable that is lisp-magic -> varalias behave as if
2948 the lisp-magic is not present at all.
2952 follow_varalias_pointers (Lisp_Object symbol,
2953 Lisp_Object follow_past_lisp_magic)
2955 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
2956 Lisp_Object tortoise, hare, val;
2959 /* quick out just in case */
2960 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value))
2963 /* Compare implementation of indirect_function(). */
2964 for (hare = tortoise = symbol, count = 0;
2965 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic),
2966 SYMBOL_VALUE_VARALIAS_P (val);
2967 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)),
2970 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue;
2973 tortoise = symbol_value_varalias_aliasee
2974 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic
2975 (tortoise, follow_past_lisp_magic)));
2976 if (EQ (hare, tortoise))
2977 return Fsignal (Qcyclic_variable_indirection, list1 (symbol));
2983 DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
2984 Define a variable as an alias for another variable.
2985 Thenceforth, any operations performed on VARIABLE will actually be
2986 performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
2987 If ALIAS is nil, remove any aliases for VARIABLE.
2988 ALIAS can itself be aliased, and the chain of variable aliases
2989 will be followed appropriately.
2990 If VARIABLE already has a value, this value will be shadowed
2991 until the alias is removed, at which point it will be restored.
2992 Currently VARIABLE cannot be a built-in variable, a variable that
2993 has a buffer-local value in any buffer, or the symbols nil or t.
2994 \(ALIAS, however, can be any type of variable.)
2998 struct symbol_value_varalias *bfwd;
2999 Lisp_Object valcontents;
3001 CHECK_SYMBOL (variable);
3002 reject_constant_symbols (variable, Qunbound, 0, Qt);
3004 valcontents = XSYMBOL (variable)->value;
3008 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3010 XSYMBOL (variable)->value =
3011 symbol_value_varalias_shadowed
3012 (XSYMBOL_VALUE_VARALIAS (valcontents));
3017 CHECK_SYMBOL (alias);
3018 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3021 XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
3025 if (SYMBOL_VALUE_MAGIC_P (valcontents)
3026 && !UNBOUNDP (valcontents))
3027 signal_simple_error ("Variable is magic and cannot be aliased", variable);
3028 reject_constant_symbols (variable, Qunbound, 0, Qt);
3030 bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
3031 &lrecord_symbol_value_varalias);
3032 bfwd->magic.type = SYMVAL_VARALIAS;
3033 bfwd->aliasee = alias;
3034 bfwd->shadowed = valcontents;
3036 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
3037 XSYMBOL (variable)->value = valcontents;
3041 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
3042 If VARIABLE is aliased to another variable, return that variable.
3043 VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
3044 Variable aliases are created with `defvaralias'. See also
3045 `indirect-variable'.
3047 (variable, follow_past_lisp_magic))
3049 Lisp_Object valcontents;
3051 CHECK_SYMBOL (variable);
3052 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3054 CHECK_SYMBOL (follow_past_lisp_magic);
3055 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3058 valcontents = fetch_value_maybe_past_magic (variable,
3059 follow_past_lisp_magic);
3061 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3062 return symbol_value_varalias_aliasee
3063 (XSYMBOL_VALUE_VARALIAS (valcontents));
3068 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /*
3069 Return the variable at the end of OBJECT's variable-alias chain.
3070 If OBJECT is a symbol, follow all variable aliases and return
3071 the final (non-aliased) symbol. Variable aliases are created with
3072 the function `defvaralias'.
3073 If OBJECT is not a symbol, just return it.
3074 Signal a cyclic-variable-indirection error if there is a loop in the
3075 variable chain of symbols.
3077 (object, follow_past_lisp_magic))
3079 if (!SYMBOLP (object))
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);
3086 return follow_varalias_pointers (object, follow_past_lisp_magic);
3090 /************************************************************************/
3091 /* initialization */
3092 /************************************************************************/
3094 /* A dumped XEmacs image has a lot more than 1511 symbols. Last
3095 estimate was that there were actually around 6300. So let's try
3096 making this bigger and see if we get better hashing behavior. */
3097 #define OBARRAY_SIZE 16411
3102 #ifndef Qnull_pointer
3103 Lisp_Object Qnull_pointer;
3106 /* some losing systems can't have static vars at function scope... */
3107 static struct symbol_value_magic guts_of_unbound_marker =
3108 { { symbol_value_forward_lheader_initializer, 0, 69},
3109 SYMVAL_UNBOUND_MARKER };
3112 init_symbols_once_early (void)
3115 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3118 #ifndef Qnull_pointer
3119 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3120 so the following is actually a no-op. */
3121 XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
3124 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3125 called the first time. */
3126 Qnil = Fmake_symbol (make_string_nocopy ((CONST Bufbyte *) "nil", 3));
3127 XSYMBOL (Qnil)->name->plist = Qnil;
3128 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
3129 XSYMBOL (Qnil)->plist = Qnil;
3131 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3132 initial_obarray = Vobarray;
3133 staticpro (&initial_obarray);
3134 /* Intern nil in the obarray */
3136 int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
3137 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3141 /* Required to get around a GCC syntax error on certain
3143 struct symbol_value_magic *tem = &guts_of_unbound_marker;
3145 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3147 if ((CONST void *) XPNTR (Qunbound) !=
3148 (CONST void *)&guts_of_unbound_marker)
3150 /* This might happen on DATA_SEG_BITS machines. */
3152 /* Can't represent a pointer to constant C data using a Lisp_Object.
3153 So heap-allocate it. */
3154 struct symbol_value_magic *urk = xnew (struct symbol_value_magic);
3155 memcpy (urk, &guts_of_unbound_marker, sizeof (*urk));
3156 XSETSYMBOL_VALUE_MAGIC (Qunbound, urk);
3159 XSYMBOL (Qnil)->function = Qunbound;
3161 defsymbol (&Qt, "t");
3162 XSYMBOL (Qt)->value = Qt; /* Veritas aetera */
3166 pdump_wire (&Qunbound);
3167 pdump_wire (&Vquit_flag);
3171 defsymbol_nodump (Lisp_Object *location, CONST char *name)
3173 *location = Fintern (make_string_nocopy ((CONST Bufbyte *) name,
3176 staticpro_nodump (location);
3180 defsymbol (Lisp_Object *location, CONST char *name)
3182 *location = Fintern (make_string_nocopy ((CONST Bufbyte *) name,
3185 staticpro (location);
3189 defkeyword (Lisp_Object *location, CONST char *name)
3191 defsymbol (location, name);
3192 Fset (*location, *location);
3196 /* Check that nobody spazzed writing a DEFUN. */
3198 check_sane_subr (Lisp_Subr *subr, Lisp_Object sym)
3200 assert (subr->min_args >= 0);
3201 assert (subr->min_args <= SUBR_MAX_ARGS);
3203 if (subr->max_args != MANY &&
3204 subr->max_args != UNEVALLED)
3206 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3207 assert (subr->max_args <= SUBR_MAX_ARGS);
3208 assert (subr->min_args <= subr->max_args);
3211 assert (UNBOUNDP (XSYMBOL (sym)->function));
3214 #define check_sane_subr(subr, sym) /* nothing */
3219 * If we are not in a pure undumped Emacs, we need to make a duplicate of
3220 * the subr. This is because the only time this function will be called
3221 * in a running Emacs is when a dynamically loaded module is adding a
3222 * subr, and we need to make sure that the subr is in allocated, Lisp-
3223 * accessible memory. The address assigned to the static subr struct
3224 * in the shared object will be a trampoline address, so we need to create
3225 * a copy here to ensure that a real address is used.
3227 * Once we have copied everything across, we re-use the original static
3228 * structure to store a pointer to the newly allocated one. This will be
3229 * used in emodules.c by emodules_doc_subr() to find a pointer to the
3230 * allocated object so that we can set its doc string propperly.
3232 * NOTE: We dont actually use the DOC pointer here any more, but we did
3233 * in an earlier implementation of module support. There is no harm in
3234 * setting it here in case we ever need it in future implementations.
3235 * subr->doc will point to the new subr structure that was allocated.
3236 * Code can then get this value from the statis subr structure and use
3239 * FIXME: Should newsubr be staticpro()'ed? I dont think so but I need
3242 #define check_module_subr() \
3244 if (initialized) { \
3245 struct Lisp_Subr *newsubr; \
3246 newsubr = (Lisp_Subr *)xmalloc(sizeof(struct Lisp_Subr)); \
3247 memcpy (newsubr, subr, sizeof(struct Lisp_Subr)); \
3248 subr->doc = (CONST char *)newsubr; \
3252 #else /* ! HAVE_SHLIB */
3253 #define check_module_subr()
3257 defsubr (Lisp_Subr *subr)
3259 Lisp_Object sym = intern (subr_name (subr));
3262 check_sane_subr (subr, sym);
3263 check_module_subr ();
3265 XSETSUBR (fun, subr);
3266 XSYMBOL (sym)->function = fun;
3269 /* Define a lisp macro using a Lisp_Subr. */
3271 defsubr_macro (Lisp_Subr *subr)
3273 Lisp_Object sym = intern (subr_name (subr));
3276 check_sane_subr (subr, sym);
3277 check_module_subr();
3279 XSETSUBR (fun, subr);
3280 XSYMBOL (sym)->function = Fcons (Qmacro, fun);
3284 deferror (Lisp_Object *symbol, CONST char *name, CONST char *messuhhj,
3285 Lisp_Object inherits_from)
3288 defsymbol (symbol, name);
3290 assert (SYMBOLP (inherits_from));
3291 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3292 Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3293 /* NOT build_translated_string (). This function is called at load time
3294 and the string needs to get translated at run time. (This happens
3295 in the function (display-error) in cmdloop.el.) */
3296 Fput (*symbol, Qerror_message, build_string (messuhhj));
3300 syms_of_symbols (void)
3302 defsymbol (&Qvariable_documentation, "variable-documentation");
3303 defsymbol (&Qvariable_domain, "variable-domain"); /* I18N3 */
3304 defsymbol (&Qad_advice_info, "ad-advice-info");
3305 defsymbol (&Qad_activate, "ad-activate");
3307 defsymbol (&Qget_value, "get-value");
3308 defsymbol (&Qset_value, "set-value");
3309 defsymbol (&Qbound_predicate, "bound-predicate");
3310 defsymbol (&Qmake_unbound, "make-unbound");
3311 defsymbol (&Qlocal_predicate, "local-predicate");
3312 defsymbol (&Qmake_local, "make-local");
3314 defsymbol (&Qboundp, "boundp");
3315 defsymbol (&Qglobally_boundp, "globally-boundp");
3316 defsymbol (&Qmakunbound, "makunbound");
3317 defsymbol (&Qsymbol_value, "symbol-value");
3318 defsymbol (&Qset, "set");
3319 defsymbol (&Qsetq_default, "setq-default");
3320 defsymbol (&Qdefault_boundp, "default-boundp");
3321 defsymbol (&Qdefault_value, "default-value");
3322 defsymbol (&Qset_default, "set-default");
3323 defsymbol (&Qmake_variable_buffer_local, "make-variable-buffer-local");
3324 defsymbol (&Qmake_local_variable, "make-local-variable");
3325 defsymbol (&Qkill_local_variable, "kill-local-variable");
3326 defsymbol (&Qkill_console_local_variable, "kill-console-local-variable");
3327 defsymbol (&Qsymbol_value_in_buffer, "symbol-value-in-buffer");
3328 defsymbol (&Qsymbol_value_in_console, "symbol-value-in-console");
3329 defsymbol (&Qlocal_variable_p, "local-variable-p");
3331 defsymbol (&Qconst_integer, "const-integer");
3332 defsymbol (&Qconst_boolean, "const-boolean");
3333 defsymbol (&Qconst_object, "const-object");
3334 defsymbol (&Qconst_specifier, "const-specifier");
3335 defsymbol (&Qdefault_buffer, "default-buffer");
3336 defsymbol (&Qcurrent_buffer, "current-buffer");
3337 defsymbol (&Qconst_current_buffer, "const-current-buffer");
3338 defsymbol (&Qdefault_console, "default-console");
3339 defsymbol (&Qselected_console, "selected-console");
3340 defsymbol (&Qconst_selected_console, "const-selected-console");
3343 DEFSUBR (Fintern_soft);
3344 DEFSUBR (Funintern);
3345 DEFSUBR (Fmapatoms);
3346 DEFSUBR (Fapropos_internal);
3348 DEFSUBR (Fsymbol_function);
3349 DEFSUBR (Fsymbol_plist);
3350 DEFSUBR (Fsymbol_name);
3351 DEFSUBR (Fmakunbound);
3352 DEFSUBR (Ffmakunbound);
3354 DEFSUBR (Fglobally_boundp);
3357 DEFSUBR (Fdefine_function);
3358 Ffset (intern ("defalias"), intern ("define-function"));
3359 DEFSUBR (Fsetplist);
3360 DEFSUBR (Fsymbol_value_in_buffer);
3361 DEFSUBR (Fsymbol_value_in_console);
3362 DEFSUBR (Fbuilt_in_variable_type);
3363 DEFSUBR (Fsymbol_value);
3365 DEFSUBR (Fdefault_boundp);
3366 DEFSUBR (Fdefault_value);
3367 DEFSUBR (Fset_default);
3368 DEFSUBR (Fsetq_default);
3369 DEFSUBR (Fmake_variable_buffer_local);
3370 DEFSUBR (Fmake_local_variable);
3371 DEFSUBR (Fkill_local_variable);
3372 DEFSUBR (Fkill_console_local_variable);
3373 DEFSUBR (Flocal_variable_p);
3374 DEFSUBR (Fdefvaralias);
3375 DEFSUBR (Fvariable_alias);
3376 DEFSUBR (Findirect_variable);
3377 DEFSUBR (Fdontusethis_set_symbol_value_handler);
3380 /* Create and initialize a Lisp variable whose value is forwarded to C data */
3382 defvar_magic (CONST char *symbol_name, CONST struct symbol_value_forward *magic)
3384 Lisp_Object sym, kludge;
3386 /* Check that `magic' points somewhere we can represent as a Lisp pointer */
3387 XSETOBJ (kludge, Lisp_Type_Record, magic);
3388 if ((void *)magic != (void*) XPNTR (kludge))
3390 /* This might happen on DATA_SEG_BITS machines. */
3392 /* Copy it to somewhere which is representable. */
3393 struct symbol_value_forward *p = xnew (struct symbol_value_forward);
3394 memcpy (p, magic, sizeof *magic);
3398 #if defined(HAVE_SHLIB)
3400 * As with defsubr(), this will only be called in a dumped Emacs when
3401 * we are adding variables from a dynamically loaded module. That means
3402 * we can't use purespace. Take that into account.
3405 sym = Fintern (build_string (symbol_name), Qnil);
3408 sym = Fintern (make_string_nocopy ((CONST Bufbyte *) symbol_name,
3409 strlen (symbol_name)), Qnil);
3411 XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic);
3415 vars_of_symbols (void)
3417 DEFVAR_LISP ("obarray", &Vobarray /*
3418 Symbol table for use by `intern' and `read'.
3419 It is a vector whose length ought to be prime for best results.
3420 The vector's contents don't make sense if examined from Lisp programs;
3421 to find all the symbols in an obarray, use `mapatoms'.
3423 /* obarray has been initialized long before */