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 static const struct lrecord_description symbol_description[] = {
112 { XD_LISP_OBJECT, offsetof(struct Lisp_Symbol, next), 5 }
115 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
116 mark_symbol, print_symbol, 0, 0, 0,
117 symbol_description, struct Lisp_Symbol);
120 /**********************************************************************/
122 /**********************************************************************/
124 /* #### using a vector here is way bogus. Use a hash table instead. */
126 Lisp_Object Vobarray;
128 static Lisp_Object initial_obarray;
130 /* oblookup stores the bucket number here, for the sake of Funintern. */
132 static int oblookup_last_bucket_number;
135 check_obarray (Lisp_Object obarray)
137 while (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
139 /* If Vobarray is now invalid, force it to be valid. */
140 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
142 obarray = wrong_type_argument (Qvectorp, obarray);
148 intern (CONST char *str)
150 Bytecount len = strlen (str);
151 CONST Bufbyte *buf = (CONST Bufbyte *) str;
152 Lisp_Object obarray = Vobarray;
154 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
155 obarray = check_obarray (obarray);
158 Lisp_Object tem = oblookup (obarray, buf, len);
163 return Fintern (make_string (buf, len), obarray);
166 DEFUN ("intern", Fintern, 1, 2, 0, /*
167 Return the canonical symbol whose name is STRING.
168 If there is none, one is created by this function and returned.
169 A second optional argument specifies the obarray to use;
170 it defaults to the value of `obarray'.
174 Lisp_Object object, *ptr;
175 struct Lisp_Symbol *symbol;
178 if (NILP (obarray)) obarray = Vobarray;
179 obarray = check_obarray (obarray);
181 CHECK_STRING (string);
183 len = XSTRING_LENGTH (string);
184 object = oblookup (obarray, XSTRING_DATA (string), len);
189 ptr = &XVECTOR_DATA (obarray)[XINT (object)];
191 object = Fmake_symbol (string);
192 symbol = XSYMBOL (object);
195 symbol_next (symbol) = XSYMBOL (*ptr);
197 symbol_next (symbol) = 0;
200 if (string_byte (symbol_name (symbol), 0) == ':' && EQ (obarray, Vobarray))
202 /* The LISP way is to put keywords in their own package, but we
203 don't have packages, so we do something simpler. Someday,
204 maybe we'll have packages and then this will be reworked.
206 symbol_value (symbol) = object;
212 DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /*
213 Return the canonical symbol named NAME, or nil if none exists.
214 NAME may be a string or a symbol. If it is a symbol, that exact
215 symbol is searched for.
216 A second optional argument specifies the obarray to use;
217 it defaults to the value of `obarray'.
221 /* #### Bug! (intern-soft "nil") returns nil. Perhaps we should
222 add a DEFAULT-IF-NOT-FOUND arg, like in get. */
224 struct Lisp_String *string;
226 if (NILP (obarray)) obarray = Vobarray;
227 obarray = check_obarray (obarray);
232 string = XSTRING (name);
235 string = symbol_name (XSYMBOL (name));
237 tem = oblookup (obarray, string_data (string), string_length (string));
238 if (INTP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
244 DEFUN ("unintern", Funintern, 1, 2, 0, /*
245 Delete the symbol named NAME, if any, from OBARRAY.
246 The value is t if a symbol was found and deleted, nil otherwise.
247 NAME may be a string or a symbol. If it is a symbol, that symbol
248 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
249 OBARRAY defaults to the value of the variable `obarray'
254 struct Lisp_String *string;
257 if (NILP (obarray)) obarray = Vobarray;
258 obarray = check_obarray (obarray);
261 string = symbol_name (XSYMBOL (name));
265 string = XSTRING (name);
268 tem = oblookup (obarray, string_data (string), string_length (string));
271 /* If arg was a symbol, don't delete anything but that symbol itself. */
272 if (SYMBOLP (name) && !EQ (name, tem))
275 hash = oblookup_last_bucket_number;
277 if (EQ (XVECTOR_DATA (obarray)[hash], tem))
279 if (XSYMBOL (tem)->next)
280 XSETSYMBOL (XVECTOR_DATA (obarray)[hash], XSYMBOL (tem)->next);
282 XVECTOR_DATA (obarray)[hash] = Qzero;
286 Lisp_Object tail, following;
288 for (tail = XVECTOR_DATA (obarray)[hash];
289 XSYMBOL (tail)->next;
292 XSETSYMBOL (following, XSYMBOL (tail)->next);
293 if (EQ (following, tem))
295 XSYMBOL (tail)->next = XSYMBOL (following)->next;
303 /* Return the symbol in OBARRAY whose names matches the string
304 of SIZE characters at PTR. If there is no such symbol in OBARRAY,
305 return the index into OBARRAY that the string hashes to.
307 Also store the bucket number in oblookup_last_bucket_number. */
310 oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size)
313 struct Lisp_Symbol *tail;
316 if (!VECTORP (obarray) ||
317 (obsize = XVECTOR_LENGTH (obarray)) == 0)
319 obarray = check_obarray (obarray);
320 obsize = XVECTOR_LENGTH (obarray);
322 hash = hash_string (ptr, size) % obsize;
323 oblookup_last_bucket_number = hash;
324 bucket = XVECTOR_DATA (obarray)[hash];
327 else if (!SYMBOLP (bucket))
328 error ("Bad data in guts of obarray"); /* Like CADR error message */
330 for (tail = XSYMBOL (bucket); ;)
332 if (string_length (tail->name) == size &&
333 !memcmp (string_data (tail->name), ptr, size))
335 XSETSYMBOL (bucket, tail);
338 tail = symbol_next (tail);
342 return make_int (hash);
345 #if 0 /* Emacs 19.34 */
347 hash_string (CONST Bufbyte *ptr, Bytecount len)
349 CONST Bufbyte *p = ptr;
350 CONST Bufbyte *end = p + len;
357 if (c >= 0140) c -= 40;
358 hash = ((hash<<3) + (hash>>28) + c);
360 return hash & 07777777777;
364 /* derived from hashpjw, Dragon Book P436. */
366 hash_string (CONST Bufbyte *ptr, Bytecount len)
373 hash = (hash << 4) + *ptr++;
374 g = hash & 0xf0000000;
376 hash = (hash ^ (g >> 24)) ^ g;
378 return hash & 07777777777;
381 /* Map FN over OBARRAY. The mapping is stopped when FN returns a
384 map_obarray (Lisp_Object obarray,
385 int (*fn) (Lisp_Object, void *), void *arg)
389 CHECK_VECTOR (obarray);
390 for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--)
392 Lisp_Object tail = XVECTOR_DATA (obarray)[i];
396 struct Lisp_Symbol *next;
397 if ((*fn) (tail, arg))
399 next = symbol_next (XSYMBOL (tail));
402 XSETSYMBOL (tail, next);
408 mapatoms_1 (Lisp_Object sym, void *arg)
410 call1 (*(Lisp_Object *)arg, sym);
414 DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /*
415 Call FUNCTION on every symbol in OBARRAY.
416 OBARRAY defaults to the value of `obarray'.
422 obarray = check_obarray (obarray);
424 map_obarray (obarray, mapatoms_1, &function);
429 /**********************************************************************/
431 /**********************************************************************/
433 struct appropos_mapper_closure
436 Lisp_Object predicate;
437 Lisp_Object accumulation;
441 apropos_mapper (Lisp_Object symbol, void *arg)
443 struct appropos_mapper_closure *closure =
444 (struct appropos_mapper_closure *) arg;
445 Bytecount match = fast_lisp_string_match (closure->regexp,
446 Fsymbol_name (symbol));
449 (NILP (closure->predicate) ||
450 !NILP (call1 (closure->predicate, symbol))))
451 closure->accumulation = Fcons (symbol, closure->accumulation);
456 DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /*
457 Show all symbols whose names contain match for REGEXP.
458 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL)
459 is done for each symbol and a symbol is mentioned only if that
461 Return list of symbols found.
465 struct appropos_mapper_closure closure;
467 CHECK_STRING (regexp);
469 closure.regexp = regexp;
470 closure.predicate = predicate;
471 closure.accumulation = Qnil;
472 map_obarray (Vobarray, apropos_mapper, &closure);
473 closure.accumulation = Fsort (closure.accumulation, Qstring_lessp);
474 return closure.accumulation;
478 /* Extract and set components of symbols */
480 static void set_up_buffer_local_cache (Lisp_Object sym,
481 struct symbol_value_buffer_local *bfwd,
483 Lisp_Object new_alist_el,
486 DEFUN ("boundp", Fboundp, 1, 1, 0, /*
487 Return t if SYMBOL's value is not void.
491 CHECK_SYMBOL (symbol);
492 return UNBOUNDP (find_symbol_value (symbol)) ? Qnil : Qt;
495 DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /*
496 Return t if SYMBOL has a global (non-bound) value.
497 This is for the byte-compiler; you really shouldn't be using this.
501 CHECK_SYMBOL (symbol);
502 return UNBOUNDP (top_level_value (symbol)) ? Qnil : Qt;
505 DEFUN ("fboundp", Ffboundp, 1, 1, 0, /*
506 Return t if SYMBOL's function definition is not void.
510 CHECK_SYMBOL (symbol);
511 return UNBOUNDP (XSYMBOL (symbol)->function) ? Qnil : Qt;
514 /* Return non-zero if SYM's value or function (the current contents of
515 which should be passed in as VAL) is constant, i.e. unsettable. */
518 symbol_is_constant (Lisp_Object sym, Lisp_Object val)
520 /* #### - I wonder if it would be better to just have a new magic value
521 type and make nil, t, and all keywords have that same magic
522 constant_symbol value. This test is awfully specific about what is
523 constant and what isn't. --Stig */
524 if (EQ (sym, Qnil) ||
528 if (SYMBOL_VALUE_MAGIC_P (val))
529 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
531 case SYMVAL_CONST_OBJECT_FORWARD:
532 case SYMVAL_CONST_SPECIFIER_FORWARD:
533 case SYMVAL_CONST_FIXNUM_FORWARD:
534 case SYMVAL_CONST_BOOLEAN_FORWARD:
535 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
536 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
538 default: break; /* Warning suppression */
541 /* We don't return true for keywords here because they are handled
542 specially by reject_constant_symbols(). */
546 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
547 non-zero) to NEWVAL. Make sure this is allowed.
548 FOLLOW_PAST_LISP_MAGIC specifies whether we delve past
549 symbol-value-lisp-magic objects. */
552 reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p,
553 Lisp_Object follow_past_lisp_magic)
556 (function_p ? XSYMBOL (sym)->function
557 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
559 if (SYMBOL_VALUE_MAGIC_P (val) &&
560 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
561 signal_simple_error ("Use `set-specifier' to change a specifier's value",
564 if (symbol_is_constant (sym, val)
565 || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)))
566 signal_error (Qsetting_constant,
567 UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
570 /* Verify that it's ok to make SYM buffer-local. This rejects
571 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC
572 specifies whether we delve into symbol-value-lisp-magic objects.
573 (Should be a symbol indicating what action is being taken; that way,
574 we don't delve if there's a handler for that action, but do otherwise.) */
577 verify_ok_for_buffer_local (Lisp_Object sym,
578 Lisp_Object follow_past_lisp_magic)
580 Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic);
582 if (symbol_is_constant (sym, val))
584 if (SYMBOL_VALUE_MAGIC_P (val))
585 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
587 case SYMVAL_DEFAULT_BUFFER_FORWARD:
588 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
589 /* #### It's theoretically possible for it to be reasonable
590 to have both console-local and buffer-local variables,
591 but I don't want to consider that right now. */
592 case SYMVAL_SELECTED_CONSOLE_FORWARD:
594 default: break; /* Warning suppression */
600 signal_error (Qerror,
601 list2 (build_string ("Symbol may not be buffer-local"), sym));
604 DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /*
605 Make SYMBOL's value be void.
609 Fset (symbol, Qunbound);
613 DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /*
614 Make SYMBOL's function definition be void.
618 CHECK_SYMBOL (symbol);
619 reject_constant_symbols (symbol, Qunbound, 1, Qt);
620 XSYMBOL (symbol)->function = Qunbound;
624 DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /*
625 Return SYMBOL's function definition. Error if that is void.
629 CHECK_SYMBOL (symbol);
630 if (UNBOUNDP (XSYMBOL (symbol)->function))
631 signal_void_function_error (symbol);
632 return XSYMBOL (symbol)->function;
635 DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /*
636 Return SYMBOL's property list.
640 CHECK_SYMBOL (symbol);
641 return XSYMBOL (symbol)->plist;
644 DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /*
645 Return SYMBOL's name, a string.
651 CHECK_SYMBOL (symbol);
652 XSETSTRING (name, XSYMBOL (symbol)->name);
656 DEFUN ("fset", Ffset, 2, 2, 0, /*
657 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
661 /* This function can GC */
662 CHECK_SYMBOL (symbol);
663 reject_constant_symbols (symbol, newdef, 1, Qt);
664 if (!NILP (Vautoload_queue) && !UNBOUNDP (XSYMBOL (symbol)->function))
665 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
667 XSYMBOL (symbol)->function = newdef;
668 /* Handle automatic advice activation */
669 if (CONSP (XSYMBOL (symbol)->plist) &&
670 !NILP (Fget (symbol, Qad_advice_info, Qnil)))
672 call2 (Qad_activate, symbol, Qnil);
673 newdef = XSYMBOL (symbol)->function;
679 DEFUN ("define-function", Fdefine_function, 2, 2, 0, /*
680 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
681 Associates the function with the current load file, if any.
685 /* This function can GC */
686 Ffset (symbol, newdef);
687 LOADHIST_ATTACH (symbol);
692 DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
693 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
697 CHECK_SYMBOL (symbol);
698 #if 0 /* Inserted for debugging 6/28/1997 -slb */
699 /* Somebody is setting a property list of integer 0, who? */
700 /* Not this way apparently. */
701 if (EQ(newplist, Qzero)) abort();
704 XSYMBOL (symbol)->plist = newplist;
709 /**********************************************************************/
711 /**********************************************************************/
713 /* If the contents of the value cell of a symbol is one of the following
714 three types of objects, then the symbol is "magic" in that setting
715 and retrieving its value doesn't just set or retrieve the raw
716 contents of the value cell. None of these objects can escape to
717 the user level, so there is no loss of generality.
719 If a symbol is "unbound", then the contents of its value cell is
720 Qunbound. Despite appearances, this is *not* a symbol, but is a
721 symbol-value-forward object. This is so that printing it results
722 in "INTERNAL OBJECT (XEmacs bug?)", in case it leaks to Lisp, somehow.
724 Logically all of the following objects are "symbol-value-magic"
725 objects, and there are some games played w.r.t. this (#### this
726 should be cleaned up). SYMBOL_VALUE_MAGIC_P is true for all of
727 the object types. XSYMBOL_VALUE_MAGIC_TYPE returns the type of
728 symbol-value-magic object. There are more than three types
729 returned by this macro: in particular, symbol-value-forward
730 has eight subtypes, and symbol-value-buffer-local has two. See
733 1. symbol-value-forward
735 symbol-value-forward is used for variables whose actual contents
736 are stored in a C variable of some sort, and for Qunbound. The
737 lcheader.next field (which is only used to chain together free
738 lcrecords) holds a pointer to the actual C variable. Included
739 in this type are "buffer-local" variables that are actually
740 stored in the buffer object itself; in this case, the "pointer"
741 is an offset into the struct buffer structure.
743 The subtypes are as follows:
745 SYMVAL_OBJECT_FORWARD:
746 (declare with DEFVAR_LISP)
747 The value of this variable is stored in a C variable of type
748 "Lisp_Object". Setting this variable sets the C variable.
749 Accessing this variable retrieves a value from the C variable.
750 These variables can be buffer-local -- in this case, the
751 raw symbol-value field gets converted into a
752 symbol-value-buffer-local, whose "current_value" slot contains
753 the symbol-value-forward. (See below.)
755 SYMVAL_FIXNUM_FORWARD:
756 SYMVAL_BOOLEAN_FORWARD:
757 (declare with DEFVAR_INT or DEFVAR_BOOL)
758 Similar to SYMVAL_OBJECT_FORWARD except that the C variable
759 is of type "int" and is an integer or boolean, respectively.
761 SYMVAL_CONST_OBJECT_FORWARD:
762 SYMVAL_CONST_FIXNUM_FORWARD:
763 SYMVAL_CONST_BOOLEAN_FORWARD:
764 (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
766 Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
767 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
770 SYMVAL_CONST_SPECIFIER_FORWARD:
771 (declare with DEFVAR_SPECIFIER)
772 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that error message
773 you get when attempting to set the value says to use
774 `set-specifier' instead.
776 SYMVAL_CURRENT_BUFFER_FORWARD:
777 (declare with DEFVAR_BUFFER_LOCAL)
778 This is used for built-in buffer-local variables -- i.e.
779 Lisp variables whose value is stored in the "struct buffer".
780 Variables of this sort always forward into C "Lisp_Object"
781 fields (although there's no reason in principle that other
782 types for ints and booleans couldn't be added). Note that
783 some of these variables are automatically local in each
784 buffer, while some are only local when they become set
785 (similar to `make-variable-buffer-local'). In these latter
786 cases, of course, the default value shows through in all
787 buffers in which the variable doesn't have a local value.
788 This is implemented by making sure the "struct buffer" field
789 always contains the correct value (whether it's local or
790 a default) and maintaining a mask in the "struct buffer"
791 indicating which fields are local. When `set-default' is
792 called on a variable that's not always local to all buffers,
793 it loops through each buffer and sets the corresponding
794 field in each buffer without a local value for the field,
795 according to the mask.
797 Calling `make-local-variable' on a variable of this sort
798 only has the effect of maybe changing the current buffer's mask.
799 Calling `make-variable-buffer-local' on a variable of this
800 sort has no effect at all.
802 SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
803 (declare with DEFVAR_CONST_BUFFER_LOCAL)
804 Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
807 SYMVAL_DEFAULT_BUFFER_FORWARD:
808 (declare with DEFVAR_BUFFER_DEFAULTS)
809 This is used for the Lisp variables that contain the
810 default values of built-in buffer-local variables. Setting
811 or referencing one of these variables forwards into a slot
812 in the special struct buffer Vbuffer_defaults.
814 SYMVAL_UNBOUND_MARKER:
815 This is used for only one object, Qunbound.
817 SYMVAL_SELECTED_CONSOLE_FORWARD:
818 (declare with DEFVAR_CONSOLE_LOCAL)
819 This is used for built-in console-local variables -- i.e.
820 Lisp variables whose value is stored in the "struct console".
821 These work just like built-in buffer-local variables.
822 However, calling `make-local-variable' or
823 `make-variable-buffer-local' on one of these variables
824 is currently disallowed because that would entail having
825 both console-local and buffer-local variables, which is
826 trickier to implement.
828 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
829 (declare with DEFVAR_CONST_CONSOLE_LOCAL)
830 Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
833 SYMVAL_DEFAULT_CONSOLE_FORWARD:
834 (declare with DEFVAR_CONSOLE_DEFAULTS)
835 This is used for the Lisp variables that contain the
836 default values of built-in console-local variables. Setting
837 or referencing one of these variables forwards into a slot
838 in the special struct console Vconsole_defaults.
841 2. symbol-value-buffer-local
843 symbol-value-buffer-local is used for variables that have had
844 `make-local-variable' or `make-variable-buffer-local' applied
845 to them. This object contains an alist mapping buffers to
846 values. In addition, the object contains a "current value",
847 which is the value in some buffer. Whenever you access the
848 variable with `symbol-value' or set it with `set' or `setq',
849 things are switched around so that the "current value"
850 refers to the current buffer, if it wasn't already. This
851 way, repeated references to a variable in the same buffer
852 are almost as efficient as if the variable weren't buffer
853 local. Note that the alist may not be up-to-date w.r.t.
854 the buffer whose value is current, as the "current value"
855 cache is normally only flushed into the alist when the
856 buffer it refers to changes.
858 Note also that it is possible for `make-local-variable'
859 or `make-variable-buffer-local' to be called on a variable
860 that forwards into a C variable (i.e. a variable whose
861 value cell is a symbol-value-forward). In this case,
862 the value cell becomes a symbol-value-buffer-local (as
863 always), and the symbol-value-forward moves into
864 the "current value" cell in this object. Also, in
865 this case the "current value" *always* refers to the
866 current buffer, so that the values of the C variable
867 always is the correct value for the current buffer.
868 set_buffer_internal() automatically updates the current-value
869 cells of all buffer-local variables that forward into C
870 variables. (There is a list of all buffer-local variables
871 that is maintained for this and other purposes.)
873 Note that only certain types of `symbol-value-forward' objects
874 can find their way into the "current value" cell of a
875 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
876 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
877 SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot
878 be buffer-local because they are unsettable;
879 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
880 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
881 does not have much of an effect (it's already buffer-local); and
882 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
883 that's not currently implemented.
886 3. symbol-value-varalias
888 A symbol-value-varalias object is used for variables that
889 are aliases for other variables. This object contains
890 the symbol that this variable is aliased to.
891 symbol-value-varalias objects cannot occur anywhere within
892 a symbol-value-buffer-local object, and most of the
893 low-level functions below do not accept them; you need
894 to call follow_varalias_pointers to get the actual
895 symbol to operate on. */
898 mark_symbol_value_buffer_local (Lisp_Object obj,
899 void (*markobj) (Lisp_Object))
901 struct symbol_value_buffer_local *bfwd;
903 #ifdef ERROR_CHECK_TYPECHECK
904 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
905 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
908 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
909 markobj (bfwd->default_value);
910 markobj (bfwd->current_value);
911 markobj (bfwd->current_buffer);
912 return bfwd->current_alist_element;
916 mark_symbol_value_lisp_magic (Lisp_Object obj,
917 void (*markobj) (Lisp_Object))
919 struct symbol_value_lisp_magic *bfwd;
922 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
924 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
925 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
927 markobj (bfwd->handler[i]);
928 markobj (bfwd->harg[i]);
930 return bfwd->shadowed;
934 mark_symbol_value_varalias (Lisp_Object obj,
935 void (*markobj) (Lisp_Object))
937 struct symbol_value_varalias *bfwd;
939 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
941 bfwd = XSYMBOL_VALUE_VARALIAS (obj);
942 markobj (bfwd->shadowed);
943 return bfwd->aliasee;
946 /* Should never, ever be called. (except by an external debugger) */
948 print_symbol_value_magic (Lisp_Object obj,
949 Lisp_Object printcharfun, int escapeflag)
952 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s type %d) 0x%lx>",
953 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
954 XSYMBOL_VALUE_MAGIC_TYPE (obj),
956 write_c_string (buf, printcharfun);
959 static const struct lrecord_description symbol_value_buffer_local_description[] = {
960 { XD_LISP_OBJECT, offsetof(struct symbol_value_buffer_local, default_value), 4 },
964 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
965 { XD_LISP_OBJECT, offsetof(struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 },
969 static const struct lrecord_description symbol_value_varalias_description[] = {
970 { XD_LISP_OBJECT, offsetof(struct symbol_value_varalias, aliasee), 2 },
974 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
975 symbol_value_forward,
976 this_one_is_unmarkable,
977 print_symbol_value_magic, 0, 0, 0, 0,
978 struct symbol_value_forward);
980 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
981 symbol_value_buffer_local,
982 mark_symbol_value_buffer_local,
983 print_symbol_value_magic, 0, 0, 0,
984 symbol_value_buffer_local_description,
985 struct symbol_value_buffer_local);
987 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
988 symbol_value_lisp_magic,
989 mark_symbol_value_lisp_magic,
990 print_symbol_value_magic, 0, 0, 0,
991 symbol_value_lisp_magic_description,
992 struct symbol_value_lisp_magic);
994 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
995 symbol_value_varalias,
996 mark_symbol_value_varalias,
997 print_symbol_value_magic, 0, 0, 0,
998 symbol_value_varalias_description,
999 struct symbol_value_varalias);
1002 /* Getting and setting values of symbols */
1004 /* Given the raw contents of a symbol value cell, return the Lisp value of
1005 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
1006 symbol-value-lisp-magic, or symbol-value-varalias.
1008 BUFFER specifies a buffer, and is used for built-in buffer-local
1009 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
1010 Note that such variables are never encapsulated in a
1011 symbol-value-buffer-local structure.
1013 CONSOLE specifies a console, and is used for built-in console-local
1014 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
1015 Note that such variables are (currently) never encapsulated in a
1016 symbol-value-buffer-local structure.
1020 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
1021 struct console *console)
1023 CONST struct symbol_value_forward *fwd;
1025 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1028 fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1029 switch (fwd->magic.type)
1031 case SYMVAL_FIXNUM_FORWARD:
1032 case SYMVAL_CONST_FIXNUM_FORWARD:
1033 return make_int (*((int *)symbol_value_forward_forward (fwd)));
1035 case SYMVAL_BOOLEAN_FORWARD:
1036 case SYMVAL_CONST_BOOLEAN_FORWARD:
1037 return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
1039 case SYMVAL_OBJECT_FORWARD:
1040 case SYMVAL_CONST_OBJECT_FORWARD:
1041 case SYMVAL_CONST_SPECIFIER_FORWARD:
1042 return *((Lisp_Object *)symbol_value_forward_forward (fwd));
1044 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1045 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1046 + ((char *)symbol_value_forward_forward (fwd)
1047 - (char *)&buffer_local_flags))));
1050 case SYMVAL_CURRENT_BUFFER_FORWARD:
1051 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1053 return (*((Lisp_Object *)((char *)buffer
1054 + ((char *)symbol_value_forward_forward (fwd)
1055 - (char *)&buffer_local_flags))));
1057 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1058 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1059 + ((char *)symbol_value_forward_forward (fwd)
1060 - (char *)&console_local_flags))));
1062 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1063 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1065 return (*((Lisp_Object *)((char *)console
1066 + ((char *)symbol_value_forward_forward (fwd)
1067 - (char *)&console_local_flags))));
1069 case SYMVAL_UNBOUND_MARKER:
1075 return Qnil; /* suppress compiler warning */
1078 /* Set the value of default-buffer-local variable SYM to VALUE. */
1081 set_default_buffer_slot_variable (Lisp_Object sym,
1084 /* Handle variables like case-fold-search that have special slots in
1085 the buffer. Make them work apparently like buffer_local variables.
1087 /* At this point, the value cell may not contain a symbol-value-varalias
1088 or symbol-value-buffer-local, and if there's a handler, we should
1089 have already called it. */
1090 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1091 CONST struct symbol_value_forward *fwd
1092 = XSYMBOL_VALUE_FORWARD (valcontents);
1093 int offset = ((char *) symbol_value_forward_forward (fwd)
1094 - (char *) &buffer_local_flags);
1095 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1096 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1097 int flags) = symbol_value_forward_magicfun (fwd);
1099 *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
1102 if (mask > 0) /* Not always per-buffer */
1106 /* Set value in each buffer which hasn't shadowed the default */
1107 LIST_LOOP_2 (elt, Vbuffer_alist)
1109 struct buffer *b = XBUFFER (XCDR (elt));
1110 if (!(b->local_var_flags & mask))
1113 magicfun (sym, &value, make_buffer (b), 0);
1114 *((Lisp_Object *) (offset + (char *) b)) = value;
1120 /* Set the value of default-console-local variable SYM to VALUE. */
1123 set_default_console_slot_variable (Lisp_Object sym,
1126 /* Handle variables like case-fold-search that have special slots in
1127 the console. Make them work apparently like console_local variables.
1129 /* At this point, the value cell may not contain a symbol-value-varalias
1130 or symbol-value-buffer-local, and if there's a handler, we should
1131 have already called it. */
1132 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1133 CONST struct symbol_value_forward *fwd
1134 = XSYMBOL_VALUE_FORWARD (valcontents);
1135 int offset = ((char *) symbol_value_forward_forward (fwd)
1136 - (char *) &console_local_flags);
1137 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1138 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1139 int flags) = symbol_value_forward_magicfun (fwd);
1141 *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
1144 if (mask > 0) /* Not always per-console */
1146 Lisp_Object console;
1148 /* Set value in each console which hasn't shadowed the default */
1149 LIST_LOOP_2 (console, Vconsole_list)
1151 struct console *d = XCONSOLE (console);
1152 if (!(d->local_var_flags & mask))
1155 magicfun (sym, &value, console, 0);
1156 *((Lisp_Object *) (offset + (char *) d)) = value;
1162 /* Store NEWVAL into SYM.
1164 SYM's value slot may *not* be types (5) or (6) above,
1165 i.e. no symbol-value-varalias objects. (You should have
1166 forwarded past all of these.)
1168 SYM should not be an unsettable symbol or a symbol with
1169 a magic `set-value' handler (unless you want to explicitly
1170 ignore this handler).
1172 OVALUE is the current value of SYM, but forwarded past any
1173 symbol-value-buffer-local and symbol-value-lisp-magic objects.
1174 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1175 the contents of its current-value cell.) NEWVAL may only be
1176 a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
1177 this function will only modify its current-value cell, which should
1178 already be set up to point to the current buffer.
1182 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
1185 if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
1187 Lisp_Object *store_pointer = value_slot_past_magic (sym);
1189 if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
1191 &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
1193 assert (UNBOUNDP (*store_pointer)
1194 || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1195 *store_pointer = newval;
1199 CONST struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue);
1200 int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
1201 Lisp_Object in_object, int flags)
1202 = symbol_value_forward_magicfun (fwd);
1204 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue))
1206 case SYMVAL_FIXNUM_FORWARD:
1209 magicfun (sym, &newval, Qnil, 0);
1210 *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
1213 case SYMVAL_BOOLEAN_FORWARD:
1215 magicfun (sym, &newval, Qnil, 0);
1216 *((int *) symbol_value_forward_forward (fwd))
1217 = ((NILP (newval)) ? 0 : 1);
1220 case SYMVAL_OBJECT_FORWARD:
1222 magicfun (sym, &newval, Qnil, 0);
1223 *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
1226 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1227 set_default_buffer_slot_variable (sym, newval);
1230 case SYMVAL_CURRENT_BUFFER_FORWARD:
1232 magicfun (sym, &newval, make_buffer (current_buffer), 0);
1233 *((Lisp_Object *) ((char *) current_buffer
1234 + ((char *) symbol_value_forward_forward (fwd)
1235 - (char *) &buffer_local_flags)))
1239 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1240 set_default_console_slot_variable (sym, newval);
1243 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1245 magicfun (sym, &newval, Vselected_console, 0);
1246 *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console)
1247 + ((char *) symbol_value_forward_forward (fwd)
1248 - (char *) &console_local_flags)))
1258 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1259 BFWD, locate and return a pointer to the element in BUFFER's
1260 local_var_alist for SYMBOL. The return value will be Qnil if
1261 BUFFER does not have its own value for SYMBOL (i.e. the default
1262 value is seen in that buffer).
1266 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
1267 struct symbol_value_buffer_local *bfwd)
1269 if (!NILP (bfwd->current_buffer) &&
1270 XBUFFER (bfwd->current_buffer) == buffer)
1271 /* This is just an optimization of the below. */
1272 return bfwd->current_alist_element;
1274 return assq_no_quit (symbol, buffer->local_var_alist);
1277 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1278 symbol-value-buffer-local of a per-buffer variable -- i.e. the
1279 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1280 slot -- may be out of date.]
1282 Write out any cached value in buffer-local variable SYMBOL's
1283 buffer-local structure, which is passed in as BFWD.
1287 write_out_buffer_local_cache (Lisp_Object symbol,
1288 struct symbol_value_buffer_local *bfwd)
1290 if (!NILP (bfwd->current_buffer))
1292 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1293 uses it, and that type cannot be inside a symbol-value-buffer-local */
1294 Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0);
1295 if (NILP (bfwd->current_alist_element))
1296 /* current_value may be updated more recently than default_value */
1297 bfwd->default_value = cval;
1299 Fsetcdr (bfwd->current_alist_element, cval);
1303 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1304 Set up BFWD's cache for validity in buffer BUF. This assumes that
1305 the cache is currently in a consistent state (this can include
1306 not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1308 If the cache is already set up for BUF, this function does nothing
1311 Otherwise, if SYM forwards out to a C variable, this also forwards
1312 SYM's value in BUF out to the variable. Therefore, you generally
1313 only want to call this when BUF is, or is about to become, the
1316 (Otherwise, you can just retrieve the value without changing the
1317 cache, at the expense of slower retrieval.)
1321 set_up_buffer_local_cache (Lisp_Object sym,
1322 struct symbol_value_buffer_local *bfwd,
1324 Lisp_Object new_alist_el,
1327 Lisp_Object new_val;
1329 if (!NILP (bfwd->current_buffer)
1330 && buf == XBUFFER (bfwd->current_buffer))
1331 /* Cache is already set up. */
1334 /* Flush out the old cache. */
1335 write_out_buffer_local_cache (sym, bfwd);
1337 /* Retrieve the new alist element and new value. */
1338 if (NILP (new_alist_el)
1340 new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1342 if (NILP (new_alist_el))
1343 new_val = bfwd->default_value;
1345 new_val = Fcdr (new_alist_el);
1347 bfwd->current_alist_element = new_alist_el;
1348 XSETBUFFER (bfwd->current_buffer, buf);
1350 /* Now store the value into the current-value slot.
1351 We don't simply write it there, because the current-value
1352 slot might be a forwarding pointer, in which case we need
1353 to instead write the value into the C variable.
1355 We might also want to call a magic function.
1357 So instead, we call this function. */
1358 store_symval_forwarding (sym, bfwd->current_value, new_val);
1363 kill_buffer_local_variables (struct buffer *buf)
1365 Lisp_Object prev = Qnil;
1368 /* Any which are supposed to be permanent,
1369 make local again, with the same values they had. */
1371 for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
1373 Lisp_Object sym = XCAR (XCAR (alist));
1374 struct symbol_value_buffer_local *bfwd;
1375 /* Variables with a symbol-value-varalias should not be here
1376 (we should have forwarded past them) and there must be a
1377 symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
1378 just forward past it; if the variable has a handler, it was
1380 Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
1382 assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
1383 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
1385 if (!NILP (Fget (sym, Qpermanent_local, Qnil)))
1386 /* prev points to the last alist element that is still
1387 staying around, so *only* update it now. This didn't
1388 used to be the case; this bug has been around since
1389 mly's rewrite two years ago! */
1393 /* Really truly kill it. */
1395 XCDR (prev) = XCDR (alist);
1397 buf->local_var_alist = XCDR (alist);
1399 /* We just effectively changed the value for this variable
1402 /* (1) If the cache is caching BUF, invalidate the cache. */
1403 if (!NILP (bfwd->current_buffer) &&
1404 buf == XBUFFER (bfwd->current_buffer))
1405 bfwd->current_buffer = Qnil;
1407 /* (2) If we changed the value in current_buffer and this
1408 variable forwards to a C variable, we need to change the
1409 value of the C variable. set_up_buffer_local_cache()
1410 will do this. It doesn't hurt to do it whenever
1411 BUF == current_buffer, so just go ahead and do that. */
1412 if (buf == current_buffer)
1413 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
1419 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1420 struct console *con, int swap_it_in,
1421 Lisp_Object symcons, int set_it_p)
1423 Lisp_Object valcontents;
1426 valcontents = XSYMBOL (sym)->value;
1429 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1432 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1434 case SYMVAL_LISP_MAGIC:
1436 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1440 case SYMVAL_VARALIAS:
1441 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1443 /* presto change-o! */
1446 case SYMVAL_BUFFER_LOCAL:
1447 case SYMVAL_SOME_BUFFER_LOCAL:
1449 struct symbol_value_buffer_local *bfwd
1450 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1454 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1455 valcontents = bfwd->current_value;
1459 if (!NILP (bfwd->current_buffer) &&
1460 buf == XBUFFER (bfwd->current_buffer))
1461 valcontents = bfwd->current_value;
1462 else if (NILP (symcons))
1465 valcontents = assq_no_quit (sym, buf->local_var_alist);
1466 if (NILP (valcontents))
1467 valcontents = bfwd->default_value;
1469 valcontents = XCDR (valcontents);
1472 valcontents = XCDR (symcons);
1480 return do_symval_forwarding (valcontents, buf, con);
1484 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1485 bound. Note that it must not be possible to QUIT within this
1489 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
1496 buf = current_buffer;
1499 CHECK_BUFFER (buffer);
1500 buf = XBUFFER (buffer);
1503 return find_symbol_value_1 (sym, buf,
1504 /* If it bombs out at startup due to a
1505 Lisp error, this may be nil. */
1506 CONSOLEP (Vselected_console)
1507 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
1511 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1516 console = Vselected_console;
1518 CHECK_CONSOLE (console);
1520 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1524 /* Return the current value of SYM. The difference between this function
1525 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1526 this updates the CURRENT_VALUE slot of buffer-local variables to
1527 point to the current buffer, while symbol_value_in_buffer doesn't. */
1530 find_symbol_value (Lisp_Object sym)
1532 /* WARNING: This function can be called when current_buffer is 0
1533 and Vselected_console is Qnil, early in initialization. */
1534 struct console *con;
1535 Lisp_Object valcontents;
1539 valcontents = XSYMBOL (sym)->value;
1540 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1543 if (CONSOLEP (Vselected_console))
1544 con = XCONSOLE (Vselected_console);
1547 /* This can also get called while we're preparing to shutdown.
1548 #### What should really happen in that case? Should we
1549 actually fix things so we can't get here in that case? */
1550 assert (!initialized || preparing_for_armageddon);
1554 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
1557 /* This is an optimized function for quick lookup of buffer local symbols
1558 by avoiding O(n) search. This will work when either:
1559 a) We have already found the symbol e.g. by traversing local_var_alist.
1561 b) We know that the symbol will not be found in the current buffer's
1562 list of local variables.
1563 In the former case, find_it_p is 1 and symbol_cons is the element from
1564 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1567 This function is called from set_buffer_internal which does both of these
1571 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1573 /* WARNING: This function can be called when current_buffer is 0
1574 and Vselected_console is Qnil, early in initialization. */
1575 struct console *con;
1576 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1579 if (CONSOLEP (Vselected_console))
1580 con = XCONSOLE (Vselected_console);
1583 /* This can also get called while we're preparing to shutdown.
1584 #### What should really happen in that case? Should we
1585 actually fix things so we can't get here in that case? */
1586 assert (!initialized || preparing_for_armageddon);
1590 return find_symbol_value_1 (sym, current_buffer, con, 1,
1591 find_it_p ? symbol_cons : Qnil,
1595 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1596 Return SYMBOL's value. Error if that is void.
1600 Lisp_Object val = find_symbol_value (symbol);
1603 return Fsignal (Qvoid_variable, list1 (symbol));
1608 DEFUN ("set", Fset, 2, 2, 0, /*
1609 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1613 REGISTER Lisp_Object valcontents;
1614 struct Lisp_Symbol *sym;
1615 /* remember, we're called by Fmakunbound() as well */
1617 CHECK_SYMBOL (symbol);
1620 sym = XSYMBOL (symbol);
1621 valcontents = sym->value;
1623 if (EQ (symbol, Qnil) ||
1625 SYMBOL_IS_KEYWORD (symbol))
1626 reject_constant_symbols (symbol, newval, 0,
1627 UNBOUNDP (newval) ? Qmakunbound : Qset);
1629 if (!SYMBOL_VALUE_MAGIC_P (valcontents) || UNBOUNDP (valcontents))
1631 sym->value = newval;
1635 reject_constant_symbols (symbol, newval, 0,
1636 UNBOUNDP (newval) ? Qmakunbound : Qset);
1640 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1642 case SYMVAL_LISP_MAGIC:
1646 if (UNBOUNDP (newval))
1647 retval = maybe_call_magic_handler (symbol, Qmakunbound, 0);
1649 retval = maybe_call_magic_handler (symbol, Qset, 1, newval);
1650 if (!UNBOUNDP (retval))
1652 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1657 case SYMVAL_VARALIAS:
1658 symbol = follow_varalias_pointers (symbol,
1660 ? Qmakunbound : Qset);
1661 /* presto change-o! */
1664 case SYMVAL_FIXNUM_FORWARD:
1665 case SYMVAL_BOOLEAN_FORWARD:
1666 case SYMVAL_OBJECT_FORWARD:
1667 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1668 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1669 if (UNBOUNDP (newval))
1670 signal_error (Qerror,
1671 list2 (build_string ("Cannot makunbound"), symbol));
1674 /* case SYMVAL_UNBOUND_MARKER: break; */
1676 case SYMVAL_CURRENT_BUFFER_FORWARD:
1678 CONST struct symbol_value_forward *fwd
1679 = XSYMBOL_VALUE_FORWARD (valcontents);
1680 int mask = XINT (*((Lisp_Object *)
1681 symbol_value_forward_forward (fwd)));
1683 /* Setting this variable makes it buffer-local */
1684 current_buffer->local_var_flags |= mask;
1688 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1690 CONST struct symbol_value_forward *fwd
1691 = XSYMBOL_VALUE_FORWARD (valcontents);
1692 int mask = XINT (*((Lisp_Object *)
1693 symbol_value_forward_forward (fwd)));
1695 /* Setting this variable makes it console-local */
1696 XCONSOLE (Vselected_console)->local_var_flags |= mask;
1700 case SYMVAL_BUFFER_LOCAL:
1701 case SYMVAL_SOME_BUFFER_LOCAL:
1703 /* If we want to examine or set the value and
1704 CURRENT-BUFFER is current, we just examine or set
1705 CURRENT-VALUE. If CURRENT-BUFFER is not current, we
1706 store the current CURRENT-VALUE value into
1707 CURRENT-ALIST- ELEMENT, then find the appropriate alist
1708 element for the buffer now current and set up
1709 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
1710 of that element, and store into CURRENT-BUFFER.
1712 If we are setting the variable and the current buffer does
1713 not have an alist entry for this variable, an alist entry is
1716 Note that CURRENT-VALUE can be a forwarding pointer.
1717 Each time it is examined or set, forwarding must be
1719 struct symbol_value_buffer_local *bfwd
1720 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1721 int some_buffer_local_p =
1722 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
1723 /* What value are we caching right now? */
1724 Lisp_Object aelt = bfwd->current_alist_element;
1726 if (!NILP (bfwd->current_buffer) &&
1727 current_buffer == XBUFFER (bfwd->current_buffer)
1728 && ((some_buffer_local_p)
1729 ? 1 /* doesn't automatically become local */
1730 : !NILP (aelt) /* already local */
1733 /* Cache is valid */
1734 valcontents = bfwd->current_value;
1738 /* If the current buffer is not the buffer whose binding is
1739 currently cached, or if it's a SYMVAL_BUFFER_LOCAL and
1740 we're looking at the default value, the cache is invalid; we
1741 need to write it out, and find the new CURRENT-ALIST-ELEMENT
1744 /* Write out the cached value for the old buffer; copy it
1745 back to its alist element. This works if the current
1746 buffer only sees the default value, too. */
1747 write_out_buffer_local_cache (symbol, bfwd);
1749 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1750 aelt = buffer_local_alist_element (current_buffer, symbol, bfwd);
1753 /* This buffer is still seeing the default value. */
1754 if (!some_buffer_local_p)
1756 /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a
1757 new assoc for a local value and set
1758 CURRENT-ALIST-ELEMENT to point to that. */
1760 do_symval_forwarding (bfwd->current_value,
1762 XCONSOLE (Vselected_console));
1763 aelt = Fcons (symbol, aelt);
1764 current_buffer->local_var_alist
1765 = Fcons (aelt, current_buffer->local_var_alist);
1769 /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
1770 we're currently seeing the default value. */
1774 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1775 bfwd->current_alist_element = aelt;
1776 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
1777 XSETBUFFER (bfwd->current_buffer, current_buffer);
1778 valcontents = bfwd->current_value;
1785 store_symval_forwarding (symbol, valcontents, newval);
1791 /* Access or set a buffer-local symbol's default value. */
1793 /* Return the default value of SYM, but don't check for voidness.
1794 Return Qunbound if it is void. */
1797 default_value (Lisp_Object sym)
1799 Lisp_Object valcontents;
1804 valcontents = XSYMBOL (sym)->value;
1807 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1810 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1812 case SYMVAL_LISP_MAGIC:
1814 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1818 case SYMVAL_VARALIAS:
1819 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1820 /* presto change-o! */
1823 case SYMVAL_UNBOUND_MARKER:
1826 case SYMVAL_CURRENT_BUFFER_FORWARD:
1828 CONST struct symbol_value_forward *fwd
1829 = XSYMBOL_VALUE_FORWARD (valcontents);
1830 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1831 + ((char *)symbol_value_forward_forward (fwd)
1832 - (char *)&buffer_local_flags))));
1835 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1837 CONST struct symbol_value_forward *fwd
1838 = XSYMBOL_VALUE_FORWARD (valcontents);
1839 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1840 + ((char *)symbol_value_forward_forward (fwd)
1841 - (char *)&console_local_flags))));
1844 case SYMVAL_BUFFER_LOCAL:
1845 case SYMVAL_SOME_BUFFER_LOCAL:
1847 struct symbol_value_buffer_local *bfwd =
1848 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1850 /* Handle user-created local variables. */
1851 /* If var is set up for a buffer that lacks a local value for it,
1852 the current value is nominally the default value.
1853 But the current value slot may be more up to date, since
1854 ordinary setq stores just that slot. So use that. */
1855 if (NILP (bfwd->current_alist_element))
1856 return do_symval_forwarding (bfwd->current_value, current_buffer,
1857 XCONSOLE (Vselected_console));
1859 return bfwd->default_value;
1862 /* For other variables, get the current value. */
1863 return do_symval_forwarding (valcontents, current_buffer,
1864 XCONSOLE (Vselected_console));
1867 RETURN_NOT_REACHED (Qnil) /* suppress compiler warning */
1870 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /*
1871 Return t if SYMBOL has a non-void default value.
1872 This is the value that is seen in buffers that do not have their own values
1877 return UNBOUNDP (default_value (symbol)) ? Qnil : Qt;
1880 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /*
1881 Return SYMBOL's default value.
1882 This is the value that is seen in buffers that do not have their own values
1883 for this variable. The default value is meaningful for variables with
1884 local bindings in certain buffers.
1888 Lisp_Object value = default_value (symbol);
1890 return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (symbol)) : value;
1893 DEFUN ("set-default", Fset_default, 2, 2, 0, /*
1894 Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.
1895 The default value is seen in buffers that do not have their own values
1900 Lisp_Object valcontents;
1902 CHECK_SYMBOL (symbol);
1905 valcontents = XSYMBOL (symbol)->value;
1908 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1909 return Fset (symbol, value);
1911 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1913 case SYMVAL_LISP_MAGIC:
1914 RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (symbol, Qset_default, 1,
1916 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1920 case SYMVAL_VARALIAS:
1921 symbol = follow_varalias_pointers (symbol, Qset_default);
1922 /* presto change-o! */
1925 case SYMVAL_CURRENT_BUFFER_FORWARD:
1926 set_default_buffer_slot_variable (symbol, value);
1929 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1930 set_default_console_slot_variable (symbol, value);
1933 case SYMVAL_BUFFER_LOCAL:
1934 case SYMVAL_SOME_BUFFER_LOCAL:
1936 /* Store new value into the DEFAULT-VALUE slot */
1937 struct symbol_value_buffer_local *bfwd
1938 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1940 bfwd->default_value = value;
1941 /* If current-buffer doesn't shadow default_value,
1942 * we must set the CURRENT-VALUE slot too */
1943 if (NILP (bfwd->current_alist_element))
1944 store_symval_forwarding (symbol, bfwd->current_value, value);
1949 return Fset (symbol, value);
1953 DEFUN ("setq-default", Fsetq_default, 0, UNEVALLED, 0, /*
1954 Set the default value of variable SYMBOL to VALUE.
1955 SYMBOL, the variable name, is literal (not evaluated);
1956 VALUE is an expression and it is evaluated.
1957 The default value of a variable is seen in buffers
1958 that do not have their own values for the variable.
1960 More generally, you can use multiple variables and values, as in
1961 (setq-default SYMBOL VALUE SYMBOL VALUE...)
1962 This sets each SYMBOL's default value to the corresponding VALUE.
1963 The VALUE for the Nth SYMBOL can refer to the new default values
1964 of previous SYMBOLs.
1968 /* This function can GC */
1969 Lisp_Object symbol, tail, val = Qnil;
1971 struct gcpro gcpro1;
1973 GET_LIST_LENGTH (args, nargs);
1975 if (nargs & 1) /* Odd number of arguments? */
1976 Fsignal (Qwrong_number_of_arguments,
1977 list2 (Qsetq_default, make_int (nargs)));
1981 PROPERTY_LIST_LOOP (tail, symbol, val, args)
1984 Fset_default (symbol, val);
1991 /* Lisp functions for creating and removing buffer-local variables. */
1993 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1,
1994 "vMake Variable Buffer Local: ", /*
1995 Make VARIABLE have a separate value for each buffer.
1996 At any time, the value for the current buffer is in effect.
1997 There is also a default value which is seen in any buffer which has not yet
1999 Using `set' or `setq' to set the variable causes it to have a separate value
2000 for the current buffer if it was previously using the default value.
2001 The function `default-value' gets the default value and `set-default'
2006 Lisp_Object valcontents;
2008 CHECK_SYMBOL (variable);
2011 verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
2013 valcontents = XSYMBOL (variable)->value;
2016 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2018 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2020 case SYMVAL_LISP_MAGIC:
2021 if (!UNBOUNDP (maybe_call_magic_handler
2022 (variable, Qmake_variable_buffer_local, 0)))
2024 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2028 case SYMVAL_VARALIAS:
2029 variable = follow_varalias_pointers (variable,
2030 Qmake_variable_buffer_local);
2031 /* presto change-o! */
2034 case SYMVAL_FIXNUM_FORWARD:
2035 case SYMVAL_BOOLEAN_FORWARD:
2036 case SYMVAL_OBJECT_FORWARD:
2037 case SYMVAL_UNBOUND_MARKER:
2040 case SYMVAL_CURRENT_BUFFER_FORWARD:
2041 case SYMVAL_BUFFER_LOCAL:
2042 /* Already per-each-buffer */
2045 case SYMVAL_SOME_BUFFER_LOCAL:
2047 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
2048 SYMVAL_BUFFER_LOCAL;
2057 struct symbol_value_buffer_local *bfwd
2058 = alloc_lcrecord_type (struct symbol_value_buffer_local,
2059 &lrecord_symbol_value_buffer_local);
2061 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2063 bfwd->default_value = find_symbol_value (variable);
2064 bfwd->current_value = valcontents;
2065 bfwd->current_alist_element = Qnil;
2066 bfwd->current_buffer = Fcurrent_buffer ();
2067 XSETSYMBOL_VALUE_MAGIC (foo, bfwd);
2068 *value_slot_past_magic (variable) = foo;
2069 #if 1 /* #### Yuck! FSFmacs bug-compatibility*/
2070 /* This sets the default-value of any make-variable-buffer-local to nil.
2071 That just sucks. User can just use setq-default to effect that,
2072 but there's no way to do makunbound-default to undo this lossage. */
2073 if (UNBOUNDP (valcontents))
2074 bfwd->default_value = Qnil;
2076 #if 0 /* #### Yuck! */
2077 /* This sets the value to nil in this buffer.
2078 User could use (setq variable nil) to do this.
2079 It isn't as egregious to do this automatically
2080 as it is to do so to the default-value, but it's
2081 still really dubious. */
2082 if (UNBOUNDP (valcontents))
2083 Fset (variable, Qnil);
2089 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1,
2090 "vMake Local Variable: ", /*
2091 Make VARIABLE have a separate value in the current buffer.
2092 Other buffers will continue to share a common default value.
2093 \(The buffer-local value of VARIABLE starts out as the same value
2094 VARIABLE previously had. If VARIABLE was void, it remains void.)
2095 See also `make-variable-buffer-local'.
2097 If the variable is already arranged to become local when set,
2098 this function causes a local value to exist for this buffer,
2099 just as setting the variable would do.
2101 Do not use `make-local-variable' to make a hook variable buffer-local.
2102 Use `make-local-hook' instead.
2106 Lisp_Object valcontents;
2107 struct symbol_value_buffer_local *bfwd;
2109 CHECK_SYMBOL (variable);
2112 verify_ok_for_buffer_local (variable, Qmake_local_variable);
2114 valcontents = XSYMBOL (variable)->value;
2117 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2119 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2121 case SYMVAL_LISP_MAGIC:
2122 if (!UNBOUNDP (maybe_call_magic_handler
2123 (variable, Qmake_local_variable, 0)))
2125 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2129 case SYMVAL_VARALIAS:
2130 variable = follow_varalias_pointers (variable, Qmake_local_variable);
2131 /* presto change-o! */
2134 case SYMVAL_FIXNUM_FORWARD:
2135 case SYMVAL_BOOLEAN_FORWARD:
2136 case SYMVAL_OBJECT_FORWARD:
2137 case SYMVAL_UNBOUND_MARKER:
2140 case SYMVAL_BUFFER_LOCAL:
2141 case SYMVAL_CURRENT_BUFFER_FORWARD:
2143 /* Make sure the symbol has a local value in this particular
2144 buffer, by setting it to the same value it already has. */
2145 Fset (variable, find_symbol_value (variable));
2149 case SYMVAL_SOME_BUFFER_LOCAL:
2151 if (!NILP (buffer_local_alist_element (current_buffer,
2153 (XSYMBOL_VALUE_BUFFER_LOCAL
2155 goto already_local_to_current_buffer;
2157 goto already_local_to_some_other_buffer;
2165 /* Make sure variable is set up to hold per-buffer values */
2166 bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
2167 &lrecord_symbol_value_buffer_local);
2168 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2170 bfwd->current_buffer = Qnil;
2171 bfwd->current_alist_element = Qnil;
2172 bfwd->current_value = valcontents;
2173 /* passing 0 is OK because this should never be a
2174 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2176 bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
2179 if (UNBOUNDP (bfwd->default_value))
2180 bfwd->default_value = Qnil; /* Yuck! */
2183 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
2184 *value_slot_past_magic (variable) = valcontents;
2186 already_local_to_some_other_buffer:
2188 /* Make sure this buffer has its own value of variable */
2189 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2191 if (UNBOUNDP (bfwd->default_value))
2193 /* If default value is unbound, set local value to nil. */
2194 XSETBUFFER (bfwd->current_buffer, current_buffer);
2195 bfwd->current_alist_element = Fcons (variable, Qnil);
2196 current_buffer->local_var_alist =
2197 Fcons (bfwd->current_alist_element, current_buffer->local_var_alist);
2198 store_symval_forwarding (variable, bfwd->current_value, Qnil);
2202 current_buffer->local_var_alist
2203 = Fcons (Fcons (variable, bfwd->default_value),
2204 current_buffer->local_var_alist);
2206 /* Make sure symbol does not think it is set up for this buffer;
2207 force it to look once again for this buffer's value */
2208 if (!NILP (bfwd->current_buffer) &&
2209 current_buffer == XBUFFER (bfwd->current_buffer))
2210 bfwd->current_buffer = Qnil;
2212 already_local_to_current_buffer:
2214 /* If the symbol forwards into a C variable, then swap in the
2215 variable for this buffer immediately. If C code modifies the
2216 variable before we swap in, then that new value will clobber the
2217 default value the next time we swap. */
2218 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2219 if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value))
2221 switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
2223 case SYMVAL_FIXNUM_FORWARD:
2224 case SYMVAL_BOOLEAN_FORWARD:
2225 case SYMVAL_OBJECT_FORWARD:
2226 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2227 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2230 case SYMVAL_UNBOUND_MARKER:
2231 case SYMVAL_CURRENT_BUFFER_FORWARD:
2242 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1,
2243 "vKill Local Variable: ", /*
2244 Make VARIABLE no longer have a separate value in the current buffer.
2245 From now on the default value will apply in this buffer.
2249 Lisp_Object valcontents;
2251 CHECK_SYMBOL (variable);
2254 valcontents = XSYMBOL (variable)->value;
2257 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2260 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2262 case SYMVAL_LISP_MAGIC:
2263 if (!UNBOUNDP (maybe_call_magic_handler
2264 (variable, Qkill_local_variable, 0)))
2266 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2270 case SYMVAL_VARALIAS:
2271 variable = follow_varalias_pointers (variable, Qkill_local_variable);
2272 /* presto change-o! */
2275 case SYMVAL_CURRENT_BUFFER_FORWARD:
2277 CONST struct symbol_value_forward *fwd
2278 = XSYMBOL_VALUE_FORWARD (valcontents);
2279 int offset = ((char *) symbol_value_forward_forward (fwd)
2280 - (char *) &buffer_local_flags);
2282 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2286 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2287 Lisp_Object in_object, int flags) =
2288 symbol_value_forward_magicfun (fwd);
2289 Lisp_Object oldval = * (Lisp_Object *)
2290 (offset + (char *) XBUFFER (Vbuffer_defaults));
2292 (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
2293 *(Lisp_Object *) (offset + (char *) current_buffer)
2295 current_buffer->local_var_flags &= ~mask;
2300 case SYMVAL_BUFFER_LOCAL:
2301 case SYMVAL_SOME_BUFFER_LOCAL:
2303 /* Get rid of this buffer's alist element, if any */
2304 struct symbol_value_buffer_local *bfwd
2305 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2306 Lisp_Object alist = current_buffer->local_var_alist;
2307 Lisp_Object alist_element
2308 = buffer_local_alist_element (current_buffer, variable, bfwd);
2310 if (!NILP (alist_element))
2311 current_buffer->local_var_alist = Fdelq (alist_element, alist);
2313 /* Make sure symbol does not think it is set up for this buffer;
2314 force it to look once again for this buffer's value */
2315 if (!NILP (bfwd->current_buffer) &&
2316 current_buffer == XBUFFER (bfwd->current_buffer))
2317 bfwd->current_buffer = Qnil;
2319 /* We just changed the value in the current_buffer. If this
2320 variable forwards to a C variable, we need to change the
2321 value of the C variable. set_up_buffer_local_cache()
2322 will do this. It doesn't hurt to do it always,
2323 so just go ahead and do that. */
2324 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2331 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2335 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2336 "vKill Console Local Variable: ", /*
2337 Make VARIABLE no longer have a separate value in the selected console.
2338 From now on the default value will apply in this console.
2342 Lisp_Object valcontents;
2344 CHECK_SYMBOL (variable);
2347 valcontents = XSYMBOL (variable)->value;
2350 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2353 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2355 case SYMVAL_LISP_MAGIC:
2356 if (!UNBOUNDP (maybe_call_magic_handler
2357 (variable, Qkill_console_local_variable, 0)))
2359 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2363 case SYMVAL_VARALIAS:
2364 variable = follow_varalias_pointers (variable,
2365 Qkill_console_local_variable);
2366 /* presto change-o! */
2369 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2371 CONST struct symbol_value_forward *fwd
2372 = XSYMBOL_VALUE_FORWARD (valcontents);
2373 int offset = ((char *) symbol_value_forward_forward (fwd)
2374 - (char *) &console_local_flags);
2376 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2380 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2381 Lisp_Object in_object, int flags) =
2382 symbol_value_forward_magicfun (fwd);
2383 Lisp_Object oldval = * (Lisp_Object *)
2384 (offset + (char *) XCONSOLE (Vconsole_defaults));
2386 magicfun (variable, &oldval, Vselected_console, 0);
2387 *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
2389 XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
2399 /* Used by specbind to determine what effects it might have. Returns:
2400 * 0 if symbol isn't buffer-local, and wouldn't be after it is set
2401 * <0 if symbol isn't presently buffer-local, but set would make it so
2402 * >0 if symbol is presently buffer-local
2405 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
2407 Lisp_Object valcontents;
2410 valcontents = XSYMBOL (symbol)->value;
2413 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2415 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2417 case SYMVAL_LISP_MAGIC:
2419 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2423 case SYMVAL_VARALIAS:
2424 symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
2425 /* presto change-o! */
2428 case SYMVAL_CURRENT_BUFFER_FORWARD:
2430 CONST struct symbol_value_forward *fwd
2431 = XSYMBOL_VALUE_FORWARD (valcontents);
2432 int mask = XINT (*((Lisp_Object *)
2433 symbol_value_forward_forward (fwd)));
2434 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
2435 /* Already buffer-local */
2438 /* Would be buffer-local after set */
2441 case SYMVAL_BUFFER_LOCAL:
2442 case SYMVAL_SOME_BUFFER_LOCAL:
2444 struct symbol_value_buffer_local *bfwd
2445 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2447 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
2450 /* Automatically becomes local when set */
2451 return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
2461 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2462 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2464 (symbol, buffer, unbound_value))
2467 CHECK_SYMBOL (symbol);
2468 CHECK_BUFFER (buffer);
2469 value = symbol_value_in_buffer (symbol, buffer);
2470 return UNBOUNDP (value) ? unbound_value : value;
2473 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2474 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2476 (symbol, console, unbound_value))
2479 CHECK_SYMBOL (symbol);
2480 CHECK_CONSOLE (console);
2481 value = symbol_value_in_console (symbol, console);
2482 return UNBOUNDP (value) ? unbound_value : value;
2485 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
2486 If SYMBOL is a built-in variable, return info about this; else return nil.
2487 The returned info will be a symbol, one of
2489 `object' A simple built-in variable.
2490 `const-object' Same, but cannot be set.
2491 `integer' A built-in integer variable.
2492 `const-integer' Same, but cannot be set.
2493 `boolean' A built-in boolean variable.
2494 `const-boolean' Same, but cannot be set.
2495 `const-specifier' Always contains a specifier; e.g. `has-modeline-p'.
2496 `current-buffer' A built-in buffer-local variable.
2497 `const-current-buffer' Same, but cannot be set.
2498 `default-buffer' Forwards to the default value of a built-in
2499 buffer-local variable.
2500 `selected-console' A built-in console-local variable.
2501 `const-selected-console' Same, but cannot be set.
2502 `default-console' Forwards to the default value of a built-in
2503 console-local variable.
2507 REGISTER Lisp_Object valcontents;
2509 CHECK_SYMBOL (symbol);
2512 valcontents = XSYMBOL (symbol)->value;
2515 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2518 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2520 case SYMVAL_LISP_MAGIC:
2521 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2525 case SYMVAL_VARALIAS:
2526 symbol = follow_varalias_pointers (symbol, Qt);
2527 /* presto change-o! */
2530 case SYMVAL_BUFFER_LOCAL:
2531 case SYMVAL_SOME_BUFFER_LOCAL:
2533 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value;
2537 case SYMVAL_FIXNUM_FORWARD: return Qinteger;
2538 case SYMVAL_CONST_FIXNUM_FORWARD: return Qconst_integer;
2539 case SYMVAL_BOOLEAN_FORWARD: return Qboolean;
2540 case SYMVAL_CONST_BOOLEAN_FORWARD: return Qconst_boolean;
2541 case SYMVAL_OBJECT_FORWARD: return Qobject;
2542 case SYMVAL_CONST_OBJECT_FORWARD: return Qconst_object;
2543 case SYMVAL_CONST_SPECIFIER_FORWARD: return Qconst_specifier;
2544 case SYMVAL_DEFAULT_BUFFER_FORWARD: return Qdefault_buffer;
2545 case SYMVAL_CURRENT_BUFFER_FORWARD: return Qcurrent_buffer;
2546 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: return Qconst_current_buffer;
2547 case SYMVAL_DEFAULT_CONSOLE_FORWARD: return Qdefault_console;
2548 case SYMVAL_SELECTED_CONSOLE_FORWARD: return Qselected_console;
2549 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: return Qconst_selected_console;
2550 case SYMVAL_UNBOUND_MARKER: return Qnil;
2553 abort (); return Qnil;
2558 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
2559 Return t if SYMBOL's value is local to BUFFER.
2560 If optional third arg AFTER-SET is true, return t if SYMBOL would be
2561 buffer-local after it is set, regardless of whether it is so presently.
2562 A nil value for BUFFER is *not* the same as (current-buffer), but means
2563 "no buffer". Specifically:
2565 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
2566 the variable is one of the special built-in variables that is always
2567 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
2568 `buffer-undo-list', and others.)
2570 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
2571 the variable has had `make-variable-buffer-local' applied to it.
2573 (symbol, buffer, after_set))
2577 CHECK_SYMBOL (symbol);
2580 buffer = get_buffer (buffer, 1);
2581 local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
2585 local_info = symbol_value_buffer_local_info (symbol, 0);
2588 if (NILP (after_set))
2589 return local_info > 0 ? Qt : Qnil;
2591 return local_info != 0 ? Qt : Qnil;
2596 I've gone ahead and partially implemented this because it's
2597 super-useful for dealing with the compatibility problems in supporting
2598 the old pointer-shape variables, and preventing people from `setq'ing
2599 the new variables. Any other way of handling this problem is way
2600 ugly, likely to be slow, and generally not something I want to waste
2601 my time worrying about.
2603 The interface and/or function name is sure to change before this
2604 gets into its final form. I currently like the way everything is
2605 set up and it has all the features I want it to have, except for
2606 one: I really want to be able to have multiple nested handlers,
2607 to implement an `advice'-like capability. This would allow,
2608 for example, a clean way of implementing `debug-if-set' or
2609 `debug-if-referenced' and such.
2611 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
2612 ************************************************************
2613 **Only** the `set-value', `make-unbound', and `make-local'
2614 handler types are currently implemented. Implementing the
2615 get-value and bound-predicate handlers is somewhat tricky
2616 because there are lots of subfunctions (e.g. find_symbol_value()).
2617 find_symbol_value(), in fact, is called from outside of
2618 this module. You'd have to have it do this:
2620 -- check for a `bound-predicate' handler, call that if so;
2621 if it returns nil, return Qunbound
2622 -- check for a `get-value' handler and call it and return
2625 It gets even trickier when you have to deal with
2626 sub-subfunctions like find_symbol_value_1(), and esp.
2627 when you have to properly handle variable aliases, which
2628 can lead to lots of tricky situations. So I've just
2629 punted on this, since the interface isn't officially
2630 exported and we can get by with just a `set-value'
2633 Actions in unimplemented handler types will correctly
2634 ignore any handlers, and will not fuck anything up or
2637 WARNING WARNING: If you do go and implement another
2638 type of handler, make *sure* to change
2639 would_be_magic_handled() so it knows about this,
2640 or dire things could result.
2641 ************************************************************
2642 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
2644 Real documentation is as follows.
2646 Set a magic handler for VARIABLE.
2647 This allows you to specify arbitrary behavior that results from
2648 accessing or setting a variable. For example, retrieving the
2649 variable's value might actually retrieve the first element off of
2650 a list stored in another variable, and setting the variable's value
2651 might add an element to the front of that list. (This is how the
2652 obsolete variable `unread-command-event' is implemented.)
2654 In general it is NOT good programming practice to use magic variables
2655 in a new package that you are designing. If you feel the need to
2656 do this, it's almost certainly a sign that you should be using a
2657 function instead of a variable. This facility is provided to allow
2658 a package to support obsolete variables and provide compatibility
2659 with similar packages with different variable names and semantics.
2660 By using magic handlers, you can cleanly provide obsoleteness and
2661 compatibility support and separate this support from the core
2662 routines in a package.
2664 VARIABLE should be a symbol naming the variable for which the
2665 magic behavior is provided. HANDLER-TYPE is a symbol specifying
2666 which behavior is being controlled, and HANDLER is the function
2667 that will be called to control this behavior. HARG is a
2668 value that will be passed to HANDLER but is otherwise
2669 uninterpreted. KEEP-EXISTING specifies what to do with existing
2670 handlers of the same type; nil means "erase them all", t means
2671 "keep them but insert at the beginning", the list (t) means
2672 "keep them but insert at the end", a function means "keep
2673 them but insert before the specified function", a list containing
2674 a function means "keep them but insert after the specified
2677 You can specify magic behavior for any type of variable at all,
2678 and for any handler types that are unspecified, the standard
2679 behavior applies. This allows you, for example, to use
2680 `defvaralias' in conjunction with this function. (For that
2681 matter, `defvaralias' could be implemented using this function.)
2683 The behaviors that can be specified in HANDLER-TYPE are
2685 get-value (SYM ARGS FUN HARG HANDLERS)
2686 This means that one of the functions `symbol-value',
2687 `default-value', `symbol-value-in-buffer', or
2688 `symbol-value-in-console' was called on SYM.
2690 set-value (SYM ARGS FUN HARG HANDLERS)
2691 This means that one of the functions `set' or `set-default'
2694 bound-predicate (SYM ARGS FUN HARG HANDLERS)
2695 This means that one of the functions `boundp', `globally-boundp',
2696 or `default-boundp' was called on SYM.
2698 make-unbound (SYM ARGS FUN HARG HANDLERS)
2699 This means that the function `makunbound' was called on SYM.
2701 local-predicate (SYM ARGS FUN HARG HANDLERS)
2702 This means that the function `local-variable-p' was called
2705 make-local (SYM ARGS FUN HARG HANDLERS)
2706 This means that one of the functions `make-local-variable',
2707 `make-variable-buffer-local', `kill-local-variable',
2708 or `kill-console-local-variable' was called on SYM.
2710 The meanings of the arguments are as follows:
2712 SYM is the symbol on which the function was called, and is always
2713 the first argument to the function.
2715 ARGS are the remaining arguments in the original call (i.e. all
2716 but the first). In the case of `set-value' in particular,
2717 the first element of ARGS is the value to which the variable
2718 is being set. In some cases, ARGS is sanitized from what was
2719 actually given. For example, whenever `nil' is passed to an
2720 argument and it means `current-buffer', the current buffer is
2721 substituted instead.
2723 FUN is a symbol indicating which function is being called.
2724 For many of the functions, you can determine the corresponding
2725 function of a different class using
2726 `symbol-function-corresponding-function'.
2728 HARG is the argument that was given in the call
2729 to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
2731 HANDLERS is a structure containing the remaining handlers
2732 for the variable; to call one of them, use
2733 `chain-to-symbol-value-handler'.
2735 NOTE: You may *not* modify the list in ARGS, and if you want to
2736 keep it around after the handler function exits, you must make
2737 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
2740 static enum lisp_magic_handler
2741 decode_magic_handler_type (Lisp_Object symbol)
2743 if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE;
2744 if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE;
2745 if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE;
2746 if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND;
2747 if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE;
2748 if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL;
2750 signal_simple_error ("Unrecognized symbol value handler type", symbol);
2752 return MAGIC_HANDLER_MAX;
2755 static enum lisp_magic_handler
2756 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
2758 if (EQ (funsym, Qsymbol_value)
2759 || EQ (funsym, Qdefault_value)
2760 || EQ (funsym, Qsymbol_value_in_buffer)
2761 || EQ (funsym, Qsymbol_value_in_console))
2762 return MAGIC_HANDLER_GET_VALUE;
2764 if (EQ (funsym, Qset)
2765 || EQ (funsym, Qset_default))
2766 return MAGIC_HANDLER_SET_VALUE;
2768 if (EQ (funsym, Qboundp)
2769 || EQ (funsym, Qglobally_boundp)
2770 || EQ (funsym, Qdefault_boundp))
2771 return MAGIC_HANDLER_BOUND_PREDICATE;
2773 if (EQ (funsym, Qmakunbound))
2774 return MAGIC_HANDLER_MAKE_UNBOUND;
2776 if (EQ (funsym, Qlocal_variable_p))
2777 return MAGIC_HANDLER_LOCAL_PREDICATE;
2779 if (EQ (funsym, Qmake_variable_buffer_local)
2780 || EQ (funsym, Qmake_local_variable))
2781 return MAGIC_HANDLER_MAKE_LOCAL;
2783 if (abort_if_not_found)
2785 signal_simple_error ("Unrecognized symbol-value function", funsym);
2786 return MAGIC_HANDLER_MAX;
2790 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
2792 /* does not take into account variable aliasing. */
2793 Lisp_Object valcontents = XSYMBOL (sym)->value;
2794 enum lisp_magic_handler slot;
2796 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2798 slot = handler_type_from_function_symbol (funsym, 1);
2799 if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND
2800 && slot != MAGIC_HANDLER_MAKE_LOCAL)
2801 /* #### temporary kludge because we haven't implemented
2802 lisp-magic variables completely */
2804 return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
2808 fetch_value_maybe_past_magic (Lisp_Object sym,
2809 Lisp_Object follow_past_lisp_magic)
2811 Lisp_Object value = XSYMBOL (sym)->value;
2812 if (SYMBOL_VALUE_LISP_MAGIC_P (value)
2813 && (EQ (follow_past_lisp_magic, Qt)
2814 || (!NILP (follow_past_lisp_magic)
2815 && !would_be_magic_handled (sym, follow_past_lisp_magic))))
2816 value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed;
2820 static Lisp_Object *
2821 value_slot_past_magic (Lisp_Object sym)
2823 Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
2825 if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
2826 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
2827 return store_pointer;
2831 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
2834 Lisp_Object args[20]; /* should be enough ... */
2836 enum lisp_magic_handler htype;
2837 Lisp_Object legerdemain;
2838 struct symbol_value_lisp_magic *bfwd;
2840 assert (nargs >= 0 && nargs < 20);
2841 legerdemain = XSYMBOL (sym)->value;
2842 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2843 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2845 va_start (vargs, nargs);
2846 for (i = 0; i < nargs; i++)
2847 args[i] = va_arg (vargs, Lisp_Object);
2850 htype = handler_type_from_function_symbol (funsym, 1);
2851 if (NILP (bfwd->handler[htype]))
2853 /* #### should be reusing the arglist, not always consing anew.
2854 Repeated handler invocations should not cause repeated consing.
2855 Doesn't matter for now, because this is just a quick implementation
2856 for obsolescence support. */
2857 return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym,
2858 bfwd->harg[htype], Qnil);
2861 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
2863 Don't you dare use this.
2864 If you do, suffer the wrath of Ben, who is likely to rename
2865 this function (or change the semantics of its arguments) without
2866 pity, thereby invalidating your code.
2868 (variable, handler_type, handler, harg, keep_existing))
2870 Lisp_Object valcontents;
2871 struct symbol_value_lisp_magic *bfwd;
2872 enum lisp_magic_handler htype;
2875 /* #### WARNING, only some handler types are implemented. See above.
2876 Actions of other types will ignore a handler if it's there.
2878 #### Also, `chain-to-symbol-value-handler' and
2879 `symbol-function-corresponding-function' are not implemented. */
2880 CHECK_SYMBOL (variable);
2881 CHECK_SYMBOL (handler_type);
2882 htype = decode_magic_handler_type (handler_type);
2883 valcontents = XSYMBOL (variable)->value;
2884 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2886 bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
2887 &lrecord_symbol_value_lisp_magic);
2888 bfwd->magic.type = SYMVAL_LISP_MAGIC;
2889 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2891 bfwd->handler[i] = Qnil;
2892 bfwd->harg[i] = Qnil;
2894 bfwd->shadowed = valcontents;
2895 XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
2898 bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
2899 bfwd->handler[htype] = handler;
2900 bfwd->harg[htype] = harg;
2902 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2903 if (!NILP (bfwd->handler[i]))
2906 if (i == MAGIC_HANDLER_MAX)
2907 /* there are no remaining handlers, so remove the structure. */
2908 XSYMBOL (variable)->value = bfwd->shadowed;
2914 /* functions for working with variable aliases. */
2916 /* Follow the chain of variable aliases for SYMBOL. Return the
2917 resulting symbol, whose value cell is guaranteed not to be a
2918 symbol-value-varalias.
2920 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
2921 If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
2922 never follow; stop right there. Otherwise FUNSYM should be a
2923 recognized symbol-value function symbol; this means, follow
2924 unless there is a special handler for the named function.
2926 OK, there is at least one reason why it's necessary for
2927 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
2928 can always be sure to catch cyclic variable aliasing. If we never
2929 follow past Lisp magic, then if the following is done:
2932 add some magic behavior to a, but not a "get-value" handler
2935 then an attempt to retrieve a's or b's value would cause infinite
2936 looping in `symbol-value'.
2938 We (of course) can't always follow past Lisp magic, because then
2939 we make any variable that is lisp-magic -> varalias behave as if
2940 the lisp-magic is not present at all.
2944 follow_varalias_pointers (Lisp_Object symbol,
2945 Lisp_Object follow_past_lisp_magic)
2947 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
2948 Lisp_Object tortoise, hare, val;
2951 /* quick out just in case */
2952 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value))
2955 /* Compare implementation of indirect_function(). */
2956 for (hare = tortoise = symbol, count = 0;
2957 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic),
2958 SYMBOL_VALUE_VARALIAS_P (val);
2959 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)),
2962 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue;
2965 tortoise = symbol_value_varalias_aliasee
2966 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic
2967 (tortoise, follow_past_lisp_magic)));
2968 if (EQ (hare, tortoise))
2969 return Fsignal (Qcyclic_variable_indirection, list1 (symbol));
2975 DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
2976 Define a variable as an alias for another variable.
2977 Thenceforth, any operations performed on VARIABLE will actually be
2978 performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
2979 If ALIAS is nil, remove any aliases for VARIABLE.
2980 ALIAS can itself be aliased, and the chain of variable aliases
2981 will be followed appropriately.
2982 If VARIABLE already has a value, this value will be shadowed
2983 until the alias is removed, at which point it will be restored.
2984 Currently VARIABLE cannot be a built-in variable, a variable that
2985 has a buffer-local value in any buffer, or the symbols nil or t.
2986 \(ALIAS, however, can be any type of variable.)
2990 struct symbol_value_varalias *bfwd;
2991 Lisp_Object valcontents;
2993 CHECK_SYMBOL (variable);
2994 reject_constant_symbols (variable, Qunbound, 0, Qt);
2996 valcontents = XSYMBOL (variable)->value;
3000 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3002 XSYMBOL (variable)->value =
3003 symbol_value_varalias_shadowed
3004 (XSYMBOL_VALUE_VARALIAS (valcontents));
3009 CHECK_SYMBOL (alias);
3010 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3013 XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
3017 if (SYMBOL_VALUE_MAGIC_P (valcontents)
3018 && !UNBOUNDP (valcontents))
3019 signal_simple_error ("Variable is magic and cannot be aliased", variable);
3020 reject_constant_symbols (variable, Qunbound, 0, Qt);
3022 bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
3023 &lrecord_symbol_value_varalias);
3024 bfwd->magic.type = SYMVAL_VARALIAS;
3025 bfwd->aliasee = alias;
3026 bfwd->shadowed = valcontents;
3028 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
3029 XSYMBOL (variable)->value = valcontents;
3033 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
3034 If VARIABLE is aliased to another variable, return that variable.
3035 VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
3036 Variable aliases are created with `defvaralias'. See also
3037 `indirect-variable'.
3039 (variable, follow_past_lisp_magic))
3041 Lisp_Object valcontents;
3043 CHECK_SYMBOL (variable);
3044 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3046 CHECK_SYMBOL (follow_past_lisp_magic);
3047 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3050 valcontents = fetch_value_maybe_past_magic (variable,
3051 follow_past_lisp_magic);
3053 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3054 return symbol_value_varalias_aliasee
3055 (XSYMBOL_VALUE_VARALIAS (valcontents));
3060 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /*
3061 Return the variable at the end of OBJECT's variable-alias chain.
3062 If OBJECT is a symbol, follow all variable aliases and return
3063 the final (non-aliased) symbol. Variable aliases are created with
3064 the function `defvaralias'.
3065 If OBJECT is not a symbol, just return it.
3066 Signal a cyclic-variable-indirection error if there is a loop in the
3067 variable chain of symbols.
3069 (object, follow_past_lisp_magic))
3071 if (!SYMBOLP (object))
3073 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3075 CHECK_SYMBOL (follow_past_lisp_magic);
3076 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3078 return follow_varalias_pointers (object, follow_past_lisp_magic);
3082 /************************************************************************/
3083 /* initialization */
3084 /************************************************************************/
3086 /* A dumped XEmacs image has a lot more than 1511 symbols. Last
3087 estimate was that there were actually around 6300. So let's try
3088 making this bigger and see if we get better hashing behavior. */
3089 #define OBARRAY_SIZE 16411
3094 #ifndef Qnull_pointer
3095 Lisp_Object Qnull_pointer;
3098 /* some losing systems can't have static vars at function scope... */
3099 static struct symbol_value_magic guts_of_unbound_marker =
3100 { { symbol_value_forward_lheader_initializer, 0, 69},
3101 SYMVAL_UNBOUND_MARKER };
3104 init_symbols_once_early (void)
3107 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3110 #ifndef Qnull_pointer
3111 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3112 so the following is actually a no-op. */
3113 XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
3116 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3117 called the first time. */
3118 Qnil = Fmake_symbol (make_string_nocopy ((CONST Bufbyte *) "nil", 3));
3119 XSYMBOL (Qnil)->name->plist = Qnil;
3120 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
3121 XSYMBOL (Qnil)->plist = Qnil;
3123 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3124 initial_obarray = Vobarray;
3125 staticpro (&initial_obarray);
3126 /* Intern nil in the obarray */
3128 int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
3129 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3133 /* Required to get around a GCC syntax error on certain
3135 struct symbol_value_magic *tem = &guts_of_unbound_marker;
3137 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3139 if ((CONST void *) XPNTR (Qunbound) !=
3140 (CONST void *)&guts_of_unbound_marker)
3142 /* This might happen on DATA_SEG_BITS machines. */
3144 /* Can't represent a pointer to constant C data using a Lisp_Object.
3145 So heap-allocate it. */
3146 struct symbol_value_magic *urk = xnew (struct symbol_value_magic);
3147 memcpy (urk, &guts_of_unbound_marker, sizeof (*urk));
3148 XSETSYMBOL_VALUE_MAGIC (Qunbound, urk);
3151 XSYMBOL (Qnil)->function = Qunbound;
3153 defsymbol (&Qt, "t");
3154 XSYMBOL (Qt)->value = Qt; /* Veritas aetera */
3159 defsymbol (Lisp_Object *location, CONST char *name)
3161 *location = Fintern (make_string_nocopy ((CONST Bufbyte *) name,
3164 staticpro (location);
3168 defkeyword (Lisp_Object *location, CONST char *name)
3170 defsymbol (location, name);
3171 Fset (*location, *location);
3175 /* Check that nobody spazzed writing a DEFUN. */
3177 check_sane_subr (Lisp_Subr *subr, Lisp_Object sym)
3179 assert (subr->min_args >= 0);
3180 assert (subr->min_args <= SUBR_MAX_ARGS);
3182 if (subr->max_args != MANY &&
3183 subr->max_args != UNEVALLED)
3185 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3186 assert (subr->max_args <= SUBR_MAX_ARGS);
3187 assert (subr->min_args <= subr->max_args);
3190 assert (UNBOUNDP (XSYMBOL (sym)->function));
3193 #define check_sane_subr(subr, sym) /* nothing */
3198 * If we are not in a pure undumped Emacs, we need to make a duplicate of
3199 * the subr. This is because the only time this function will be called
3200 * in a running Emacs is when a dynamically loaded module is adding a
3201 * subr, and we need to make sure that the subr is in allocated, Lisp-
3202 * accessible memory. The address assigned to the static subr struct
3203 * in the shared object will be a trampoline address, so we need to create
3204 * a copy here to ensure that a real address is used.
3206 * Once we have copied everything across, we re-use the original static
3207 * structure to store a pointer to the newly allocated one. This will be
3208 * used in emodules.c by emodules_doc_subr() to find a pointer to the
3209 * allocated object so that we can set its doc string propperly.
3211 * NOTE: We dont actually use the DOC pointer here any more, but we did
3212 * in an earlier implementation of module support. There is no harm in
3213 * setting it here in case we ever need it in future implementations.
3214 * subr->doc will point to the new subr structure that was allocated.
3215 * Code can then get this value from the statis subr structure and use
3218 * FIXME: Should newsubr be staticpro()'ed? I dont think so but I need
3221 #define check_module_subr() \
3223 if (initialized) { \
3224 struct Lisp_Subr *newsubr; \
3225 newsubr = (Lisp_Subr *)xmalloc(sizeof(struct Lisp_Subr)); \
3226 memcpy (newsubr, subr, sizeof(struct Lisp_Subr)); \
3227 subr->doc = (CONST char *)newsubr; \
3231 #else /* ! HAVE_SHLIB */
3232 #define check_module_subr()
3236 defsubr (Lisp_Subr *subr)
3238 Lisp_Object sym = intern (subr_name (subr));
3241 check_sane_subr (subr, sym);
3242 check_module_subr ();
3244 XSETSUBR (fun, subr);
3245 XSYMBOL (sym)->function = fun;
3248 /* Define a lisp macro using a Lisp_Subr. */
3250 defsubr_macro (Lisp_Subr *subr)
3252 Lisp_Object sym = intern (subr_name (subr));
3255 check_sane_subr (subr, sym);
3256 check_module_subr();
3258 XSETSUBR (fun, subr);
3259 XSYMBOL (sym)->function = Fcons (Qmacro, fun);
3263 deferror (Lisp_Object *symbol, CONST char *name, CONST char *messuhhj,
3264 Lisp_Object inherits_from)
3267 defsymbol (symbol, name);
3269 assert (SYMBOLP (inherits_from));
3270 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3271 pure_put (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3272 /* NOT build_translated_string (). This function is called at load time
3273 and the string needs to get translated at run time. (This happens
3274 in the function (display-error) in cmdloop.el.) */
3275 pure_put (*symbol, Qerror_message, build_string (messuhhj));
3279 syms_of_symbols (void)
3281 defsymbol (&Qvariable_documentation, "variable-documentation");
3282 defsymbol (&Qvariable_domain, "variable-domain"); /* I18N3 */
3283 defsymbol (&Qad_advice_info, "ad-advice-info");
3284 defsymbol (&Qad_activate, "ad-activate");
3286 defsymbol (&Qget_value, "get-value");
3287 defsymbol (&Qset_value, "set-value");
3288 defsymbol (&Qbound_predicate, "bound-predicate");
3289 defsymbol (&Qmake_unbound, "make-unbound");
3290 defsymbol (&Qlocal_predicate, "local-predicate");
3291 defsymbol (&Qmake_local, "make-local");
3293 defsymbol (&Qboundp, "boundp");
3294 defsymbol (&Qfboundp, "fboundp");
3295 defsymbol (&Qglobally_boundp, "globally-boundp");
3296 defsymbol (&Qmakunbound, "makunbound");
3297 defsymbol (&Qsymbol_value, "symbol-value");
3298 defsymbol (&Qset, "set");
3299 defsymbol (&Qsetq_default, "setq-default");
3300 defsymbol (&Qdefault_boundp, "default-boundp");
3301 defsymbol (&Qdefault_value, "default-value");
3302 defsymbol (&Qset_default, "set-default");
3303 defsymbol (&Qmake_variable_buffer_local, "make-variable-buffer-local");
3304 defsymbol (&Qmake_local_variable, "make-local-variable");
3305 defsymbol (&Qkill_local_variable, "kill-local-variable");
3306 defsymbol (&Qkill_console_local_variable, "kill-console-local-variable");
3307 defsymbol (&Qsymbol_value_in_buffer, "symbol-value-in-buffer");
3308 defsymbol (&Qsymbol_value_in_console, "symbol-value-in-console");
3309 defsymbol (&Qlocal_variable_p, "local-variable-p");
3311 defsymbol (&Qconst_integer, "const-integer");
3312 defsymbol (&Qconst_boolean, "const-boolean");
3313 defsymbol (&Qconst_object, "const-object");
3314 defsymbol (&Qconst_specifier, "const-specifier");
3315 defsymbol (&Qdefault_buffer, "default-buffer");
3316 defsymbol (&Qcurrent_buffer, "current-buffer");
3317 defsymbol (&Qconst_current_buffer, "const-current-buffer");
3318 defsymbol (&Qdefault_console, "default-console");
3319 defsymbol (&Qselected_console, "selected-console");
3320 defsymbol (&Qconst_selected_console, "const-selected-console");
3323 DEFSUBR (Fintern_soft);
3324 DEFSUBR (Funintern);
3325 DEFSUBR (Fmapatoms);
3326 DEFSUBR (Fapropos_internal);
3328 DEFSUBR (Fsymbol_function);
3329 DEFSUBR (Fsymbol_plist);
3330 DEFSUBR (Fsymbol_name);
3331 DEFSUBR (Fmakunbound);
3332 DEFSUBR (Ffmakunbound);
3334 DEFSUBR (Fglobally_boundp);
3337 DEFSUBR (Fdefine_function);
3338 Ffset (intern ("defalias"), intern ("define-function"));
3339 DEFSUBR (Fsetplist);
3340 DEFSUBR (Fsymbol_value_in_buffer);
3341 DEFSUBR (Fsymbol_value_in_console);
3342 DEFSUBR (Fbuilt_in_variable_type);
3343 DEFSUBR (Fsymbol_value);
3345 DEFSUBR (Fdefault_boundp);
3346 DEFSUBR (Fdefault_value);
3347 DEFSUBR (Fset_default);
3348 DEFSUBR (Fsetq_default);
3349 DEFSUBR (Fmake_variable_buffer_local);
3350 DEFSUBR (Fmake_local_variable);
3351 DEFSUBR (Fkill_local_variable);
3352 DEFSUBR (Fkill_console_local_variable);
3353 DEFSUBR (Flocal_variable_p);
3354 DEFSUBR (Fdefvaralias);
3355 DEFSUBR (Fvariable_alias);
3356 DEFSUBR (Findirect_variable);
3357 DEFSUBR (Fdontusethis_set_symbol_value_handler);
3360 /* Create and initialize a Lisp variable whose value is forwarded to C data */
3362 defvar_magic (CONST char *symbol_name, CONST struct symbol_value_forward *magic)
3364 Lisp_Object sym, kludge;
3366 /* Check that `magic' points somewhere we can represent as a Lisp pointer */
3367 XSETOBJ (kludge, Lisp_Type_Record, magic);
3368 if ((void *)magic != (void*) XPNTR (kludge))
3370 /* This might happen on DATA_SEG_BITS machines. */
3372 /* Copy it to somewhere which is representable. */
3373 struct symbol_value_forward *p = xnew (struct symbol_value_forward);
3374 memcpy (p, magic, sizeof *magic);
3378 #if defined(HAVE_SHLIB)
3380 * As with defsubr(), this will only be called in a dumped Emacs when
3381 * we are adding variables from a dynamically loaded module. That means
3382 * we can't use purespace. Take that into account.
3385 sym = Fintern (build_string (symbol_name), Qnil);
3388 sym = Fintern (make_string_nocopy ((CONST Bufbyte *) symbol_name,
3389 strlen (symbol_name)), Qnil);
3391 XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic);
3395 vars_of_symbols (void)
3397 DEFVAR_LISP ("obarray", &Vobarray /*
3398 Symbol table for use by `intern' and `read'.
3399 It is a vector whose length ought to be prime for best results.
3400 The vector's contents don't make sense if examined from Lisp programs;
3401 to find all the symbols in an obarray, use `mapatoms'.
3403 /* obarray has been initialized long before */