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, Qfboundp, 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, void (*markobj) (Lisp_Object))
92 struct Lisp_Symbol *sym = XSYMBOL (obj);
96 markobj (sym->function);
97 XSETSTRING (pname, sym->name);
99 if (!symbol_next (sym))
103 markobj (sym->plist);
104 /* Mark the rest of the symbols in the obarray hash-chain */
105 sym = symbol_next (sym);
106 XSETSYMBOL (obj, sym);
111 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
112 mark_symbol, print_symbol, 0, 0, 0,
116 /**********************************************************************/
118 /**********************************************************************/
120 /* #### using a vector here is way bogus. Use a hash table instead. */
122 Lisp_Object Vobarray;
124 static Lisp_Object initial_obarray;
126 /* oblookup stores the bucket number here, for the sake of Funintern. */
128 static int oblookup_last_bucket_number;
131 check_obarray (Lisp_Object obarray)
133 while (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
135 /* If Vobarray is now invalid, force it to be valid. */
136 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
138 obarray = wrong_type_argument (Qvectorp, obarray);
144 intern (CONST char *str)
146 Bytecount len = strlen (str);
147 CONST Bufbyte *buf = (CONST Bufbyte *) str;
148 Lisp_Object obarray = Vobarray;
150 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
151 obarray = check_obarray (obarray);
154 Lisp_Object tem = oblookup (obarray, buf, len);
159 return Fintern (make_string (buf, len), obarray);
162 DEFUN ("intern", Fintern, 1, 2, 0, /*
163 Return the canonical symbol whose name is STRING.
164 If there is none, one is created by this function and returned.
165 A second optional argument specifies the obarray to use;
166 it defaults to the value of `obarray'.
170 Lisp_Object object, *ptr;
171 struct Lisp_Symbol *symbol;
174 if (NILP (obarray)) obarray = Vobarray;
175 obarray = check_obarray (obarray);
177 CHECK_STRING (string);
179 len = XSTRING_LENGTH (string);
180 object = oblookup (obarray, XSTRING_DATA (string), len);
185 ptr = &XVECTOR_DATA (obarray)[XINT (object)];
187 object = Fmake_symbol (string);
188 symbol = XSYMBOL (object);
191 symbol_next (symbol) = XSYMBOL (*ptr);
193 symbol_next (symbol) = 0;
196 if (string_byte (symbol_name (symbol), 0) == ':' && EQ (obarray, Vobarray))
198 /* The LISP way is to put keywords in their own package, but we
199 don't have packages, so we do something simpler. Someday,
200 maybe we'll have packages and then this will be reworked.
202 symbol_value (symbol) = object;
208 DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /*
209 Return the canonical symbol named NAME, or nil if none exists.
210 NAME may be a string or a symbol. If it is a symbol, that exact
211 symbol is searched for.
212 A second optional argument specifies the obarray to use;
213 it defaults to the value of `obarray'.
217 /* #### Bug! (intern-soft "nil") returns nil. Perhaps we should
218 add a DEFAULT-IF-NOT-FOUND arg, like in get. */
220 struct Lisp_String *string;
222 if (NILP (obarray)) obarray = Vobarray;
223 obarray = check_obarray (obarray);
228 string = XSTRING (name);
231 string = symbol_name (XSYMBOL (name));
233 tem = oblookup (obarray, string_data (string), string_length (string));
234 if (INTP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
240 DEFUN ("unintern", Funintern, 1, 2, 0, /*
241 Delete the symbol named NAME, if any, from OBARRAY.
242 The value is t if a symbol was found and deleted, nil otherwise.
243 NAME may be a string or a symbol. If it is a symbol, that symbol
244 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
245 OBARRAY defaults to the value of the variable `obarray'
250 struct Lisp_String *string;
253 if (NILP (obarray)) obarray = Vobarray;
254 obarray = check_obarray (obarray);
257 string = symbol_name (XSYMBOL (name));
261 string = XSTRING (name);
264 tem = oblookup (obarray, string_data (string), string_length (string));
267 /* If arg was a symbol, don't delete anything but that symbol itself. */
268 if (SYMBOLP (name) && !EQ (name, tem))
271 hash = oblookup_last_bucket_number;
273 if (EQ (XVECTOR_DATA (obarray)[hash], tem))
275 if (XSYMBOL (tem)->next)
276 XSETSYMBOL (XVECTOR_DATA (obarray)[hash], XSYMBOL (tem)->next);
278 XVECTOR_DATA (obarray)[hash] = Qzero;
282 Lisp_Object tail, following;
284 for (tail = XVECTOR_DATA (obarray)[hash];
285 XSYMBOL (tail)->next;
288 XSETSYMBOL (following, XSYMBOL (tail)->next);
289 if (EQ (following, tem))
291 XSYMBOL (tail)->next = XSYMBOL (following)->next;
299 /* Return the symbol in OBARRAY whose names matches the string
300 of SIZE characters at PTR. If there is no such symbol in OBARRAY,
301 return the index into OBARRAY that the string hashes to.
303 Also store the bucket number in oblookup_last_bucket_number. */
306 oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size)
309 struct Lisp_Symbol *tail;
312 if (!VECTORP (obarray) ||
313 (obsize = XVECTOR_LENGTH (obarray)) == 0)
315 obarray = check_obarray (obarray);
316 obsize = XVECTOR_LENGTH (obarray);
318 hash = hash_string (ptr, size) % obsize;
319 oblookup_last_bucket_number = hash;
320 bucket = XVECTOR_DATA (obarray)[hash];
323 else if (!SYMBOLP (bucket))
324 error ("Bad data in guts of obarray"); /* Like CADR error message */
326 for (tail = XSYMBOL (bucket); ;)
328 if (string_length (tail->name) == size &&
329 !memcmp (string_data (tail->name), ptr, size))
331 XSETSYMBOL (bucket, tail);
334 tail = symbol_next (tail);
338 return make_int (hash);
341 #if 0 /* Emacs 19.34 */
343 hash_string (CONST Bufbyte *ptr, Bytecount len)
345 CONST Bufbyte *p = ptr;
346 CONST Bufbyte *end = p + len;
353 if (c >= 0140) c -= 40;
354 hash = ((hash<<3) + (hash>>28) + c);
356 return hash & 07777777777;
360 /* derived from hashpjw, Dragon Book P436. */
362 hash_string (CONST Bufbyte *ptr, Bytecount len)
369 hash = (hash << 4) + *ptr++;
370 g = hash & 0xf0000000;
372 hash = (hash ^ (g >> 24)) ^ g;
374 return hash & 07777777777;
377 /* Map FN over OBARRAY. The mapping is stopped when FN returns a
380 map_obarray (Lisp_Object obarray,
381 int (*fn) (Lisp_Object, void *), void *arg)
385 CHECK_VECTOR (obarray);
386 for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--)
388 Lisp_Object tail = XVECTOR_DATA (obarray)[i];
392 struct Lisp_Symbol *next;
393 if ((*fn) (tail, arg))
395 next = symbol_next (XSYMBOL (tail));
398 XSETSYMBOL (tail, next);
404 mapatoms_1 (Lisp_Object sym, void *arg)
406 call1 (*(Lisp_Object *)arg, sym);
410 DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /*
411 Call FUNCTION on every symbol in OBARRAY.
412 OBARRAY defaults to the value of `obarray'.
418 obarray = check_obarray (obarray);
420 map_obarray (obarray, mapatoms_1, &function);
425 /**********************************************************************/
427 /**********************************************************************/
429 struct appropos_mapper_closure
432 Lisp_Object predicate;
433 Lisp_Object accumulation;
437 apropos_mapper (Lisp_Object symbol, void *arg)
439 struct appropos_mapper_closure *closure =
440 (struct appropos_mapper_closure *) arg;
441 Bytecount match = fast_lisp_string_match (closure->regexp,
442 Fsymbol_name (symbol));
445 (NILP (closure->predicate) ||
446 !NILP (call1 (closure->predicate, symbol))))
447 closure->accumulation = Fcons (symbol, closure->accumulation);
452 DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /*
453 Show all symbols whose names contain match for REGEXP.
454 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL)
455 is done for each symbol and a symbol is mentioned only if that
457 Return list of symbols found.
461 struct appropos_mapper_closure closure;
463 CHECK_STRING (regexp);
465 closure.regexp = regexp;
466 closure.predicate = predicate;
467 closure.accumulation = Qnil;
468 map_obarray (Vobarray, apropos_mapper, &closure);
469 closure.accumulation = Fsort (closure.accumulation, Qstring_lessp);
470 return closure.accumulation;
474 /* Extract and set components of symbols */
476 static void set_up_buffer_local_cache (Lisp_Object sym,
477 struct symbol_value_buffer_local *bfwd,
479 Lisp_Object new_alist_el,
482 DEFUN ("boundp", Fboundp, 1, 1, 0, /*
483 Return t if SYMBOL's value is not void.
487 CHECK_SYMBOL (symbol);
488 return UNBOUNDP (find_symbol_value (symbol)) ? Qnil : Qt;
491 DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /*
492 Return t if SYMBOL has a global (non-bound) value.
493 This is for the byte-compiler; you really shouldn't be using this.
497 CHECK_SYMBOL (symbol);
498 return UNBOUNDP (top_level_value (symbol)) ? Qnil : Qt;
501 DEFUN ("fboundp", Ffboundp, 1, 1, 0, /*
502 Return t if SYMBOL's function definition is not void.
506 CHECK_SYMBOL (symbol);
507 return UNBOUNDP (XSYMBOL (symbol)->function) ? Qnil : Qt;
510 /* Return non-zero if SYM's value or function (the current contents of
511 which should be passed in as VAL) is constant, i.e. unsettable. */
514 symbol_is_constant (Lisp_Object sym, Lisp_Object val)
516 /* #### - I wonder if it would be better to just have a new magic value
517 type and make nil, t, and all keywords have that same magic
518 constant_symbol value. This test is awfully specific about what is
519 constant and what isn't. --Stig */
520 if (EQ (sym, Qnil) ||
524 if (SYMBOL_VALUE_MAGIC_P (val))
525 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
527 case SYMVAL_CONST_OBJECT_FORWARD:
528 case SYMVAL_CONST_SPECIFIER_FORWARD:
529 case SYMVAL_CONST_FIXNUM_FORWARD:
530 case SYMVAL_CONST_BOOLEAN_FORWARD:
531 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
532 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
534 default: break; /* Warning suppression */
537 /* We don't return true for keywords here because they are handled
538 specially by reject_constant_symbols(). */
542 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
543 non-zero) to NEWVAL. Make sure this is allowed.
544 FOLLOW_PAST_LISP_MAGIC specifies whether we delve past
545 symbol-value-lisp-magic objects. */
548 reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p,
549 Lisp_Object follow_past_lisp_magic)
552 (function_p ? XSYMBOL (sym)->function
553 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
555 if (SYMBOL_VALUE_MAGIC_P (val) &&
556 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
557 signal_simple_error ("Use `set-specifier' to change a specifier's value",
560 if (symbol_is_constant (sym, val)
561 || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)))
562 signal_error (Qsetting_constant,
563 UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
566 /* Verify that it's ok to make SYM buffer-local. This rejects
567 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC
568 specifies whether we delve into symbol-value-lisp-magic objects.
569 (Should be a symbol indicating what action is being taken; that way,
570 we don't delve if there's a handler for that action, but do otherwise.) */
573 verify_ok_for_buffer_local (Lisp_Object sym,
574 Lisp_Object follow_past_lisp_magic)
576 Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic);
578 if (symbol_is_constant (sym, val))
580 if (SYMBOL_VALUE_MAGIC_P (val))
581 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
583 case SYMVAL_DEFAULT_BUFFER_FORWARD:
584 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
585 /* #### It's theoretically possible for it to be reasonable
586 to have both console-local and buffer-local variables,
587 but I don't want to consider that right now. */
588 case SYMVAL_SELECTED_CONSOLE_FORWARD:
590 default: break; /* Warning suppression */
596 signal_error (Qerror,
597 list2 (build_string ("Symbol may not be buffer-local"), sym));
600 DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /*
601 Make SYMBOL's value be void.
605 Fset (symbol, Qunbound);
609 DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /*
610 Make SYMBOL's function definition be void.
614 CHECK_SYMBOL (symbol);
615 reject_constant_symbols (symbol, Qunbound, 1, Qt);
616 XSYMBOL (symbol)->function = Qunbound;
620 DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /*
621 Return SYMBOL's function definition. Error if that is void.
625 CHECK_SYMBOL (symbol);
626 if (UNBOUNDP (XSYMBOL (symbol)->function))
627 signal_void_function_error (symbol);
628 return XSYMBOL (symbol)->function;
631 DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /*
632 Return SYMBOL's property list.
636 CHECK_SYMBOL (symbol);
637 return XSYMBOL (symbol)->plist;
640 DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /*
641 Return SYMBOL's name, a string.
647 CHECK_SYMBOL (symbol);
648 XSETSTRING (name, XSYMBOL (symbol)->name);
652 DEFUN ("fset", Ffset, 2, 2, 0, /*
653 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
657 /* This function can GC */
658 CHECK_SYMBOL (symbol);
659 reject_constant_symbols (symbol, newdef, 1, Qt);
660 if (!NILP (Vautoload_queue) && !UNBOUNDP (XSYMBOL (symbol)->function))
661 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
663 XSYMBOL (symbol)->function = newdef;
664 /* Handle automatic advice activation */
665 if (CONSP (XSYMBOL (symbol)->plist) &&
666 !NILP (Fget (symbol, Qad_advice_info, Qnil)))
668 call2 (Qad_activate, symbol, Qnil);
669 newdef = XSYMBOL (symbol)->function;
675 DEFUN ("define-function", Fdefine_function, 2, 2, 0, /*
676 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
677 Associates the function with the current load file, if any.
681 /* This function can GC */
682 Ffset (symbol, newdef);
683 LOADHIST_ATTACH (symbol);
688 DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
689 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
693 CHECK_SYMBOL (symbol);
694 #if 0 /* Inserted for debugging 6/28/1997 -slb */
695 /* Somebody is setting a property list of integer 0, who? */
696 /* Not this way apparently. */
697 if (EQ(newplist, Qzero)) abort();
700 XSYMBOL (symbol)->plist = newplist;
705 /**********************************************************************/
707 /**********************************************************************/
709 /* If the contents of the value cell of a symbol is one of the following
710 three types of objects, then the symbol is "magic" in that setting
711 and retrieving its value doesn't just set or retrieve the raw
712 contents of the value cell. None of these objects can escape to
713 the user level, so there is no loss of generality.
715 If a symbol is "unbound", then the contents of its value cell is
716 Qunbound. Despite appearances, this is *not* a symbol, but is a
717 symbol-value-forward object. This is so that printing it results
718 in "INTERNAL OBJECT (XEmacs bug?)", in case it leaks to Lisp, somehow.
720 Logically all of the following objects are "symbol-value-magic"
721 objects, and there are some games played w.r.t. this (#### this
722 should be cleaned up). SYMBOL_VALUE_MAGIC_P is true for all of
723 the object types. XSYMBOL_VALUE_MAGIC_TYPE returns the type of
724 symbol-value-magic object. There are more than three types
725 returned by this macro: in particular, symbol-value-forward
726 has eight subtypes, and symbol-value-buffer-local has two. See
729 1. symbol-value-forward
731 symbol-value-forward is used for variables whose actual contents
732 are stored in a C variable of some sort, and for Qunbound. The
733 lcheader.next field (which is only used to chain together free
734 lcrecords) holds a pointer to the actual C variable. Included
735 in this type are "buffer-local" variables that are actually
736 stored in the buffer object itself; in this case, the "pointer"
737 is an offset into the struct buffer structure.
739 The subtypes are as follows:
741 SYMVAL_OBJECT_FORWARD:
742 (declare with DEFVAR_LISP)
743 The value of this variable is stored in a C variable of type
744 "Lisp_Object". Setting this variable sets the C variable.
745 Accessing this variable retrieves a value from the C variable.
746 These variables can be buffer-local -- in this case, the
747 raw symbol-value field gets converted into a
748 symbol-value-buffer-local, whose "current_value" slot contains
749 the symbol-value-forward. (See below.)
751 SYMVAL_FIXNUM_FORWARD:
752 SYMVAL_BOOLEAN_FORWARD:
753 (declare with DEFVAR_INT or DEFVAR_BOOL)
754 Similar to SYMVAL_OBJECT_FORWARD except that the C variable
755 is of type "int" and is an integer or boolean, respectively.
757 SYMVAL_CONST_OBJECT_FORWARD:
758 SYMVAL_CONST_FIXNUM_FORWARD:
759 SYMVAL_CONST_BOOLEAN_FORWARD:
760 (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
762 Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
763 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
766 SYMVAL_CONST_SPECIFIER_FORWARD:
767 (declare with DEFVAR_SPECIFIER)
768 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that error message
769 you get when attempting to set the value says to use
770 `set-specifier' instead.
772 SYMVAL_CURRENT_BUFFER_FORWARD:
773 (declare with DEFVAR_BUFFER_LOCAL)
774 This is used for built-in buffer-local variables -- i.e.
775 Lisp variables whose value is stored in the "struct buffer".
776 Variables of this sort always forward into C "Lisp_Object"
777 fields (although there's no reason in principle that other
778 types for ints and booleans couldn't be added). Note that
779 some of these variables are automatically local in each
780 buffer, while some are only local when they become set
781 (similar to `make-variable-buffer-local'). In these latter
782 cases, of course, the default value shows through in all
783 buffers in which the variable doesn't have a local value.
784 This is implemented by making sure the "struct buffer" field
785 always contains the correct value (whether it's local or
786 a default) and maintaining a mask in the "struct buffer"
787 indicating which fields are local. When `set-default' is
788 called on a variable that's not always local to all buffers,
789 it loops through each buffer and sets the corresponding
790 field in each buffer without a local value for the field,
791 according to the mask.
793 Calling `make-local-variable' on a variable of this sort
794 only has the effect of maybe changing the current buffer's mask.
795 Calling `make-variable-buffer-local' on a variable of this
796 sort has no effect at all.
798 SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
799 (declare with DEFVAR_CONST_BUFFER_LOCAL)
800 Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
803 SYMVAL_DEFAULT_BUFFER_FORWARD:
804 (declare with DEFVAR_BUFFER_DEFAULTS)
805 This is used for the Lisp variables that contain the
806 default values of built-in buffer-local variables. Setting
807 or referencing one of these variables forwards into a slot
808 in the special struct buffer Vbuffer_defaults.
810 SYMVAL_UNBOUND_MARKER:
811 This is used for only one object, Qunbound.
813 SYMVAL_SELECTED_CONSOLE_FORWARD:
814 (declare with DEFVAR_CONSOLE_LOCAL)
815 This is used for built-in console-local variables -- i.e.
816 Lisp variables whose value is stored in the "struct console".
817 These work just like built-in buffer-local variables.
818 However, calling `make-local-variable' or
819 `make-variable-buffer-local' on one of these variables
820 is currently disallowed because that would entail having
821 both console-local and buffer-local variables, which is
822 trickier to implement.
824 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
825 (declare with DEFVAR_CONST_CONSOLE_LOCAL)
826 Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
829 SYMVAL_DEFAULT_CONSOLE_FORWARD:
830 (declare with DEFVAR_CONSOLE_DEFAULTS)
831 This is used for the Lisp variables that contain the
832 default values of built-in console-local variables. Setting
833 or referencing one of these variables forwards into a slot
834 in the special struct console Vconsole_defaults.
837 2. symbol-value-buffer-local
839 symbol-value-buffer-local is used for variables that have had
840 `make-local-variable' or `make-variable-buffer-local' applied
841 to them. This object contains an alist mapping buffers to
842 values. In addition, the object contains a "current value",
843 which is the value in some buffer. Whenever you access the
844 variable with `symbol-value' or set it with `set' or `setq',
845 things are switched around so that the "current value"
846 refers to the current buffer, if it wasn't already. This
847 way, repeated references to a variable in the same buffer
848 are almost as efficient as if the variable weren't buffer
849 local. Note that the alist may not be up-to-date w.r.t.
850 the buffer whose value is current, as the "current value"
851 cache is normally only flushed into the alist when the
852 buffer it refers to changes.
854 Note also that it is possible for `make-local-variable'
855 or `make-variable-buffer-local' to be called on a variable
856 that forwards into a C variable (i.e. a variable whose
857 value cell is a symbol-value-forward). In this case,
858 the value cell becomes a symbol-value-buffer-local (as
859 always), and the symbol-value-forward moves into
860 the "current value" cell in this object. Also, in
861 this case the "current value" *always* refers to the
862 current buffer, so that the values of the C variable
863 always is the correct value for the current buffer.
864 set_buffer_internal() automatically updates the current-value
865 cells of all buffer-local variables that forward into C
866 variables. (There is a list of all buffer-local variables
867 that is maintained for this and other purposes.)
869 Note that only certain types of `symbol-value-forward' objects
870 can find their way into the "current value" cell of a
871 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
872 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
873 SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot
874 be buffer-local because they are unsettable;
875 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
876 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
877 does not have much of an effect (it's already buffer-local); and
878 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
879 that's not currently implemented.
882 3. symbol-value-varalias
884 A symbol-value-varalias object is used for variables that
885 are aliases for other variables. This object contains
886 the symbol that this variable is aliased to.
887 symbol-value-varalias objects cannot occur anywhere within
888 a symbol-value-buffer-local object, and most of the
889 low-level functions below do not accept them; you need
890 to call follow_varalias_pointers to get the actual
891 symbol to operate on. */
894 mark_symbol_value_buffer_local (Lisp_Object obj,
895 void (*markobj) (Lisp_Object))
897 struct symbol_value_buffer_local *bfwd;
899 #ifdef ERROR_CHECK_TYPECHECK
900 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
901 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
904 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
905 markobj (bfwd->default_value);
906 markobj (bfwd->current_value);
907 markobj (bfwd->current_buffer);
908 return bfwd->current_alist_element;
912 mark_symbol_value_lisp_magic (Lisp_Object obj,
913 void (*markobj) (Lisp_Object))
915 struct symbol_value_lisp_magic *bfwd;
918 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
920 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
921 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
923 markobj (bfwd->handler[i]);
924 markobj (bfwd->harg[i]);
926 return bfwd->shadowed;
930 mark_symbol_value_varalias (Lisp_Object obj,
931 void (*markobj) (Lisp_Object))
933 struct symbol_value_varalias *bfwd;
935 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
937 bfwd = XSYMBOL_VALUE_VARALIAS (obj);
938 markobj (bfwd->shadowed);
939 return bfwd->aliasee;
942 /* Should never, ever be called. (except by an external debugger) */
944 print_symbol_value_magic (Lisp_Object obj,
945 Lisp_Object printcharfun, int escapeflag)
948 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s type %d) 0x%lx>",
949 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
950 XSYMBOL_VALUE_MAGIC_TYPE (obj),
952 write_c_string (buf, printcharfun);
955 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
956 symbol_value_forward,
957 this_one_is_unmarkable,
958 print_symbol_value_magic, 0, 0, 0,
959 struct symbol_value_forward);
961 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
962 symbol_value_buffer_local,
963 mark_symbol_value_buffer_local,
964 print_symbol_value_magic, 0, 0, 0,
965 struct symbol_value_buffer_local);
967 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
968 symbol_value_lisp_magic,
969 mark_symbol_value_lisp_magic,
970 print_symbol_value_magic, 0, 0, 0,
971 struct symbol_value_lisp_magic);
973 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
974 symbol_value_varalias,
975 mark_symbol_value_varalias,
976 print_symbol_value_magic, 0, 0, 0,
977 struct symbol_value_varalias);
980 /* Getting and setting values of symbols */
982 /* Given the raw contents of a symbol value cell, return the Lisp value of
983 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
984 symbol-value-lisp-magic, or symbol-value-varalias.
986 BUFFER specifies a buffer, and is used for built-in buffer-local
987 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
988 Note that such variables are never encapsulated in a
989 symbol-value-buffer-local structure.
991 CONSOLE specifies a console, and is used for built-in console-local
992 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
993 Note that such variables are (currently) never encapsulated in a
994 symbol-value-buffer-local structure.
998 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
999 struct console *console)
1001 CONST struct symbol_value_forward *fwd;
1003 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1006 fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1007 switch (fwd->magic.type)
1009 case SYMVAL_FIXNUM_FORWARD:
1010 case SYMVAL_CONST_FIXNUM_FORWARD:
1011 return make_int (*((int *)symbol_value_forward_forward (fwd)));
1013 case SYMVAL_BOOLEAN_FORWARD:
1014 case SYMVAL_CONST_BOOLEAN_FORWARD:
1015 return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
1017 case SYMVAL_OBJECT_FORWARD:
1018 case SYMVAL_CONST_OBJECT_FORWARD:
1019 case SYMVAL_CONST_SPECIFIER_FORWARD:
1020 return *((Lisp_Object *)symbol_value_forward_forward (fwd));
1022 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1023 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1024 + ((char *)symbol_value_forward_forward (fwd)
1025 - (char *)&buffer_local_flags))));
1028 case SYMVAL_CURRENT_BUFFER_FORWARD:
1029 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1031 return (*((Lisp_Object *)((char *)buffer
1032 + ((char *)symbol_value_forward_forward (fwd)
1033 - (char *)&buffer_local_flags))));
1035 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1036 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1037 + ((char *)symbol_value_forward_forward (fwd)
1038 - (char *)&console_local_flags))));
1040 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1041 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1043 return (*((Lisp_Object *)((char *)console
1044 + ((char *)symbol_value_forward_forward (fwd)
1045 - (char *)&console_local_flags))));
1047 case SYMVAL_UNBOUND_MARKER:
1053 return Qnil; /* suppress compiler warning */
1056 /* Set the value of default-buffer-local variable SYM to VALUE. */
1059 set_default_buffer_slot_variable (Lisp_Object sym,
1062 /* Handle variables like case-fold-search that have special slots in
1063 the buffer. Make them work apparently like buffer_local variables.
1065 /* At this point, the value cell may not contain a symbol-value-varalias
1066 or symbol-value-buffer-local, and if there's a handler, we should
1067 have already called it. */
1068 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1069 CONST struct symbol_value_forward *fwd
1070 = XSYMBOL_VALUE_FORWARD (valcontents);
1071 int offset = ((char *) symbol_value_forward_forward (fwd)
1072 - (char *) &buffer_local_flags);
1073 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1074 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1075 int flags) = symbol_value_forward_magicfun (fwd);
1077 *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
1080 if (mask > 0) /* Not always per-buffer */
1084 /* Set value in each buffer which hasn't shadowed the default */
1085 LIST_LOOP_2 (elt, Vbuffer_alist)
1087 struct buffer *b = XBUFFER (XCDR (elt));
1088 if (!(b->local_var_flags & mask))
1091 magicfun (sym, &value, make_buffer (b), 0);
1092 *((Lisp_Object *) (offset + (char *) b)) = value;
1098 /* Set the value of default-console-local variable SYM to VALUE. */
1101 set_default_console_slot_variable (Lisp_Object sym,
1104 /* Handle variables like case-fold-search that have special slots in
1105 the console. Make them work apparently like console_local variables.
1107 /* At this point, the value cell may not contain a symbol-value-varalias
1108 or symbol-value-buffer-local, and if there's a handler, we should
1109 have already called it. */
1110 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1111 CONST struct symbol_value_forward *fwd
1112 = XSYMBOL_VALUE_FORWARD (valcontents);
1113 int offset = ((char *) symbol_value_forward_forward (fwd)
1114 - (char *) &console_local_flags);
1115 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1116 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1117 int flags) = symbol_value_forward_magicfun (fwd);
1119 *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
1122 if (mask > 0) /* Not always per-console */
1124 Lisp_Object console;
1126 /* Set value in each console which hasn't shadowed the default */
1127 LIST_LOOP_2 (console, Vconsole_list)
1129 struct console *d = XCONSOLE (console);
1130 if (!(d->local_var_flags & mask))
1133 magicfun (sym, &value, console, 0);
1134 *((Lisp_Object *) (offset + (char *) d)) = value;
1140 /* Store NEWVAL into SYM.
1142 SYM's value slot may *not* be types (5) or (6) above,
1143 i.e. no symbol-value-varalias objects. (You should have
1144 forwarded past all of these.)
1146 SYM should not be an unsettable symbol or a symbol with
1147 a magic `set-value' handler (unless you want to explicitly
1148 ignore this handler).
1150 OVALUE is the current value of SYM, but forwarded past any
1151 symbol-value-buffer-local and symbol-value-lisp-magic objects.
1152 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1153 the contents of its current-value cell.) NEWVAL may only be
1154 a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
1155 this function will only modify its current-value cell, which should
1156 already be set up to point to the current buffer.
1160 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
1163 if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
1165 Lisp_Object *store_pointer = value_slot_past_magic (sym);
1167 if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
1169 &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
1171 assert (UNBOUNDP (*store_pointer)
1172 || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1173 *store_pointer = newval;
1177 CONST struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue);
1178 int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
1179 Lisp_Object in_object, int flags)
1180 = symbol_value_forward_magicfun (fwd);
1182 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue))
1184 case SYMVAL_FIXNUM_FORWARD:
1187 magicfun (sym, &newval, Qnil, 0);
1188 *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
1191 case SYMVAL_BOOLEAN_FORWARD:
1193 magicfun (sym, &newval, Qnil, 0);
1194 *((int *) symbol_value_forward_forward (fwd))
1195 = ((NILP (newval)) ? 0 : 1);
1198 case SYMVAL_OBJECT_FORWARD:
1200 magicfun (sym, &newval, Qnil, 0);
1201 *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
1204 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1205 set_default_buffer_slot_variable (sym, newval);
1208 case SYMVAL_CURRENT_BUFFER_FORWARD:
1210 magicfun (sym, &newval, make_buffer (current_buffer), 0);
1211 *((Lisp_Object *) ((char *) current_buffer
1212 + ((char *) symbol_value_forward_forward (fwd)
1213 - (char *) &buffer_local_flags)))
1217 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1218 set_default_console_slot_variable (sym, newval);
1221 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1223 magicfun (sym, &newval, Vselected_console, 0);
1224 *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console)
1225 + ((char *) symbol_value_forward_forward (fwd)
1226 - (char *) &console_local_flags)))
1236 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1237 BFWD, locate and return a pointer to the element in BUFFER's
1238 local_var_alist for SYMBOL. The return value will be Qnil if
1239 BUFFER does not have its own value for SYMBOL (i.e. the default
1240 value is seen in that buffer).
1244 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
1245 struct symbol_value_buffer_local *bfwd)
1247 if (!NILP (bfwd->current_buffer) &&
1248 XBUFFER (bfwd->current_buffer) == buffer)
1249 /* This is just an optimization of the below. */
1250 return bfwd->current_alist_element;
1252 return assq_no_quit (symbol, buffer->local_var_alist);
1255 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1256 symbol-value-buffer-local of a per-buffer variable -- i.e. the
1257 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1258 slot -- may be out of date.]
1260 Write out any cached value in buffer-local variable SYMBOL's
1261 buffer-local structure, which is passed in as BFWD.
1265 write_out_buffer_local_cache (Lisp_Object symbol,
1266 struct symbol_value_buffer_local *bfwd)
1268 if (!NILP (bfwd->current_buffer))
1270 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1271 uses it, and that type cannot be inside a symbol-value-buffer-local */
1272 Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0);
1273 if (NILP (bfwd->current_alist_element))
1274 /* current_value may be updated more recently than default_value */
1275 bfwd->default_value = cval;
1277 Fsetcdr (bfwd->current_alist_element, cval);
1281 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1282 Set up BFWD's cache for validity in buffer BUF. This assumes that
1283 the cache is currently in a consistent state (this can include
1284 not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1286 If the cache is already set up for BUF, this function does nothing
1289 Otherwise, if SYM forwards out to a C variable, this also forwards
1290 SYM's value in BUF out to the variable. Therefore, you generally
1291 only want to call this when BUF is, or is about to become, the
1294 (Otherwise, you can just retrieve the value without changing the
1295 cache, at the expense of slower retrieval.)
1299 set_up_buffer_local_cache (Lisp_Object sym,
1300 struct symbol_value_buffer_local *bfwd,
1302 Lisp_Object new_alist_el,
1305 Lisp_Object new_val;
1307 if (!NILP (bfwd->current_buffer)
1308 && buf == XBUFFER (bfwd->current_buffer))
1309 /* Cache is already set up. */
1312 /* Flush out the old cache. */
1313 write_out_buffer_local_cache (sym, bfwd);
1315 /* Retrieve the new alist element and new value. */
1316 if (NILP (new_alist_el)
1318 new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1320 if (NILP (new_alist_el))
1321 new_val = bfwd->default_value;
1323 new_val = Fcdr (new_alist_el);
1325 bfwd->current_alist_element = new_alist_el;
1326 XSETBUFFER (bfwd->current_buffer, buf);
1328 /* Now store the value into the current-value slot.
1329 We don't simply write it there, because the current-value
1330 slot might be a forwarding pointer, in which case we need
1331 to instead write the value into the C variable.
1333 We might also want to call a magic function.
1335 So instead, we call this function. */
1336 store_symval_forwarding (sym, bfwd->current_value, new_val);
1341 kill_buffer_local_variables (struct buffer *buf)
1343 Lisp_Object prev = Qnil;
1346 /* Any which are supposed to be permanent,
1347 make local again, with the same values they had. */
1349 for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
1351 Lisp_Object sym = XCAR (XCAR (alist));
1352 struct symbol_value_buffer_local *bfwd;
1353 /* Variables with a symbol-value-varalias should not be here
1354 (we should have forwarded past them) and there must be a
1355 symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
1356 just forward past it; if the variable has a handler, it was
1358 Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
1360 assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
1361 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
1363 if (!NILP (Fget (sym, Qpermanent_local, Qnil)))
1364 /* prev points to the last alist element that is still
1365 staying around, so *only* update it now. This didn't
1366 used to be the case; this bug has been around since
1367 mly's rewrite two years ago! */
1371 /* Really truly kill it. */
1373 XCDR (prev) = XCDR (alist);
1375 buf->local_var_alist = XCDR (alist);
1377 /* We just effectively changed the value for this variable
1380 /* (1) If the cache is caching BUF, invalidate the cache. */
1381 if (!NILP (bfwd->current_buffer) &&
1382 buf == XBUFFER (bfwd->current_buffer))
1383 bfwd->current_buffer = Qnil;
1385 /* (2) If we changed the value in current_buffer and this
1386 variable forwards to a C variable, we need to change the
1387 value of the C variable. set_up_buffer_local_cache()
1388 will do this. It doesn't hurt to do it whenever
1389 BUF == current_buffer, so just go ahead and do that. */
1390 if (buf == current_buffer)
1391 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
1397 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1398 struct console *con, int swap_it_in,
1399 Lisp_Object symcons, int set_it_p)
1401 Lisp_Object valcontents;
1404 valcontents = XSYMBOL (sym)->value;
1407 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1410 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1412 case SYMVAL_LISP_MAGIC:
1414 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1418 case SYMVAL_VARALIAS:
1419 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1421 /* presto change-o! */
1424 case SYMVAL_BUFFER_LOCAL:
1425 case SYMVAL_SOME_BUFFER_LOCAL:
1427 struct symbol_value_buffer_local *bfwd
1428 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1432 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1433 valcontents = bfwd->current_value;
1437 if (!NILP (bfwd->current_buffer) &&
1438 buf == XBUFFER (bfwd->current_buffer))
1439 valcontents = bfwd->current_value;
1440 else if (NILP (symcons))
1443 valcontents = assq_no_quit (sym, buf->local_var_alist);
1444 if (NILP (valcontents))
1445 valcontents = bfwd->default_value;
1447 valcontents = XCDR (valcontents);
1450 valcontents = XCDR (symcons);
1458 return do_symval_forwarding (valcontents, buf, con);
1462 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1463 bound. Note that it must not be possible to QUIT within this
1467 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
1474 buf = current_buffer;
1477 CHECK_BUFFER (buffer);
1478 buf = XBUFFER (buffer);
1481 return find_symbol_value_1 (sym, buf,
1482 /* If it bombs out at startup due to a
1483 Lisp error, this may be nil. */
1484 CONSOLEP (Vselected_console)
1485 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
1489 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1494 console = Vselected_console;
1496 CHECK_CONSOLE (console);
1498 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1502 /* Return the current value of SYM. The difference between this function
1503 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1504 this updates the CURRENT_VALUE slot of buffer-local variables to
1505 point to the current buffer, while symbol_value_in_buffer doesn't. */
1508 find_symbol_value (Lisp_Object sym)
1510 /* WARNING: This function can be called when current_buffer is 0
1511 and Vselected_console is Qnil, early in initialization. */
1512 struct console *con;
1513 Lisp_Object valcontents;
1517 valcontents = XSYMBOL (sym)->value;
1518 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1521 if (CONSOLEP (Vselected_console))
1522 con = XCONSOLE (Vselected_console);
1525 /* This can also get called while we're preparing to shutdown.
1526 #### What should really happen in that case? Should we
1527 actually fix things so we can't get here in that case? */
1528 assert (!initialized || preparing_for_armageddon);
1532 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
1535 /* This is an optimized function for quick lookup of buffer local symbols
1536 by avoiding O(n) search. This will work when either:
1537 a) We have already found the symbol e.g. by traversing local_var_alist.
1539 b) We know that the symbol will not be found in the current buffer's
1540 list of local variables.
1541 In the former case, find_it_p is 1 and symbol_cons is the element from
1542 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1545 This function is called from set_buffer_internal which does both of these
1549 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1551 /* WARNING: This function can be called when current_buffer is 0
1552 and Vselected_console is Qnil, early in initialization. */
1553 struct console *con;
1554 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1557 if (CONSOLEP (Vselected_console))
1558 con = XCONSOLE (Vselected_console);
1561 /* This can also get called while we're preparing to shutdown.
1562 #### What should really happen in that case? Should we
1563 actually fix things so we can't get here in that case? */
1564 assert (!initialized || preparing_for_armageddon);
1568 return find_symbol_value_1 (sym, current_buffer, con, 1,
1569 find_it_p ? symbol_cons : Qnil,
1573 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1574 Return SYMBOL's value. Error if that is void.
1578 Lisp_Object val = find_symbol_value (symbol);
1581 return Fsignal (Qvoid_variable, list1 (symbol));
1586 DEFUN ("set", Fset, 2, 2, 0, /*
1587 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1591 REGISTER Lisp_Object valcontents;
1592 struct Lisp_Symbol *sym;
1593 /* remember, we're called by Fmakunbound() as well */
1595 CHECK_SYMBOL (symbol);
1598 sym = XSYMBOL (symbol);
1599 valcontents = sym->value;
1601 if (EQ (symbol, Qnil) ||
1603 SYMBOL_IS_KEYWORD (symbol))
1604 reject_constant_symbols (symbol, newval, 0,
1605 UNBOUNDP (newval) ? Qmakunbound : Qset);
1607 if (!SYMBOL_VALUE_MAGIC_P (valcontents) || UNBOUNDP (valcontents))
1609 sym->value = newval;
1613 reject_constant_symbols (symbol, newval, 0,
1614 UNBOUNDP (newval) ? Qmakunbound : Qset);
1618 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1620 case SYMVAL_LISP_MAGIC:
1624 if (UNBOUNDP (newval))
1625 retval = maybe_call_magic_handler (symbol, Qmakunbound, 0);
1627 retval = maybe_call_magic_handler (symbol, Qset, 1, newval);
1628 if (!UNBOUNDP (retval))
1630 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1635 case SYMVAL_VARALIAS:
1636 symbol = follow_varalias_pointers (symbol,
1638 ? Qmakunbound : Qset);
1639 /* presto change-o! */
1642 case SYMVAL_FIXNUM_FORWARD:
1643 case SYMVAL_BOOLEAN_FORWARD:
1644 case SYMVAL_OBJECT_FORWARD:
1645 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1646 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1647 if (UNBOUNDP (newval))
1648 signal_error (Qerror,
1649 list2 (build_string ("Cannot makunbound"), symbol));
1652 /* case SYMVAL_UNBOUND_MARKER: break; */
1654 case SYMVAL_CURRENT_BUFFER_FORWARD:
1656 CONST struct symbol_value_forward *fwd
1657 = XSYMBOL_VALUE_FORWARD (valcontents);
1658 int mask = XINT (*((Lisp_Object *)
1659 symbol_value_forward_forward (fwd)));
1661 /* Setting this variable makes it buffer-local */
1662 current_buffer->local_var_flags |= mask;
1666 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1668 CONST struct symbol_value_forward *fwd
1669 = XSYMBOL_VALUE_FORWARD (valcontents);
1670 int mask = XINT (*((Lisp_Object *)
1671 symbol_value_forward_forward (fwd)));
1673 /* Setting this variable makes it console-local */
1674 XCONSOLE (Vselected_console)->local_var_flags |= mask;
1678 case SYMVAL_BUFFER_LOCAL:
1679 case SYMVAL_SOME_BUFFER_LOCAL:
1681 /* If we want to examine or set the value and
1682 CURRENT-BUFFER is current, we just examine or set
1683 CURRENT-VALUE. If CURRENT-BUFFER is not current, we
1684 store the current CURRENT-VALUE value into
1685 CURRENT-ALIST- ELEMENT, then find the appropriate alist
1686 element for the buffer now current and set up
1687 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
1688 of that element, and store into CURRENT-BUFFER.
1690 If we are setting the variable and the current buffer does
1691 not have an alist entry for this variable, an alist entry is
1694 Note that CURRENT-VALUE can be a forwarding pointer.
1695 Each time it is examined or set, forwarding must be
1697 struct symbol_value_buffer_local *bfwd
1698 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1699 int some_buffer_local_p =
1700 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
1701 /* What value are we caching right now? */
1702 Lisp_Object aelt = bfwd->current_alist_element;
1704 if (!NILP (bfwd->current_buffer) &&
1705 current_buffer == XBUFFER (bfwd->current_buffer)
1706 && ((some_buffer_local_p)
1707 ? 1 /* doesn't automatically become local */
1708 : !NILP (aelt) /* already local */
1711 /* Cache is valid */
1712 valcontents = bfwd->current_value;
1716 /* If the current buffer is not the buffer whose binding is
1717 currently cached, or if it's a SYMVAL_BUFFER_LOCAL and
1718 we're looking at the default value, the cache is invalid; we
1719 need to write it out, and find the new CURRENT-ALIST-ELEMENT
1722 /* Write out the cached value for the old buffer; copy it
1723 back to its alist element. This works if the current
1724 buffer only sees the default value, too. */
1725 write_out_buffer_local_cache (symbol, bfwd);
1727 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1728 aelt = buffer_local_alist_element (current_buffer, symbol, bfwd);
1731 /* This buffer is still seeing the default value. */
1732 if (!some_buffer_local_p)
1734 /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a
1735 new assoc for a local value and set
1736 CURRENT-ALIST-ELEMENT to point to that. */
1738 do_symval_forwarding (bfwd->current_value,
1740 XCONSOLE (Vselected_console));
1741 aelt = Fcons (symbol, aelt);
1742 current_buffer->local_var_alist
1743 = Fcons (aelt, current_buffer->local_var_alist);
1747 /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
1748 we're currently seeing the default value. */
1752 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1753 bfwd->current_alist_element = aelt;
1754 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
1755 XSETBUFFER (bfwd->current_buffer, current_buffer);
1756 valcontents = bfwd->current_value;
1763 store_symval_forwarding (symbol, valcontents, newval);
1769 /* Access or set a buffer-local symbol's default value. */
1771 /* Return the default value of SYM, but don't check for voidness.
1772 Return Qunbound if it is void. */
1775 default_value (Lisp_Object sym)
1777 Lisp_Object valcontents;
1782 valcontents = XSYMBOL (sym)->value;
1785 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1788 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1790 case SYMVAL_LISP_MAGIC:
1792 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1796 case SYMVAL_VARALIAS:
1797 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1798 /* presto change-o! */
1801 case SYMVAL_UNBOUND_MARKER:
1804 case SYMVAL_CURRENT_BUFFER_FORWARD:
1806 CONST struct symbol_value_forward *fwd
1807 = XSYMBOL_VALUE_FORWARD (valcontents);
1808 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1809 + ((char *)symbol_value_forward_forward (fwd)
1810 - (char *)&buffer_local_flags))));
1813 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1815 CONST struct symbol_value_forward *fwd
1816 = XSYMBOL_VALUE_FORWARD (valcontents);
1817 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1818 + ((char *)symbol_value_forward_forward (fwd)
1819 - (char *)&console_local_flags))));
1822 case SYMVAL_BUFFER_LOCAL:
1823 case SYMVAL_SOME_BUFFER_LOCAL:
1825 struct symbol_value_buffer_local *bfwd =
1826 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1828 /* Handle user-created local variables. */
1829 /* If var is set up for a buffer that lacks a local value for it,
1830 the current value is nominally the default value.
1831 But the current value slot may be more up to date, since
1832 ordinary setq stores just that slot. So use that. */
1833 if (NILP (bfwd->current_alist_element))
1834 return do_symval_forwarding (bfwd->current_value, current_buffer,
1835 XCONSOLE (Vselected_console));
1837 return bfwd->default_value;
1840 /* For other variables, get the current value. */
1841 return do_symval_forwarding (valcontents, current_buffer,
1842 XCONSOLE (Vselected_console));
1845 RETURN_NOT_REACHED (Qnil) /* suppress compiler warning */
1848 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /*
1849 Return t if SYMBOL has a non-void default value.
1850 This is the value that is seen in buffers that do not have their own values
1855 return UNBOUNDP (default_value (symbol)) ? Qnil : Qt;
1858 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /*
1859 Return SYMBOL's default value.
1860 This is the value that is seen in buffers that do not have their own values
1861 for this variable. The default value is meaningful for variables with
1862 local bindings in certain buffers.
1866 Lisp_Object value = default_value (symbol);
1868 return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (symbol)) : value;
1871 DEFUN ("set-default", Fset_default, 2, 2, 0, /*
1872 Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.
1873 The default value is seen in buffers that do not have their own values
1878 Lisp_Object valcontents;
1880 CHECK_SYMBOL (symbol);
1883 valcontents = XSYMBOL (symbol)->value;
1886 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1887 return Fset (symbol, value);
1889 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1891 case SYMVAL_LISP_MAGIC:
1892 RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (symbol, Qset_default, 1,
1894 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1898 case SYMVAL_VARALIAS:
1899 symbol = follow_varalias_pointers (symbol, Qset_default);
1900 /* presto change-o! */
1903 case SYMVAL_CURRENT_BUFFER_FORWARD:
1904 set_default_buffer_slot_variable (symbol, value);
1907 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1908 set_default_console_slot_variable (symbol, value);
1911 case SYMVAL_BUFFER_LOCAL:
1912 case SYMVAL_SOME_BUFFER_LOCAL:
1914 /* Store new value into the DEFAULT-VALUE slot */
1915 struct symbol_value_buffer_local *bfwd
1916 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1918 bfwd->default_value = value;
1919 /* If current-buffer doesn't shadow default_value,
1920 * we must set the CURRENT-VALUE slot too */
1921 if (NILP (bfwd->current_alist_element))
1922 store_symval_forwarding (symbol, bfwd->current_value, value);
1927 return Fset (symbol, value);
1931 DEFUN ("setq-default", Fsetq_default, 0, UNEVALLED, 0, /*
1932 Set the default value of variable SYMBOL to VALUE.
1933 SYMBOL, the variable name, is literal (not evaluated);
1934 VALUE is an expression and it is evaluated.
1935 The default value of a variable is seen in buffers
1936 that do not have their own values for the variable.
1938 More generally, you can use multiple variables and values, as in
1939 (setq-default SYMBOL VALUE SYMBOL VALUE...)
1940 This sets each SYMBOL's default value to the corresponding VALUE.
1941 The VALUE for the Nth SYMBOL can refer to the new default values
1942 of previous SYMBOLs.
1946 /* This function can GC */
1947 Lisp_Object symbol, tail, val = Qnil;
1949 struct gcpro gcpro1;
1951 GET_LIST_LENGTH (args, nargs);
1953 if (nargs & 1) /* Odd number of arguments? */
1954 Fsignal (Qwrong_number_of_arguments,
1955 list2 (Qsetq_default, make_int (nargs)));
1959 PROPERTY_LIST_LOOP (tail, symbol, val, args)
1962 Fset_default (symbol, val);
1969 /* Lisp functions for creating and removing buffer-local variables. */
1971 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1,
1972 "vMake Variable Buffer Local: ", /*
1973 Make VARIABLE have a separate value for each buffer.
1974 At any time, the value for the current buffer is in effect.
1975 There is also a default value which is seen in any buffer which has not yet
1977 Using `set' or `setq' to set the variable causes it to have a separate value
1978 for the current buffer if it was previously using the default value.
1979 The function `default-value' gets the default value and `set-default'
1984 Lisp_Object valcontents;
1986 CHECK_SYMBOL (variable);
1989 verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
1991 valcontents = XSYMBOL (variable)->value;
1994 if (SYMBOL_VALUE_MAGIC_P (valcontents))
1996 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1998 case SYMVAL_LISP_MAGIC:
1999 if (!UNBOUNDP (maybe_call_magic_handler
2000 (variable, Qmake_variable_buffer_local, 0)))
2002 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2006 case SYMVAL_VARALIAS:
2007 variable = follow_varalias_pointers (variable,
2008 Qmake_variable_buffer_local);
2009 /* presto change-o! */
2012 case SYMVAL_FIXNUM_FORWARD:
2013 case SYMVAL_BOOLEAN_FORWARD:
2014 case SYMVAL_OBJECT_FORWARD:
2015 case SYMVAL_UNBOUND_MARKER:
2018 case SYMVAL_CURRENT_BUFFER_FORWARD:
2019 case SYMVAL_BUFFER_LOCAL:
2020 /* Already per-each-buffer */
2023 case SYMVAL_SOME_BUFFER_LOCAL:
2025 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
2026 SYMVAL_BUFFER_LOCAL;
2035 struct symbol_value_buffer_local *bfwd
2036 = alloc_lcrecord_type (struct symbol_value_buffer_local,
2037 &lrecord_symbol_value_buffer_local);
2039 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2041 bfwd->default_value = find_symbol_value (variable);
2042 bfwd->current_value = valcontents;
2043 bfwd->current_alist_element = Qnil;
2044 bfwd->current_buffer = Fcurrent_buffer ();
2045 XSETSYMBOL_VALUE_MAGIC (foo, bfwd);
2046 *value_slot_past_magic (variable) = foo;
2047 #if 1 /* #### Yuck! FSFmacs bug-compatibility*/
2048 /* This sets the default-value of any make-variable-buffer-local to nil.
2049 That just sucks. User can just use setq-default to effect that,
2050 but there's no way to do makunbound-default to undo this lossage. */
2051 if (UNBOUNDP (valcontents))
2052 bfwd->default_value = Qnil;
2054 #if 0 /* #### Yuck! */
2055 /* This sets the value to nil in this buffer.
2056 User could use (setq variable nil) to do this.
2057 It isn't as egregious to do this automatically
2058 as it is to do so to the default-value, but it's
2059 still really dubious. */
2060 if (UNBOUNDP (valcontents))
2061 Fset (variable, Qnil);
2067 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1,
2068 "vMake Local Variable: ", /*
2069 Make VARIABLE have a separate value in the current buffer.
2070 Other buffers will continue to share a common default value.
2071 \(The buffer-local value of VARIABLE starts out as the same value
2072 VARIABLE previously had. If VARIABLE was void, it remains void.)
2073 See also `make-variable-buffer-local'.
2075 If the variable is already arranged to become local when set,
2076 this function causes a local value to exist for this buffer,
2077 just as setting the variable would do.
2079 Do not use `make-local-variable' to make a hook variable buffer-local.
2080 Use `make-local-hook' instead.
2084 Lisp_Object valcontents;
2085 struct symbol_value_buffer_local *bfwd;
2087 CHECK_SYMBOL (variable);
2090 verify_ok_for_buffer_local (variable, Qmake_local_variable);
2092 valcontents = XSYMBOL (variable)->value;
2095 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2097 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2099 case SYMVAL_LISP_MAGIC:
2100 if (!UNBOUNDP (maybe_call_magic_handler
2101 (variable, Qmake_local_variable, 0)))
2103 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2107 case SYMVAL_VARALIAS:
2108 variable = follow_varalias_pointers (variable, Qmake_local_variable);
2109 /* presto change-o! */
2112 case SYMVAL_FIXNUM_FORWARD:
2113 case SYMVAL_BOOLEAN_FORWARD:
2114 case SYMVAL_OBJECT_FORWARD:
2115 case SYMVAL_UNBOUND_MARKER:
2118 case SYMVAL_BUFFER_LOCAL:
2119 case SYMVAL_CURRENT_BUFFER_FORWARD:
2121 /* Make sure the symbol has a local value in this particular
2122 buffer, by setting it to the same value it already has. */
2123 Fset (variable, find_symbol_value (variable));
2127 case SYMVAL_SOME_BUFFER_LOCAL:
2129 if (!NILP (buffer_local_alist_element (current_buffer,
2131 (XSYMBOL_VALUE_BUFFER_LOCAL
2133 goto already_local_to_current_buffer;
2135 goto already_local_to_some_other_buffer;
2143 /* Make sure variable is set up to hold per-buffer values */
2144 bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
2145 &lrecord_symbol_value_buffer_local);
2146 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2148 bfwd->current_buffer = Qnil;
2149 bfwd->current_alist_element = Qnil;
2150 bfwd->current_value = valcontents;
2151 /* passing 0 is OK because this should never be a
2152 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2154 bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
2157 if (UNBOUNDP (bfwd->default_value))
2158 bfwd->default_value = Qnil; /* Yuck! */
2161 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
2162 *value_slot_past_magic (variable) = valcontents;
2164 already_local_to_some_other_buffer:
2166 /* Make sure this buffer has its own value of variable */
2167 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2169 if (UNBOUNDP (bfwd->default_value))
2171 /* If default value is unbound, set local value to nil. */
2172 XSETBUFFER (bfwd->current_buffer, current_buffer);
2173 bfwd->current_alist_element = Fcons (variable, Qnil);
2174 current_buffer->local_var_alist =
2175 Fcons (bfwd->current_alist_element, current_buffer->local_var_alist);
2176 store_symval_forwarding (variable, bfwd->current_value, Qnil);
2180 current_buffer->local_var_alist
2181 = Fcons (Fcons (variable, bfwd->default_value),
2182 current_buffer->local_var_alist);
2184 /* Make sure symbol does not think it is set up for this buffer;
2185 force it to look once again for this buffer's value */
2186 if (!NILP (bfwd->current_buffer) &&
2187 current_buffer == XBUFFER (bfwd->current_buffer))
2188 bfwd->current_buffer = Qnil;
2190 already_local_to_current_buffer:
2192 /* If the symbol forwards into a C variable, then swap in the
2193 variable for this buffer immediately. If C code modifies the
2194 variable before we swap in, then that new value will clobber the
2195 default value the next time we swap. */
2196 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2197 if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value))
2199 switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
2201 case SYMVAL_FIXNUM_FORWARD:
2202 case SYMVAL_BOOLEAN_FORWARD:
2203 case SYMVAL_OBJECT_FORWARD:
2204 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2205 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2208 case SYMVAL_UNBOUND_MARKER:
2209 case SYMVAL_CURRENT_BUFFER_FORWARD:
2220 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1,
2221 "vKill Local Variable: ", /*
2222 Make VARIABLE no longer have a separate value in the current buffer.
2223 From now on the default value will apply in this buffer.
2227 Lisp_Object valcontents;
2229 CHECK_SYMBOL (variable);
2232 valcontents = XSYMBOL (variable)->value;
2235 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2238 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2240 case SYMVAL_LISP_MAGIC:
2241 if (!UNBOUNDP (maybe_call_magic_handler
2242 (variable, Qkill_local_variable, 0)))
2244 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2248 case SYMVAL_VARALIAS:
2249 variable = follow_varalias_pointers (variable, Qkill_local_variable);
2250 /* presto change-o! */
2253 case SYMVAL_CURRENT_BUFFER_FORWARD:
2255 CONST struct symbol_value_forward *fwd
2256 = XSYMBOL_VALUE_FORWARD (valcontents);
2257 int offset = ((char *) symbol_value_forward_forward (fwd)
2258 - (char *) &buffer_local_flags);
2260 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2264 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2265 Lisp_Object in_object, int flags) =
2266 symbol_value_forward_magicfun (fwd);
2267 Lisp_Object oldval = * (Lisp_Object *)
2268 (offset + (char *) XBUFFER (Vbuffer_defaults));
2270 (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
2271 *(Lisp_Object *) (offset + (char *) current_buffer)
2273 current_buffer->local_var_flags &= ~mask;
2278 case SYMVAL_BUFFER_LOCAL:
2279 case SYMVAL_SOME_BUFFER_LOCAL:
2281 /* Get rid of this buffer's alist element, if any */
2282 struct symbol_value_buffer_local *bfwd
2283 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2284 Lisp_Object alist = current_buffer->local_var_alist;
2285 Lisp_Object alist_element
2286 = buffer_local_alist_element (current_buffer, variable, bfwd);
2288 if (!NILP (alist_element))
2289 current_buffer->local_var_alist = Fdelq (alist_element, alist);
2291 /* Make sure symbol does not think it is set up for this buffer;
2292 force it to look once again for this buffer's value */
2293 if (!NILP (bfwd->current_buffer) &&
2294 current_buffer == XBUFFER (bfwd->current_buffer))
2295 bfwd->current_buffer = Qnil;
2297 /* We just changed the value in the current_buffer. If this
2298 variable forwards to a C variable, we need to change the
2299 value of the C variable. set_up_buffer_local_cache()
2300 will do this. It doesn't hurt to do it always,
2301 so just go ahead and do that. */
2302 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2309 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2313 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2314 "vKill Console Local Variable: ", /*
2315 Make VARIABLE no longer have a separate value in the selected console.
2316 From now on the default value will apply in this console.
2320 Lisp_Object valcontents;
2322 CHECK_SYMBOL (variable);
2325 valcontents = XSYMBOL (variable)->value;
2328 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2331 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2333 case SYMVAL_LISP_MAGIC:
2334 if (!UNBOUNDP (maybe_call_magic_handler
2335 (variable, Qkill_console_local_variable, 0)))
2337 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2341 case SYMVAL_VARALIAS:
2342 variable = follow_varalias_pointers (variable,
2343 Qkill_console_local_variable);
2344 /* presto change-o! */
2347 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2349 CONST struct symbol_value_forward *fwd
2350 = XSYMBOL_VALUE_FORWARD (valcontents);
2351 int offset = ((char *) symbol_value_forward_forward (fwd)
2352 - (char *) &console_local_flags);
2354 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2358 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2359 Lisp_Object in_object, int flags) =
2360 symbol_value_forward_magicfun (fwd);
2361 Lisp_Object oldval = * (Lisp_Object *)
2362 (offset + (char *) XCONSOLE (Vconsole_defaults));
2364 magicfun (variable, &oldval, Vselected_console, 0);
2365 *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
2367 XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
2377 /* Used by specbind to determine what effects it might have. Returns:
2378 * 0 if symbol isn't buffer-local, and wouldn't be after it is set
2379 * <0 if symbol isn't presently buffer-local, but set would make it so
2380 * >0 if symbol is presently buffer-local
2383 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
2385 Lisp_Object valcontents;
2388 valcontents = XSYMBOL (symbol)->value;
2391 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2393 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2395 case SYMVAL_LISP_MAGIC:
2397 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2401 case SYMVAL_VARALIAS:
2402 symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
2403 /* presto change-o! */
2406 case SYMVAL_CURRENT_BUFFER_FORWARD:
2408 CONST struct symbol_value_forward *fwd
2409 = XSYMBOL_VALUE_FORWARD (valcontents);
2410 int mask = XINT (*((Lisp_Object *)
2411 symbol_value_forward_forward (fwd)));
2412 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
2413 /* Already buffer-local */
2416 /* Would be buffer-local after set */
2419 case SYMVAL_BUFFER_LOCAL:
2420 case SYMVAL_SOME_BUFFER_LOCAL:
2422 struct symbol_value_buffer_local *bfwd
2423 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2425 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
2428 /* Automatically becomes local when set */
2429 return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
2439 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2440 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2442 (symbol, buffer, unbound_value))
2445 CHECK_SYMBOL (symbol);
2446 CHECK_BUFFER (buffer);
2447 value = symbol_value_in_buffer (symbol, buffer);
2448 return UNBOUNDP (value) ? unbound_value : value;
2451 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2452 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2454 (symbol, console, unbound_value))
2457 CHECK_SYMBOL (symbol);
2458 CHECK_CONSOLE (console);
2459 value = symbol_value_in_console (symbol, console);
2460 return UNBOUNDP (value) ? unbound_value : value;
2463 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
2464 If SYMBOL is a built-in variable, return info about this; else return nil.
2465 The returned info will be a symbol, one of
2467 `object' A simple built-in variable.
2468 `const-object' Same, but cannot be set.
2469 `integer' A built-in integer variable.
2470 `const-integer' Same, but cannot be set.
2471 `boolean' A built-in boolean variable.
2472 `const-boolean' Same, but cannot be set.
2473 `const-specifier' Always contains a specifier; e.g. `has-modeline-p'.
2474 `current-buffer' A built-in buffer-local variable.
2475 `const-current-buffer' Same, but cannot be set.
2476 `default-buffer' Forwards to the default value of a built-in
2477 buffer-local variable.
2478 `selected-console' A built-in console-local variable.
2479 `const-selected-console' Same, but cannot be set.
2480 `default-console' Forwards to the default value of a built-in
2481 console-local variable.
2485 REGISTER Lisp_Object valcontents;
2487 CHECK_SYMBOL (symbol);
2490 valcontents = XSYMBOL (symbol)->value;
2493 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2496 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2498 case SYMVAL_LISP_MAGIC:
2499 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2503 case SYMVAL_VARALIAS:
2504 symbol = follow_varalias_pointers (symbol, Qt);
2505 /* presto change-o! */
2508 case SYMVAL_BUFFER_LOCAL:
2509 case SYMVAL_SOME_BUFFER_LOCAL:
2511 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value;
2515 case SYMVAL_FIXNUM_FORWARD: return Qinteger;
2516 case SYMVAL_CONST_FIXNUM_FORWARD: return Qconst_integer;
2517 case SYMVAL_BOOLEAN_FORWARD: return Qboolean;
2518 case SYMVAL_CONST_BOOLEAN_FORWARD: return Qconst_boolean;
2519 case SYMVAL_OBJECT_FORWARD: return Qobject;
2520 case SYMVAL_CONST_OBJECT_FORWARD: return Qconst_object;
2521 case SYMVAL_CONST_SPECIFIER_FORWARD: return Qconst_specifier;
2522 case SYMVAL_DEFAULT_BUFFER_FORWARD: return Qdefault_buffer;
2523 case SYMVAL_CURRENT_BUFFER_FORWARD: return Qcurrent_buffer;
2524 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: return Qconst_current_buffer;
2525 case SYMVAL_DEFAULT_CONSOLE_FORWARD: return Qdefault_console;
2526 case SYMVAL_SELECTED_CONSOLE_FORWARD: return Qselected_console;
2527 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: return Qconst_selected_console;
2528 case SYMVAL_UNBOUND_MARKER: return Qnil;
2531 abort (); return Qnil;
2536 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
2537 Return t if SYMBOL's value is local to BUFFER.
2538 If optional third arg AFTER-SET is true, return t if SYMBOL would be
2539 buffer-local after it is set, regardless of whether it is so presently.
2540 A nil value for BUFFER is *not* the same as (current-buffer), but means
2541 "no buffer". Specifically:
2543 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
2544 the variable is one of the special built-in variables that is always
2545 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
2546 `buffer-undo-list', and others.)
2548 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
2549 the variable has had `make-variable-buffer-local' applied to it.
2551 (symbol, buffer, after_set))
2555 CHECK_SYMBOL (symbol);
2558 buffer = get_buffer (buffer, 1);
2559 local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
2563 local_info = symbol_value_buffer_local_info (symbol, 0);
2566 if (NILP (after_set))
2567 return local_info > 0 ? Qt : Qnil;
2569 return local_info != 0 ? Qt : Qnil;
2574 I've gone ahead and partially implemented this because it's
2575 super-useful for dealing with the compatibility problems in supporting
2576 the old pointer-shape variables, and preventing people from `setq'ing
2577 the new variables. Any other way of handling this problem is way
2578 ugly, likely to be slow, and generally not something I want to waste
2579 my time worrying about.
2581 The interface and/or function name is sure to change before this
2582 gets into its final form. I currently like the way everything is
2583 set up and it has all the features I want it to have, except for
2584 one: I really want to be able to have multiple nested handlers,
2585 to implement an `advice'-like capability. This would allow,
2586 for example, a clean way of implementing `debug-if-set' or
2587 `debug-if-referenced' and such.
2589 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
2590 ************************************************************
2591 **Only** the `set-value', `make-unbound', and `make-local'
2592 handler types are currently implemented. Implementing the
2593 get-value and bound-predicate handlers is somewhat tricky
2594 because there are lots of subfunctions (e.g. find_symbol_value()).
2595 find_symbol_value(), in fact, is called from outside of
2596 this module. You'd have to have it do this:
2598 -- check for a `bound-predicate' handler, call that if so;
2599 if it returns nil, return Qunbound
2600 -- check for a `get-value' handler and call it and return
2603 It gets even trickier when you have to deal with
2604 sub-subfunctions like find_symbol_value_1(), and esp.
2605 when you have to properly handle variable aliases, which
2606 can lead to lots of tricky situations. So I've just
2607 punted on this, since the interface isn't officially
2608 exported and we can get by with just a `set-value'
2611 Actions in unimplemented handler types will correctly
2612 ignore any handlers, and will not fuck anything up or
2615 WARNING WARNING: If you do go and implement another
2616 type of handler, make *sure* to change
2617 would_be_magic_handled() so it knows about this,
2618 or dire things could result.
2619 ************************************************************
2620 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
2622 Real documentation is as follows.
2624 Set a magic handler for VARIABLE.
2625 This allows you to specify arbitrary behavior that results from
2626 accessing or setting a variable. For example, retrieving the
2627 variable's value might actually retrieve the first element off of
2628 a list stored in another variable, and setting the variable's value
2629 might add an element to the front of that list. (This is how the
2630 obsolete variable `unread-command-event' is implemented.)
2632 In general it is NOT good programming practice to use magic variables
2633 in a new package that you are designing. If you feel the need to
2634 do this, it's almost certainly a sign that you should be using a
2635 function instead of a variable. This facility is provided to allow
2636 a package to support obsolete variables and provide compatibility
2637 with similar packages with different variable names and semantics.
2638 By using magic handlers, you can cleanly provide obsoleteness and
2639 compatibility support and separate this support from the core
2640 routines in a package.
2642 VARIABLE should be a symbol naming the variable for which the
2643 magic behavior is provided. HANDLER-TYPE is a symbol specifying
2644 which behavior is being controlled, and HANDLER is the function
2645 that will be called to control this behavior. HARG is a
2646 value that will be passed to HANDLER but is otherwise
2647 uninterpreted. KEEP-EXISTING specifies what to do with existing
2648 handlers of the same type; nil means "erase them all", t means
2649 "keep them but insert at the beginning", the list (t) means
2650 "keep them but insert at the end", a function means "keep
2651 them but insert before the specified function", a list containing
2652 a function means "keep them but insert after the specified
2655 You can specify magic behavior for any type of variable at all,
2656 and for any handler types that are unspecified, the standard
2657 behavior applies. This allows you, for example, to use
2658 `defvaralias' in conjunction with this function. (For that
2659 matter, `defvaralias' could be implemented using this function.)
2661 The behaviors that can be specified in HANDLER-TYPE are
2663 get-value (SYM ARGS FUN HARG HANDLERS)
2664 This means that one of the functions `symbol-value',
2665 `default-value', `symbol-value-in-buffer', or
2666 `symbol-value-in-console' was called on SYM.
2668 set-value (SYM ARGS FUN HARG HANDLERS)
2669 This means that one of the functions `set' or `set-default'
2672 bound-predicate (SYM ARGS FUN HARG HANDLERS)
2673 This means that one of the functions `boundp', `globally-boundp',
2674 or `default-boundp' was called on SYM.
2676 make-unbound (SYM ARGS FUN HARG HANDLERS)
2677 This means that the function `makunbound' was called on SYM.
2679 local-predicate (SYM ARGS FUN HARG HANDLERS)
2680 This means that the function `local-variable-p' was called
2683 make-local (SYM ARGS FUN HARG HANDLERS)
2684 This means that one of the functions `make-local-variable',
2685 `make-variable-buffer-local', `kill-local-variable',
2686 or `kill-console-local-variable' was called on SYM.
2688 The meanings of the arguments are as follows:
2690 SYM is the symbol on which the function was called, and is always
2691 the first argument to the function.
2693 ARGS are the remaining arguments in the original call (i.e. all
2694 but the first). In the case of `set-value' in particular,
2695 the first element of ARGS is the value to which the variable
2696 is being set. In some cases, ARGS is sanitized from what was
2697 actually given. For example, whenever `nil' is passed to an
2698 argument and it means `current-buffer', the current buffer is
2699 substituted instead.
2701 FUN is a symbol indicating which function is being called.
2702 For many of the functions, you can determine the corresponding
2703 function of a different class using
2704 `symbol-function-corresponding-function'.
2706 HARG is the argument that was given in the call
2707 to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
2709 HANDLERS is a structure containing the remaining handlers
2710 for the variable; to call one of them, use
2711 `chain-to-symbol-value-handler'.
2713 NOTE: You may *not* modify the list in ARGS, and if you want to
2714 keep it around after the handler function exits, you must make
2715 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
2718 static enum lisp_magic_handler
2719 decode_magic_handler_type (Lisp_Object symbol)
2721 if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE;
2722 if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE;
2723 if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE;
2724 if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND;
2725 if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE;
2726 if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL;
2728 signal_simple_error ("Unrecognized symbol value handler type", symbol);
2730 return MAGIC_HANDLER_MAX;
2733 static enum lisp_magic_handler
2734 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
2736 if (EQ (funsym, Qsymbol_value)
2737 || EQ (funsym, Qdefault_value)
2738 || EQ (funsym, Qsymbol_value_in_buffer)
2739 || EQ (funsym, Qsymbol_value_in_console))
2740 return MAGIC_HANDLER_GET_VALUE;
2742 if (EQ (funsym, Qset)
2743 || EQ (funsym, Qset_default))
2744 return MAGIC_HANDLER_SET_VALUE;
2746 if (EQ (funsym, Qboundp)
2747 || EQ (funsym, Qglobally_boundp)
2748 || EQ (funsym, Qdefault_boundp))
2749 return MAGIC_HANDLER_BOUND_PREDICATE;
2751 if (EQ (funsym, Qmakunbound))
2752 return MAGIC_HANDLER_MAKE_UNBOUND;
2754 if (EQ (funsym, Qlocal_variable_p))
2755 return MAGIC_HANDLER_LOCAL_PREDICATE;
2757 if (EQ (funsym, Qmake_variable_buffer_local)
2758 || EQ (funsym, Qmake_local_variable))
2759 return MAGIC_HANDLER_MAKE_LOCAL;
2761 if (abort_if_not_found)
2763 signal_simple_error ("Unrecognized symbol-value function", funsym);
2764 return MAGIC_HANDLER_MAX;
2768 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
2770 /* does not take into account variable aliasing. */
2771 Lisp_Object valcontents = XSYMBOL (sym)->value;
2772 enum lisp_magic_handler slot;
2774 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2776 slot = handler_type_from_function_symbol (funsym, 1);
2777 if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND
2778 && slot != MAGIC_HANDLER_MAKE_LOCAL)
2779 /* #### temporary kludge because we haven't implemented
2780 lisp-magic variables completely */
2782 return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
2786 fetch_value_maybe_past_magic (Lisp_Object sym,
2787 Lisp_Object follow_past_lisp_magic)
2789 Lisp_Object value = XSYMBOL (sym)->value;
2790 if (SYMBOL_VALUE_LISP_MAGIC_P (value)
2791 && (EQ (follow_past_lisp_magic, Qt)
2792 || (!NILP (follow_past_lisp_magic)
2793 && !would_be_magic_handled (sym, follow_past_lisp_magic))))
2794 value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed;
2798 static Lisp_Object *
2799 value_slot_past_magic (Lisp_Object sym)
2801 Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
2803 if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
2804 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
2805 return store_pointer;
2809 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
2812 Lisp_Object args[20]; /* should be enough ... */
2814 enum lisp_magic_handler htype;
2815 Lisp_Object legerdemain;
2816 struct symbol_value_lisp_magic *bfwd;
2818 assert (nargs >= 0 && nargs < 20);
2819 legerdemain = XSYMBOL (sym)->value;
2820 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2821 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2823 va_start (vargs, nargs);
2824 for (i = 0; i < nargs; i++)
2825 args[i] = va_arg (vargs, Lisp_Object);
2828 htype = handler_type_from_function_symbol (funsym, 1);
2829 if (NILP (bfwd->handler[htype]))
2831 /* #### should be reusing the arglist, not always consing anew.
2832 Repeated handler invocations should not cause repeated consing.
2833 Doesn't matter for now, because this is just a quick implementation
2834 for obsolescence support. */
2835 return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym,
2836 bfwd->harg[htype], Qnil);
2839 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
2841 Don't you dare use this.
2842 If you do, suffer the wrath of Ben, who is likely to rename
2843 this function (or change the semantics of its arguments) without
2844 pity, thereby invalidating your code.
2846 (variable, handler_type, handler, harg, keep_existing))
2848 Lisp_Object valcontents;
2849 struct symbol_value_lisp_magic *bfwd;
2850 enum lisp_magic_handler htype;
2853 /* #### WARNING, only some handler types are implemented. See above.
2854 Actions of other types will ignore a handler if it's there.
2856 #### Also, `chain-to-symbol-value-handler' and
2857 `symbol-function-corresponding-function' are not implemented. */
2858 CHECK_SYMBOL (variable);
2859 CHECK_SYMBOL (handler_type);
2860 htype = decode_magic_handler_type (handler_type);
2861 valcontents = XSYMBOL (variable)->value;
2862 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2864 bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
2865 &lrecord_symbol_value_lisp_magic);
2866 bfwd->magic.type = SYMVAL_LISP_MAGIC;
2867 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2869 bfwd->handler[i] = Qnil;
2870 bfwd->harg[i] = Qnil;
2872 bfwd->shadowed = valcontents;
2873 XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
2876 bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
2877 bfwd->handler[htype] = handler;
2878 bfwd->harg[htype] = harg;
2880 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2881 if (!NILP (bfwd->handler[i]))
2884 if (i == MAGIC_HANDLER_MAX)
2885 /* there are no remaining handlers, so remove the structure. */
2886 XSYMBOL (variable)->value = bfwd->shadowed;
2892 /* functions for working with variable aliases. */
2894 /* Follow the chain of variable aliases for SYMBOL. Return the
2895 resulting symbol, whose value cell is guaranteed not to be a
2896 symbol-value-varalias.
2898 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
2899 If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
2900 never follow; stop right there. Otherwise FUNSYM should be a
2901 recognized symbol-value function symbol; this means, follow
2902 unless there is a special handler for the named function.
2904 OK, there is at least one reason why it's necessary for
2905 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
2906 can always be sure to catch cyclic variable aliasing. If we never
2907 follow past Lisp magic, then if the following is done:
2910 add some magic behavior to a, but not a "get-value" handler
2913 then an attempt to retrieve a's or b's value would cause infinite
2914 looping in `symbol-value'.
2916 We (of course) can't always follow past Lisp magic, because then
2917 we make any variable that is lisp-magic -> varalias behave as if
2918 the lisp-magic is not present at all.
2922 follow_varalias_pointers (Lisp_Object symbol,
2923 Lisp_Object follow_past_lisp_magic)
2925 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
2926 Lisp_Object tortoise, hare, val;
2929 /* quick out just in case */
2930 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value))
2933 /* Compare implementation of indirect_function(). */
2934 for (hare = tortoise = symbol, count = 0;
2935 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic),
2936 SYMBOL_VALUE_VARALIAS_P (val);
2937 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)),
2940 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue;
2943 tortoise = symbol_value_varalias_aliasee
2944 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic
2945 (tortoise, follow_past_lisp_magic)));
2946 if (EQ (hare, tortoise))
2947 return Fsignal (Qcyclic_variable_indirection, list1 (symbol));
2953 DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
2954 Define a variable as an alias for another variable.
2955 Thenceforth, any operations performed on VARIABLE will actually be
2956 performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
2957 If ALIAS is nil, remove any aliases for VARIABLE.
2958 ALIAS can itself be aliased, and the chain of variable aliases
2959 will be followed appropriately.
2960 If VARIABLE already has a value, this value will be shadowed
2961 until the alias is removed, at which point it will be restored.
2962 Currently VARIABLE cannot be a built-in variable, a variable that
2963 has a buffer-local value in any buffer, or the symbols nil or t.
2964 \(ALIAS, however, can be any type of variable.)
2968 struct symbol_value_varalias *bfwd;
2969 Lisp_Object valcontents;
2971 CHECK_SYMBOL (variable);
2972 reject_constant_symbols (variable, Qunbound, 0, Qt);
2974 valcontents = XSYMBOL (variable)->value;
2978 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
2980 XSYMBOL (variable)->value =
2981 symbol_value_varalias_shadowed
2982 (XSYMBOL_VALUE_VARALIAS (valcontents));
2987 CHECK_SYMBOL (alias);
2988 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
2991 XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
2995 if (SYMBOL_VALUE_MAGIC_P (valcontents)
2996 && !UNBOUNDP (valcontents))
2997 signal_simple_error ("Variable is magic and cannot be aliased", variable);
2998 reject_constant_symbols (variable, Qunbound, 0, Qt);
3000 bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
3001 &lrecord_symbol_value_varalias);
3002 bfwd->magic.type = SYMVAL_VARALIAS;
3003 bfwd->aliasee = alias;
3004 bfwd->shadowed = valcontents;
3006 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
3007 XSYMBOL (variable)->value = valcontents;
3011 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
3012 If VARIABLE is aliased to another variable, return that variable.
3013 VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
3014 Variable aliases are created with `defvaralias'. See also
3015 `indirect-variable'.
3017 (variable, follow_past_lisp_magic))
3019 Lisp_Object valcontents;
3021 CHECK_SYMBOL (variable);
3022 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3024 CHECK_SYMBOL (follow_past_lisp_magic);
3025 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3028 valcontents = fetch_value_maybe_past_magic (variable,
3029 follow_past_lisp_magic);
3031 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3032 return symbol_value_varalias_aliasee
3033 (XSYMBOL_VALUE_VARALIAS (valcontents));
3038 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /*
3039 Return the variable at the end of OBJECT's variable-alias chain.
3040 If OBJECT is a symbol, follow all variable aliases and return
3041 the final (non-aliased) symbol. Variable aliases are created with
3042 the function `defvaralias'.
3043 If OBJECT is not a symbol, just return it.
3044 Signal a cyclic-variable-indirection error if there is a loop in the
3045 variable chain of symbols.
3047 (object, follow_past_lisp_magic))
3049 if (!SYMBOLP (object))
3051 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3053 CHECK_SYMBOL (follow_past_lisp_magic);
3054 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3056 return follow_varalias_pointers (object, follow_past_lisp_magic);
3060 /************************************************************************/
3061 /* initialization */
3062 /************************************************************************/
3064 /* A dumped XEmacs image has a lot more than 1511 symbols. Last
3065 estimate was that there were actually around 6300. So let's try
3066 making this bigger and see if we get better hashing behavior. */
3067 #define OBARRAY_SIZE 16411
3072 #ifndef Qnull_pointer
3073 Lisp_Object Qnull_pointer;
3076 /* some losing systems can't have static vars at function scope... */
3077 static struct symbol_value_magic guts_of_unbound_marker =
3078 { { symbol_value_forward_lheader_initializer, 0, 69},
3079 SYMVAL_UNBOUND_MARKER };
3082 init_symbols_once_early (void)
3085 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3088 #ifndef Qnull_pointer
3089 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3090 so the following is actually a no-op. */
3091 XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
3094 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3095 called the first time. */
3096 Qnil = Fmake_symbol (make_string_nocopy ((CONST Bufbyte *) "nil", 3));
3097 XSYMBOL (Qnil)->name->plist = Qnil;
3098 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
3099 XSYMBOL (Qnil)->plist = Qnil;
3101 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3102 initial_obarray = Vobarray;
3103 staticpro (&initial_obarray);
3104 /* Intern nil in the obarray */
3106 int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
3107 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3111 /* Required to get around a GCC syntax error on certain
3113 struct symbol_value_magic *tem = &guts_of_unbound_marker;
3115 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3117 if ((CONST void *) XPNTR (Qunbound) !=
3118 (CONST void *)&guts_of_unbound_marker)
3120 /* This might happen on DATA_SEG_BITS machines. */
3122 /* Can't represent a pointer to constant C data using a Lisp_Object.
3123 So heap-allocate it. */
3124 struct symbol_value_magic *urk = xnew (struct symbol_value_magic);
3125 memcpy (urk, &guts_of_unbound_marker, sizeof (*urk));
3126 XSETSYMBOL_VALUE_MAGIC (Qunbound, urk);
3129 XSYMBOL (Qnil)->function = Qunbound;
3131 defsymbol (&Qt, "t");
3132 XSYMBOL (Qt)->value = Qt; /* Veritas aetera */
3137 defsymbol (Lisp_Object *location, CONST char *name)
3139 *location = Fintern (make_string_nocopy ((CONST Bufbyte *) name,
3142 staticpro (location);
3146 defkeyword (Lisp_Object *location, CONST char *name)
3148 defsymbol (location, name);
3149 Fset (*location, *location);
3153 /* Check that nobody spazzed writing a DEFUN. */
3155 check_sane_subr (Lisp_Subr *subr, Lisp_Object sym)
3157 assert (subr->min_args >= 0);
3158 assert (subr->min_args <= SUBR_MAX_ARGS);
3160 if (subr->max_args != MANY &&
3161 subr->max_args != UNEVALLED)
3163 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3164 assert (subr->max_args <= SUBR_MAX_ARGS);
3165 assert (subr->min_args <= subr->max_args);
3168 assert (UNBOUNDP (XSYMBOL (sym)->function));
3171 #define check_sane_subr(subr, sym) /* nothing */
3176 * If we are not in a pure undumped Emacs, we need to make a duplicate of
3177 * the subr. This is because the only time this function will be called
3178 * in a running Emacs is when a dynamically loaded module is adding a
3179 * subr, and we need to make sure that the subr is in allocated, Lisp-
3180 * accessible memory. The address assigned to the static subr struct
3181 * in the shared object will be a trampoline address, so we need to create
3182 * a copy here to ensure that a real address is used.
3184 * Once we have copied everything across, we re-use the original static
3185 * structure to store a pointer to the newly allocated one. This will be
3186 * used in emodules.c by emodules_doc_subr() to find a pointer to the
3187 * allocated object so that we can set its doc string propperly.
3189 * NOTE: We dont actually use the DOC pointer here any more, but we did
3190 * in an earlier implementation of module support. There is no harm in
3191 * setting it here in case we ever need it in future implementations.
3192 * subr->doc will point to the new subr structure that was allocated.
3193 * Code can then get this value from the statis subr structure and use
3196 * FIXME: Should newsubr be staticpro()'ed? I dont think so but I need
3199 #define check_module_subr() \
3201 if (initialized) { \
3202 struct Lisp_Subr *newsubr; \
3203 newsubr = (Lisp_Subr *)xmalloc(sizeof(struct Lisp_Subr)); \
3204 memcpy (newsubr, subr, sizeof(struct Lisp_Subr)); \
3205 subr->doc = (CONST char *)newsubr; \
3209 #else /* ! HAVE_SHLIB */
3210 #define check_module_subr()
3214 defsubr (Lisp_Subr *subr)
3216 Lisp_Object sym = intern (subr_name (subr));
3219 check_sane_subr (subr, sym);
3220 check_module_subr ();
3222 XSETSUBR (fun, subr);
3223 XSYMBOL (sym)->function = fun;
3226 /* Define a lisp macro using a Lisp_Subr. */
3228 defsubr_macro (Lisp_Subr *subr)
3230 Lisp_Object sym = intern (subr_name (subr));
3233 check_sane_subr (subr, sym);
3234 check_module_subr();
3236 XSETSUBR (fun, subr);
3237 XSYMBOL (sym)->function = Fcons (Qmacro, fun);
3241 deferror (Lisp_Object *symbol, CONST char *name, CONST char *messuhhj,
3242 Lisp_Object inherits_from)
3245 defsymbol (symbol, name);
3247 assert (SYMBOLP (inherits_from));
3248 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3249 pure_put (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3250 /* NOT build_translated_string (). This function is called at load time
3251 and the string needs to get translated at run time. (This happens
3252 in the function (display-error) in cmdloop.el.) */
3253 pure_put (*symbol, Qerror_message, build_string (messuhhj));
3257 syms_of_symbols (void)
3259 defsymbol (&Qvariable_documentation, "variable-documentation");
3260 defsymbol (&Qvariable_domain, "variable-domain"); /* I18N3 */
3261 defsymbol (&Qad_advice_info, "ad-advice-info");
3262 defsymbol (&Qad_activate, "ad-activate");
3264 defsymbol (&Qget_value, "get-value");
3265 defsymbol (&Qset_value, "set-value");
3266 defsymbol (&Qbound_predicate, "bound-predicate");
3267 defsymbol (&Qmake_unbound, "make-unbound");
3268 defsymbol (&Qlocal_predicate, "local-predicate");
3269 defsymbol (&Qmake_local, "make-local");
3271 defsymbol (&Qboundp, "boundp");
3272 defsymbol (&Qfboundp, "fboundp");
3273 defsymbol (&Qglobally_boundp, "globally-boundp");
3274 defsymbol (&Qmakunbound, "makunbound");
3275 defsymbol (&Qsymbol_value, "symbol-value");
3276 defsymbol (&Qset, "set");
3277 defsymbol (&Qsetq_default, "setq-default");
3278 defsymbol (&Qdefault_boundp, "default-boundp");
3279 defsymbol (&Qdefault_value, "default-value");
3280 defsymbol (&Qset_default, "set-default");
3281 defsymbol (&Qmake_variable_buffer_local, "make-variable-buffer-local");
3282 defsymbol (&Qmake_local_variable, "make-local-variable");
3283 defsymbol (&Qkill_local_variable, "kill-local-variable");
3284 defsymbol (&Qkill_console_local_variable, "kill-console-local-variable");
3285 defsymbol (&Qsymbol_value_in_buffer, "symbol-value-in-buffer");
3286 defsymbol (&Qsymbol_value_in_console, "symbol-value-in-console");
3287 defsymbol (&Qlocal_variable_p, "local-variable-p");
3289 defsymbol (&Qconst_integer, "const-integer");
3290 defsymbol (&Qconst_boolean, "const-boolean");
3291 defsymbol (&Qconst_object, "const-object");
3292 defsymbol (&Qconst_specifier, "const-specifier");
3293 defsymbol (&Qdefault_buffer, "default-buffer");
3294 defsymbol (&Qcurrent_buffer, "current-buffer");
3295 defsymbol (&Qconst_current_buffer, "const-current-buffer");
3296 defsymbol (&Qdefault_console, "default-console");
3297 defsymbol (&Qselected_console, "selected-console");
3298 defsymbol (&Qconst_selected_console, "const-selected-console");
3301 DEFSUBR (Fintern_soft);
3302 DEFSUBR (Funintern);
3303 DEFSUBR (Fmapatoms);
3304 DEFSUBR (Fapropos_internal);
3306 DEFSUBR (Fsymbol_function);
3307 DEFSUBR (Fsymbol_plist);
3308 DEFSUBR (Fsymbol_name);
3309 DEFSUBR (Fmakunbound);
3310 DEFSUBR (Ffmakunbound);
3312 DEFSUBR (Fglobally_boundp);
3315 DEFSUBR (Fdefine_function);
3316 Ffset (intern ("defalias"), intern ("define-function"));
3317 DEFSUBR (Fsetplist);
3318 DEFSUBR (Fsymbol_value_in_buffer);
3319 DEFSUBR (Fsymbol_value_in_console);
3320 DEFSUBR (Fbuilt_in_variable_type);
3321 DEFSUBR (Fsymbol_value);
3323 DEFSUBR (Fdefault_boundp);
3324 DEFSUBR (Fdefault_value);
3325 DEFSUBR (Fset_default);
3326 DEFSUBR (Fsetq_default);
3327 DEFSUBR (Fmake_variable_buffer_local);
3328 DEFSUBR (Fmake_local_variable);
3329 DEFSUBR (Fkill_local_variable);
3330 DEFSUBR (Fkill_console_local_variable);
3331 DEFSUBR (Flocal_variable_p);
3332 DEFSUBR (Fdefvaralias);
3333 DEFSUBR (Fvariable_alias);
3334 DEFSUBR (Findirect_variable);
3335 DEFSUBR (Fdontusethis_set_symbol_value_handler);
3338 /* Create and initialize a Lisp variable whose value is forwarded to C data */
3340 defvar_magic (CONST char *symbol_name, CONST struct symbol_value_forward *magic)
3342 Lisp_Object sym, kludge;
3344 /* Check that `magic' points somewhere we can represent as a Lisp pointer */
3345 XSETOBJ (kludge, Lisp_Type_Record, magic);
3346 if ((void *)magic != (void*) XPNTR (kludge))
3348 /* This might happen on DATA_SEG_BITS machines. */
3350 /* Copy it to somewhere which is representable. */
3351 struct symbol_value_forward *p = xnew (struct symbol_value_forward);
3352 memcpy (p, magic, sizeof *magic);
3356 #if defined(HAVE_SHLIB)
3358 * As with defsubr(), this will only be called in a dumped Emacs when
3359 * we are adding variables from a dynamically loaded module. That means
3360 * we can't use purespace. Take that into account.
3363 sym = Fintern (build_string (symbol_name), Qnil);
3366 sym = Fintern (make_string_nocopy ((CONST Bufbyte *) symbol_name,
3367 strlen (symbol_name)), Qnil);
3369 XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic);
3373 vars_of_symbols (void)
3375 DEFVAR_LISP ("obarray", &Vobarray /*
3376 Symbol table for use by `intern' and `read'.
3377 It is a vector whose length ought to be prime for best results.
3378 The vector's contents don't make sense if examined from Lisp programs;
3379 to find all the symbols in an obarray, use `mapatoms'.
3381 /* obarray has been initialized long before */