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 */
63 Lisp_Object Qad_advice_info, Qad_activate;
65 Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound;
66 Lisp_Object Qlocal_predicate, Qmake_local;
68 Lisp_Object Qboundp, Qfboundp, Qglobally_boundp, Qmakunbound;
69 Lisp_Object Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value;
70 Lisp_Object Qset_default, Qsetq_default;
71 Lisp_Object Qmake_variable_buffer_local, Qmake_local_variable;
72 Lisp_Object Qkill_local_variable, Qkill_console_local_variable;
73 Lisp_Object Qsymbol_value_in_buffer, Qsymbol_value_in_console;
74 Lisp_Object Qlocal_variable_p;
76 Lisp_Object Qconst_integer, Qconst_boolean, Qconst_object;
77 Lisp_Object Qconst_specifier;
78 Lisp_Object Qdefault_buffer, Qcurrent_buffer, Qconst_current_buffer;
79 Lisp_Object Qdefault_console, Qselected_console, Qconst_selected_console;
81 static Lisp_Object maybe_call_magic_handler (Lisp_Object sym,
84 static Lisp_Object fetch_value_maybe_past_magic (Lisp_Object sym,
85 Lisp_Object follow_past_lisp_magic);
86 static Lisp_Object *value_slot_past_magic (Lisp_Object sym);
87 static Lisp_Object follow_varalias_pointers (Lisp_Object symbol,
88 Lisp_Object follow_past_lisp_magic);
92 mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object))
94 struct Lisp_Symbol *sym = XSYMBOL (obj);
98 markobj (sym->function);
99 XSETSTRING (pname, sym->name);
101 if (!symbol_next (sym))
105 markobj (sym->plist);
106 /* Mark the rest of the symbols in the obarray hash-chain */
107 sym = symbol_next (sym);
108 XSETSYMBOL (obj, sym);
113 static const struct lrecord_description symbol_description[] = {
114 { XD_LISP_OBJECT, offsetof(struct Lisp_Symbol, next), 5 }
117 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
118 mark_symbol, print_symbol, 0, 0, 0,
119 symbol_description, struct Lisp_Symbol);
122 /**********************************************************************/
124 /**********************************************************************/
126 /* #### using a vector here is way bogus. Use a hash table instead. */
128 Lisp_Object Vobarray;
130 static Lisp_Object initial_obarray;
132 /* oblookup stores the bucket number here, for the sake of Funintern. */
134 static int oblookup_last_bucket_number;
137 check_obarray (Lisp_Object obarray)
139 while (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
141 /* If Vobarray is now invalid, force it to be valid. */
142 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
144 obarray = wrong_type_argument (Qvectorp, obarray);
150 intern (CONST char *str)
152 Bytecount len = strlen (str);
153 CONST Bufbyte *buf = (CONST Bufbyte *) str;
154 Lisp_Object obarray = Vobarray;
156 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
157 obarray = check_obarray (obarray);
160 Lisp_Object tem = oblookup (obarray, buf, len);
165 return Fintern (make_string (buf, len), obarray);
168 DEFUN ("intern", Fintern, 1, 2, 0, /*
169 Return the canonical symbol whose name is STRING.
170 If there is none, one is created by this function and returned.
171 A second optional argument specifies the obarray to use;
172 it defaults to the value of `obarray'.
176 Lisp_Object object, *ptr;
177 struct Lisp_Symbol *symbol;
180 if (NILP (obarray)) obarray = Vobarray;
181 obarray = check_obarray (obarray);
183 CHECK_STRING (string);
185 len = XSTRING_LENGTH (string);
186 object = oblookup (obarray, XSTRING_DATA (string), len);
191 ptr = &XVECTOR_DATA (obarray)[XINT (object)];
193 object = Fmake_symbol (string);
194 symbol = XSYMBOL (object);
197 symbol_next (symbol) = XSYMBOL (*ptr);
199 symbol_next (symbol) = 0;
202 if (string_byte (symbol_name (symbol), 0) == ':' && EQ (obarray, Vobarray))
204 /* The LISP way is to put keywords in their own package, but we
205 don't have packages, so we do something simpler. Someday,
206 maybe we'll have packages and then this will be reworked.
208 symbol_value (symbol) = object;
214 DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /*
215 Return the canonical symbol named NAME, or nil if none exists.
216 NAME may be a string or a symbol. If it is a symbol, that exact
217 symbol is searched for.
218 A second optional argument specifies the obarray to use;
219 it defaults to the value of `obarray'.
223 /* #### Bug! (intern-soft "nil") returns nil. Perhaps we should
224 add a DEFAULT-IF-NOT-FOUND arg, like in get. */
226 struct Lisp_String *string;
228 if (NILP (obarray)) obarray = Vobarray;
229 obarray = check_obarray (obarray);
234 string = XSTRING (name);
237 string = symbol_name (XSYMBOL (name));
239 tem = oblookup (obarray, string_data (string), string_length (string));
240 if (INTP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
246 DEFUN ("unintern", Funintern, 1, 2, 0, /*
247 Delete the symbol named NAME, if any, from OBARRAY.
248 The value is t if a symbol was found and deleted, nil otherwise.
249 NAME may be a string or a symbol. If it is a symbol, that symbol
250 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
251 OBARRAY defaults to the value of the variable `obarray'
256 struct Lisp_String *string;
259 if (NILP (obarray)) obarray = Vobarray;
260 obarray = check_obarray (obarray);
263 string = symbol_name (XSYMBOL (name));
267 string = XSTRING (name);
270 tem = oblookup (obarray, string_data (string), string_length (string));
273 /* If arg was a symbol, don't delete anything but that symbol itself. */
274 if (SYMBOLP (name) && !EQ (name, tem))
277 hash = oblookup_last_bucket_number;
279 if (EQ (XVECTOR_DATA (obarray)[hash], tem))
281 if (XSYMBOL (tem)->next)
282 XSETSYMBOL (XVECTOR_DATA (obarray)[hash], XSYMBOL (tem)->next);
284 XVECTOR_DATA (obarray)[hash] = Qzero;
288 Lisp_Object tail, following;
290 for (tail = XVECTOR_DATA (obarray)[hash];
291 XSYMBOL (tail)->next;
294 XSETSYMBOL (following, XSYMBOL (tail)->next);
295 if (EQ (following, tem))
297 XSYMBOL (tail)->next = XSYMBOL (following)->next;
305 /* Return the symbol in OBARRAY whose names matches the string
306 of SIZE characters at PTR. If there is no such symbol in OBARRAY,
307 return the index into OBARRAY that the string hashes to.
309 Also store the bucket number in oblookup_last_bucket_number. */
312 oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size)
315 struct Lisp_Symbol *tail;
318 if (!VECTORP (obarray) ||
319 (obsize = XVECTOR_LENGTH (obarray)) == 0)
321 obarray = check_obarray (obarray);
322 obsize = XVECTOR_LENGTH (obarray);
324 hash = hash_string (ptr, size) % obsize;
325 oblookup_last_bucket_number = hash;
326 bucket = XVECTOR_DATA (obarray)[hash];
329 else if (!SYMBOLP (bucket))
330 error ("Bad data in guts of obarray"); /* Like CADR error message */
332 for (tail = XSYMBOL (bucket); ;)
334 if (string_length (tail->name) == size &&
335 !memcmp (string_data (tail->name), ptr, size))
337 XSETSYMBOL (bucket, tail);
340 tail = symbol_next (tail);
344 return make_int (hash);
347 #if 0 /* Emacs 19.34 */
349 hash_string (CONST Bufbyte *ptr, Bytecount len)
351 CONST Bufbyte *p = ptr;
352 CONST Bufbyte *end = p + len;
359 if (c >= 0140) c -= 40;
360 hash = ((hash<<3) + (hash>>28) + c);
362 return hash & 07777777777;
366 /* derived from hashpjw, Dragon Book P436. */
368 hash_string (CONST Bufbyte *ptr, Bytecount len)
375 hash = (hash << 4) + *ptr++;
376 g = hash & 0xf0000000;
378 hash = (hash ^ (g >> 24)) ^ g;
380 return hash & 07777777777;
383 /* Map FN over OBARRAY. The mapping is stopped when FN returns a
386 map_obarray (Lisp_Object obarray,
387 int (*fn) (Lisp_Object, void *), void *arg)
391 CHECK_VECTOR (obarray);
392 for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--)
394 Lisp_Object tail = XVECTOR_DATA (obarray)[i];
398 struct Lisp_Symbol *next;
399 if ((*fn) (tail, arg))
401 next = symbol_next (XSYMBOL (tail));
404 XSETSYMBOL (tail, next);
410 mapatoms_1 (Lisp_Object sym, void *arg)
412 call1 (*(Lisp_Object *)arg, sym);
416 DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /*
417 Call FUNCTION on every symbol in OBARRAY.
418 OBARRAY defaults to the value of `obarray'.
424 obarray = check_obarray (obarray);
426 map_obarray (obarray, mapatoms_1, &function);
431 /**********************************************************************/
433 /**********************************************************************/
435 struct appropos_mapper_closure
438 Lisp_Object predicate;
439 Lisp_Object accumulation;
443 apropos_mapper (Lisp_Object symbol, void *arg)
445 struct appropos_mapper_closure *closure =
446 (struct appropos_mapper_closure *) arg;
447 Bytecount match = fast_lisp_string_match (closure->regexp,
448 Fsymbol_name (symbol));
451 (NILP (closure->predicate) ||
452 !NILP (call1 (closure->predicate, symbol))))
453 closure->accumulation = Fcons (symbol, closure->accumulation);
458 DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /*
459 Show all symbols whose names contain match for REGEXP.
460 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL)
461 is done for each symbol and a symbol is mentioned only if that
463 Return list of symbols found.
467 struct appropos_mapper_closure closure;
469 CHECK_STRING (regexp);
471 closure.regexp = regexp;
472 closure.predicate = predicate;
473 closure.accumulation = Qnil;
474 map_obarray (Vobarray, apropos_mapper, &closure);
475 closure.accumulation = Fsort (closure.accumulation, Qstring_lessp);
476 return closure.accumulation;
480 /* Extract and set components of symbols */
482 static void set_up_buffer_local_cache (Lisp_Object sym,
483 struct symbol_value_buffer_local *bfwd,
485 Lisp_Object new_alist_el,
488 DEFUN ("boundp", Fboundp, 1, 1, 0, /*
489 Return t if SYMBOL's value is not void.
493 CHECK_SYMBOL (symbol);
494 return UNBOUNDP (find_symbol_value (symbol)) ? Qnil : Qt;
497 DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /*
498 Return t if SYMBOL has a global (non-bound) value.
499 This is for the byte-compiler; you really shouldn't be using this.
503 CHECK_SYMBOL (symbol);
504 return UNBOUNDP (top_level_value (symbol)) ? Qnil : Qt;
507 DEFUN ("fboundp", Ffboundp, 1, 1, 0, /*
508 Return t if SYMBOL's function definition is not void.
512 CHECK_SYMBOL (symbol);
513 return UNBOUNDP (XSYMBOL (symbol)->function) ? Qnil : Qt;
516 /* Return non-zero if SYM's value or function (the current contents of
517 which should be passed in as VAL) is constant, i.e. unsettable. */
520 symbol_is_constant (Lisp_Object sym, Lisp_Object val)
522 /* #### - I wonder if it would be better to just have a new magic value
523 type and make nil, t, and all keywords have that same magic
524 constant_symbol value. This test is awfully specific about what is
525 constant and what isn't. --Stig */
526 if (EQ (sym, Qnil) ||
530 if (SYMBOL_VALUE_MAGIC_P (val))
531 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
533 case SYMVAL_CONST_OBJECT_FORWARD:
534 case SYMVAL_CONST_SPECIFIER_FORWARD:
535 case SYMVAL_CONST_FIXNUM_FORWARD:
536 case SYMVAL_CONST_BOOLEAN_FORWARD:
537 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
538 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
540 default: break; /* Warning suppression */
543 /* We don't return true for keywords here because they are handled
544 specially by reject_constant_symbols(). */
548 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
549 non-zero) to NEWVAL. Make sure this is allowed.
550 FOLLOW_PAST_LISP_MAGIC specifies whether we delve past
551 symbol-value-lisp-magic objects. */
554 reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p,
555 Lisp_Object follow_past_lisp_magic)
558 (function_p ? XSYMBOL (sym)->function
559 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
561 if (SYMBOL_VALUE_MAGIC_P (val) &&
562 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
563 signal_simple_error ("Use `set-specifier' to change a specifier's value",
566 if (symbol_is_constant (sym, val)
567 || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)))
568 signal_error (Qsetting_constant,
569 UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
572 /* Verify that it's ok to make SYM buffer-local. This rejects
573 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC
574 specifies whether we delve into symbol-value-lisp-magic objects.
575 (Should be a symbol indicating what action is being taken; that way,
576 we don't delve if there's a handler for that action, but do otherwise.) */
579 verify_ok_for_buffer_local (Lisp_Object sym,
580 Lisp_Object follow_past_lisp_magic)
582 Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic);
584 if (symbol_is_constant (sym, val))
586 if (SYMBOL_VALUE_MAGIC_P (val))
587 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
589 case SYMVAL_DEFAULT_BUFFER_FORWARD:
590 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
591 /* #### It's theoretically possible for it to be reasonable
592 to have both console-local and buffer-local variables,
593 but I don't want to consider that right now. */
594 case SYMVAL_SELECTED_CONSOLE_FORWARD:
596 default: break; /* Warning suppression */
602 signal_error (Qerror,
603 list2 (build_string ("Symbol may not be buffer-local"), sym));
606 DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /*
607 Make SYMBOL's value be void.
611 Fset (symbol, Qunbound);
615 DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /*
616 Make SYMBOL's function definition be void.
620 CHECK_SYMBOL (symbol);
621 reject_constant_symbols (symbol, Qunbound, 1, Qt);
622 XSYMBOL (symbol)->function = Qunbound;
626 DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /*
627 Return SYMBOL's function definition. Error if that is void.
631 CHECK_SYMBOL (symbol);
632 if (UNBOUNDP (XSYMBOL (symbol)->function))
633 signal_void_function_error (symbol);
634 return XSYMBOL (symbol)->function;
637 DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /*
638 Return SYMBOL's property list.
642 CHECK_SYMBOL (symbol);
643 return XSYMBOL (symbol)->plist;
646 DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /*
647 Return SYMBOL's name, a string.
653 CHECK_SYMBOL (symbol);
654 XSETSTRING (name, XSYMBOL (symbol)->name);
658 DEFUN ("fset", Ffset, 2, 2, 0, /*
659 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
663 /* This function can GC */
664 CHECK_SYMBOL (symbol);
665 reject_constant_symbols (symbol, newdef, 1, Qt);
666 if (!NILP (Vautoload_queue) && !UNBOUNDP (XSYMBOL (symbol)->function))
667 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
669 XSYMBOL (symbol)->function = newdef;
670 /* Handle automatic advice activation */
671 if (CONSP (XSYMBOL (symbol)->plist) &&
672 !NILP (Fget (symbol, Qad_advice_info, Qnil)))
674 call2 (Qad_activate, symbol, Qnil);
675 newdef = XSYMBOL (symbol)->function;
681 DEFUN ("define-function", Fdefine_function, 2, 2, 0, /*
682 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
683 Associates the function with the current load file, if any.
687 /* This function can GC */
688 Ffset (symbol, newdef);
689 LOADHIST_ATTACH (symbol);
694 DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
695 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
699 CHECK_SYMBOL (symbol);
700 #if 0 /* Inserted for debugging 6/28/1997 -slb */
701 /* Somebody is setting a property list of integer 0, who? */
702 /* Not this way apparently. */
703 if (EQ(newplist, Qzero)) abort();
706 XSYMBOL (symbol)->plist = newplist;
711 /**********************************************************************/
713 /**********************************************************************/
715 /* If the contents of the value cell of a symbol is one of the following
716 three types of objects, then the symbol is "magic" in that setting
717 and retrieving its value doesn't just set or retrieve the raw
718 contents of the value cell. None of these objects can escape to
719 the user level, so there is no loss of generality.
721 If a symbol is "unbound", then the contents of its value cell is
722 Qunbound. Despite appearances, this is *not* a symbol, but is a
723 symbol-value-forward object. This is so that printing it results
724 in "INTERNAL OBJECT (XEmacs bug?)", in case it leaks to Lisp, somehow.
726 Logically all of the following objects are "symbol-value-magic"
727 objects, and there are some games played w.r.t. this (#### this
728 should be cleaned up). SYMBOL_VALUE_MAGIC_P is true for all of
729 the object types. XSYMBOL_VALUE_MAGIC_TYPE returns the type of
730 symbol-value-magic object. There are more than three types
731 returned by this macro: in particular, symbol-value-forward
732 has eight subtypes, and symbol-value-buffer-local has two. See
735 1. symbol-value-forward
737 symbol-value-forward is used for variables whose actual contents
738 are stored in a C variable of some sort, and for Qunbound. The
739 lcheader.next field (which is only used to chain together free
740 lcrecords) holds a pointer to the actual C variable. Included
741 in this type are "buffer-local" variables that are actually
742 stored in the buffer object itself; in this case, the "pointer"
743 is an offset into the struct buffer structure.
745 The subtypes are as follows:
747 SYMVAL_OBJECT_FORWARD:
748 (declare with DEFVAR_LISP)
749 The value of this variable is stored in a C variable of type
750 "Lisp_Object". Setting this variable sets the C variable.
751 Accessing this variable retrieves a value from the C variable.
752 These variables can be buffer-local -- in this case, the
753 raw symbol-value field gets converted into a
754 symbol-value-buffer-local, whose "current_value" slot contains
755 the symbol-value-forward. (See below.)
757 SYMVAL_FIXNUM_FORWARD:
758 SYMVAL_BOOLEAN_FORWARD:
759 (declare with DEFVAR_INT or DEFVAR_BOOL)
760 Similar to SYMVAL_OBJECT_FORWARD except that the C variable
761 is of type "int" and is an integer or boolean, respectively.
763 SYMVAL_CONST_OBJECT_FORWARD:
764 SYMVAL_CONST_FIXNUM_FORWARD:
765 SYMVAL_CONST_BOOLEAN_FORWARD:
766 (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
768 Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
769 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
772 SYMVAL_CONST_SPECIFIER_FORWARD:
773 (declare with DEFVAR_SPECIFIER)
774 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that error message
775 you get when attempting to set the value says to use
776 `set-specifier' instead.
778 SYMVAL_CURRENT_BUFFER_FORWARD:
779 (declare with DEFVAR_BUFFER_LOCAL)
780 This is used for built-in buffer-local variables -- i.e.
781 Lisp variables whose value is stored in the "struct buffer".
782 Variables of this sort always forward into C "Lisp_Object"
783 fields (although there's no reason in principle that other
784 types for ints and booleans couldn't be added). Note that
785 some of these variables are automatically local in each
786 buffer, while some are only local when they become set
787 (similar to `make-variable-buffer-local'). In these latter
788 cases, of course, the default value shows through in all
789 buffers in which the variable doesn't have a local value.
790 This is implemented by making sure the "struct buffer" field
791 always contains the correct value (whether it's local or
792 a default) and maintaining a mask in the "struct buffer"
793 indicating which fields are local. When `set-default' is
794 called on a variable that's not always local to all buffers,
795 it loops through each buffer and sets the corresponding
796 field in each buffer without a local value for the field,
797 according to the mask.
799 Calling `make-local-variable' on a variable of this sort
800 only has the effect of maybe changing the current buffer's mask.
801 Calling `make-variable-buffer-local' on a variable of this
802 sort has no effect at all.
804 SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
805 (declare with DEFVAR_CONST_BUFFER_LOCAL)
806 Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
809 SYMVAL_DEFAULT_BUFFER_FORWARD:
810 (declare with DEFVAR_BUFFER_DEFAULTS)
811 This is used for the Lisp variables that contain the
812 default values of built-in buffer-local variables. Setting
813 or referencing one of these variables forwards into a slot
814 in the special struct buffer Vbuffer_defaults.
816 SYMVAL_UNBOUND_MARKER:
817 This is used for only one object, Qunbound.
819 SYMVAL_SELECTED_CONSOLE_FORWARD:
820 (declare with DEFVAR_CONSOLE_LOCAL)
821 This is used for built-in console-local variables -- i.e.
822 Lisp variables whose value is stored in the "struct console".
823 These work just like built-in buffer-local variables.
824 However, calling `make-local-variable' or
825 `make-variable-buffer-local' on one of these variables
826 is currently disallowed because that would entail having
827 both console-local and buffer-local variables, which is
828 trickier to implement.
830 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
831 (declare with DEFVAR_CONST_CONSOLE_LOCAL)
832 Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
835 SYMVAL_DEFAULT_CONSOLE_FORWARD:
836 (declare with DEFVAR_CONSOLE_DEFAULTS)
837 This is used for the Lisp variables that contain the
838 default values of built-in console-local variables. Setting
839 or referencing one of these variables forwards into a slot
840 in the special struct console Vconsole_defaults.
843 2. symbol-value-buffer-local
845 symbol-value-buffer-local is used for variables that have had
846 `make-local-variable' or `make-variable-buffer-local' applied
847 to them. This object contains an alist mapping buffers to
848 values. In addition, the object contains a "current value",
849 which is the value in some buffer. Whenever you access the
850 variable with `symbol-value' or set it with `set' or `setq',
851 things are switched around so that the "current value"
852 refers to the current buffer, if it wasn't already. This
853 way, repeated references to a variable in the same buffer
854 are almost as efficient as if the variable weren't buffer
855 local. Note that the alist may not be up-to-date w.r.t.
856 the buffer whose value is current, as the "current value"
857 cache is normally only flushed into the alist when the
858 buffer it refers to changes.
860 Note also that it is possible for `make-local-variable'
861 or `make-variable-buffer-local' to be called on a variable
862 that forwards into a C variable (i.e. a variable whose
863 value cell is a symbol-value-forward). In this case,
864 the value cell becomes a symbol-value-buffer-local (as
865 always), and the symbol-value-forward moves into
866 the "current value" cell in this object. Also, in
867 this case the "current value" *always* refers to the
868 current buffer, so that the values of the C variable
869 always is the correct value for the current buffer.
870 set_buffer_internal() automatically updates the current-value
871 cells of all buffer-local variables that forward into C
872 variables. (There is a list of all buffer-local variables
873 that is maintained for this and other purposes.)
875 Note that only certain types of `symbol-value-forward' objects
876 can find their way into the "current value" cell of a
877 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
878 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
879 SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot
880 be buffer-local because they are unsettable;
881 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
882 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
883 does not have much of an effect (it's already buffer-local); and
884 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
885 that's not currently implemented.
888 3. symbol-value-varalias
890 A symbol-value-varalias object is used for variables that
891 are aliases for other variables. This object contains
892 the symbol that this variable is aliased to.
893 symbol-value-varalias objects cannot occur anywhere within
894 a symbol-value-buffer-local object, and most of the
895 low-level functions below do not accept them; you need
896 to call follow_varalias_pointers to get the actual
897 symbol to operate on. */
900 mark_symbol_value_buffer_local (Lisp_Object obj,
901 void (*markobj) (Lisp_Object))
903 struct symbol_value_buffer_local *bfwd;
905 #ifdef ERROR_CHECK_TYPECHECK
906 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
907 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
910 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
911 markobj (bfwd->default_value);
912 markobj (bfwd->current_value);
913 markobj (bfwd->current_buffer);
914 return bfwd->current_alist_element;
918 mark_symbol_value_lisp_magic (Lisp_Object obj,
919 void (*markobj) (Lisp_Object))
921 struct symbol_value_lisp_magic *bfwd;
924 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
926 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
927 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
929 markobj (bfwd->handler[i]);
930 markobj (bfwd->harg[i]);
932 return bfwd->shadowed;
936 mark_symbol_value_varalias (Lisp_Object obj,
937 void (*markobj) (Lisp_Object))
939 struct symbol_value_varalias *bfwd;
941 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
943 bfwd = XSYMBOL_VALUE_VARALIAS (obj);
944 markobj (bfwd->shadowed);
945 return bfwd->aliasee;
948 /* Should never, ever be called. (except by an external debugger) */
950 print_symbol_value_magic (Lisp_Object obj,
951 Lisp_Object printcharfun, int escapeflag)
954 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s type %d) 0x%lx>",
955 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
956 XSYMBOL_VALUE_MAGIC_TYPE (obj),
958 write_c_string (buf, printcharfun);
961 static const struct lrecord_description symbol_value_buffer_local_description[] = {
962 { XD_LISP_OBJECT, offsetof(struct symbol_value_buffer_local, default_value), 4 },
966 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
967 { XD_LISP_OBJECT, offsetof(struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 },
971 static const struct lrecord_description symbol_value_varalias_description[] = {
972 { XD_LISP_OBJECT, offsetof(struct symbol_value_varalias, aliasee), 2 },
976 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
977 symbol_value_forward,
978 this_one_is_unmarkable,
979 print_symbol_value_magic, 0, 0, 0, 0,
980 struct symbol_value_forward);
982 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
983 symbol_value_buffer_local,
984 mark_symbol_value_buffer_local,
985 print_symbol_value_magic, 0, 0, 0,
986 symbol_value_buffer_local_description,
987 struct symbol_value_buffer_local);
989 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
990 symbol_value_lisp_magic,
991 mark_symbol_value_lisp_magic,
992 print_symbol_value_magic, 0, 0, 0,
993 symbol_value_lisp_magic_description,
994 struct symbol_value_lisp_magic);
996 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
997 symbol_value_varalias,
998 mark_symbol_value_varalias,
999 print_symbol_value_magic, 0, 0, 0,
1000 symbol_value_varalias_description,
1001 struct symbol_value_varalias);
1004 /* Getting and setting values of symbols */
1006 /* Given the raw contents of a symbol value cell, return the Lisp value of
1007 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
1008 symbol-value-lisp-magic, or symbol-value-varalias.
1010 BUFFER specifies a buffer, and is used for built-in buffer-local
1011 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
1012 Note that such variables are never encapsulated in a
1013 symbol-value-buffer-local structure.
1015 CONSOLE specifies a console, and is used for built-in console-local
1016 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
1017 Note that such variables are (currently) never encapsulated in a
1018 symbol-value-buffer-local structure.
1022 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
1023 struct console *console)
1025 CONST struct symbol_value_forward *fwd;
1027 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1030 fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1031 switch (fwd->magic.type)
1033 case SYMVAL_FIXNUM_FORWARD:
1034 case SYMVAL_CONST_FIXNUM_FORWARD:
1035 return make_int (*((int *)symbol_value_forward_forward (fwd)));
1037 case SYMVAL_BOOLEAN_FORWARD:
1038 case SYMVAL_CONST_BOOLEAN_FORWARD:
1039 return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
1041 case SYMVAL_OBJECT_FORWARD:
1042 case SYMVAL_CONST_OBJECT_FORWARD:
1043 case SYMVAL_CONST_SPECIFIER_FORWARD:
1044 return *((Lisp_Object *)symbol_value_forward_forward (fwd));
1046 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1047 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1048 + ((char *)symbol_value_forward_forward (fwd)
1049 - (char *)&buffer_local_flags))));
1052 case SYMVAL_CURRENT_BUFFER_FORWARD:
1053 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1055 return (*((Lisp_Object *)((char *)buffer
1056 + ((char *)symbol_value_forward_forward (fwd)
1057 - (char *)&buffer_local_flags))));
1059 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1060 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1061 + ((char *)symbol_value_forward_forward (fwd)
1062 - (char *)&console_local_flags))));
1064 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1065 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1067 return (*((Lisp_Object *)((char *)console
1068 + ((char *)symbol_value_forward_forward (fwd)
1069 - (char *)&console_local_flags))));
1071 case SYMVAL_UNBOUND_MARKER:
1077 return Qnil; /* suppress compiler warning */
1080 /* Set the value of default-buffer-local variable SYM to VALUE. */
1083 set_default_buffer_slot_variable (Lisp_Object sym,
1086 /* Handle variables like case-fold-search that have special slots in
1087 the buffer. Make them work apparently like buffer_local variables.
1089 /* At this point, the value cell may not contain a symbol-value-varalias
1090 or symbol-value-buffer-local, and if there's a handler, we should
1091 have already called it. */
1092 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1093 CONST struct symbol_value_forward *fwd
1094 = XSYMBOL_VALUE_FORWARD (valcontents);
1095 int offset = ((char *) symbol_value_forward_forward (fwd)
1096 - (char *) &buffer_local_flags);
1097 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1098 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1099 int flags) = symbol_value_forward_magicfun (fwd);
1101 *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
1104 if (mask > 0) /* Not always per-buffer */
1108 /* Set value in each buffer which hasn't shadowed the default */
1109 LIST_LOOP_2 (elt, Vbuffer_alist)
1111 struct buffer *b = XBUFFER (XCDR (elt));
1112 if (!(b->local_var_flags & mask))
1115 magicfun (sym, &value, make_buffer (b), 0);
1116 *((Lisp_Object *) (offset + (char *) b)) = value;
1122 /* Set the value of default-console-local variable SYM to VALUE. */
1125 set_default_console_slot_variable (Lisp_Object sym,
1128 /* Handle variables like case-fold-search that have special slots in
1129 the console. Make them work apparently like console_local variables.
1131 /* At this point, the value cell may not contain a symbol-value-varalias
1132 or symbol-value-buffer-local, and if there's a handler, we should
1133 have already called it. */
1134 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1135 CONST struct symbol_value_forward *fwd
1136 = XSYMBOL_VALUE_FORWARD (valcontents);
1137 int offset = ((char *) symbol_value_forward_forward (fwd)
1138 - (char *) &console_local_flags);
1139 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1140 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1141 int flags) = symbol_value_forward_magicfun (fwd);
1143 *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
1146 if (mask > 0) /* Not always per-console */
1148 Lisp_Object console;
1150 /* Set value in each console which hasn't shadowed the default */
1151 LIST_LOOP_2 (console, Vconsole_list)
1153 struct console *d = XCONSOLE (console);
1154 if (!(d->local_var_flags & mask))
1157 magicfun (sym, &value, console, 0);
1158 *((Lisp_Object *) (offset + (char *) d)) = value;
1164 /* Store NEWVAL into SYM.
1166 SYM's value slot may *not* be types (5) or (6) above,
1167 i.e. no symbol-value-varalias objects. (You should have
1168 forwarded past all of these.)
1170 SYM should not be an unsettable symbol or a symbol with
1171 a magic `set-value' handler (unless you want to explicitly
1172 ignore this handler).
1174 OVALUE is the current value of SYM, but forwarded past any
1175 symbol-value-buffer-local and symbol-value-lisp-magic objects.
1176 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1177 the contents of its current-value cell.) NEWVAL may only be
1178 a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
1179 this function will only modify its current-value cell, which should
1180 already be set up to point to the current buffer.
1184 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
1187 if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
1189 Lisp_Object *store_pointer = value_slot_past_magic (sym);
1191 if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
1193 &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
1195 assert (UNBOUNDP (*store_pointer)
1196 || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1197 *store_pointer = newval;
1201 CONST struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue);
1202 int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
1203 Lisp_Object in_object, int flags)
1204 = symbol_value_forward_magicfun (fwd);
1206 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue))
1208 case SYMVAL_FIXNUM_FORWARD:
1211 magicfun (sym, &newval, Qnil, 0);
1212 *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
1215 case SYMVAL_BOOLEAN_FORWARD:
1217 magicfun (sym, &newval, Qnil, 0);
1218 *((int *) symbol_value_forward_forward (fwd))
1219 = ((NILP (newval)) ? 0 : 1);
1222 case SYMVAL_OBJECT_FORWARD:
1224 magicfun (sym, &newval, Qnil, 0);
1225 *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
1228 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1229 set_default_buffer_slot_variable (sym, newval);
1232 case SYMVAL_CURRENT_BUFFER_FORWARD:
1234 magicfun (sym, &newval, make_buffer (current_buffer), 0);
1235 *((Lisp_Object *) ((char *) current_buffer
1236 + ((char *) symbol_value_forward_forward (fwd)
1237 - (char *) &buffer_local_flags)))
1241 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1242 set_default_console_slot_variable (sym, newval);
1245 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1247 magicfun (sym, &newval, Vselected_console, 0);
1248 *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console)
1249 + ((char *) symbol_value_forward_forward (fwd)
1250 - (char *) &console_local_flags)))
1260 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1261 BFWD, locate and return a pointer to the element in BUFFER's
1262 local_var_alist for SYMBOL. The return value will be Qnil if
1263 BUFFER does not have its own value for SYMBOL (i.e. the default
1264 value is seen in that buffer).
1268 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
1269 struct symbol_value_buffer_local *bfwd)
1271 if (!NILP (bfwd->current_buffer) &&
1272 XBUFFER (bfwd->current_buffer) == buffer)
1273 /* This is just an optimization of the below. */
1274 return bfwd->current_alist_element;
1276 return assq_no_quit (symbol, buffer->local_var_alist);
1279 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1280 symbol-value-buffer-local of a per-buffer variable -- i.e. the
1281 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1282 slot -- may be out of date.]
1284 Write out any cached value in buffer-local variable SYMBOL's
1285 buffer-local structure, which is passed in as BFWD.
1289 write_out_buffer_local_cache (Lisp_Object symbol,
1290 struct symbol_value_buffer_local *bfwd)
1292 if (!NILP (bfwd->current_buffer))
1294 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1295 uses it, and that type cannot be inside a symbol-value-buffer-local */
1296 Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0);
1297 if (NILP (bfwd->current_alist_element))
1298 /* current_value may be updated more recently than default_value */
1299 bfwd->default_value = cval;
1301 Fsetcdr (bfwd->current_alist_element, cval);
1305 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1306 Set up BFWD's cache for validity in buffer BUF. This assumes that
1307 the cache is currently in a consistent state (this can include
1308 not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1310 If the cache is already set up for BUF, this function does nothing
1313 Otherwise, if SYM forwards out to a C variable, this also forwards
1314 SYM's value in BUF out to the variable. Therefore, you generally
1315 only want to call this when BUF is, or is about to become, the
1318 (Otherwise, you can just retrieve the value without changing the
1319 cache, at the expense of slower retrieval.)
1323 set_up_buffer_local_cache (Lisp_Object sym,
1324 struct symbol_value_buffer_local *bfwd,
1326 Lisp_Object new_alist_el,
1329 Lisp_Object new_val;
1331 if (!NILP (bfwd->current_buffer)
1332 && buf == XBUFFER (bfwd->current_buffer))
1333 /* Cache is already set up. */
1336 /* Flush out the old cache. */
1337 write_out_buffer_local_cache (sym, bfwd);
1339 /* Retrieve the new alist element and new value. */
1340 if (NILP (new_alist_el)
1342 new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1344 if (NILP (new_alist_el))
1345 new_val = bfwd->default_value;
1347 new_val = Fcdr (new_alist_el);
1349 bfwd->current_alist_element = new_alist_el;
1350 XSETBUFFER (bfwd->current_buffer, buf);
1352 /* Now store the value into the current-value slot.
1353 We don't simply write it there, because the current-value
1354 slot might be a forwarding pointer, in which case we need
1355 to instead write the value into the C variable.
1357 We might also want to call a magic function.
1359 So instead, we call this function. */
1360 store_symval_forwarding (sym, bfwd->current_value, new_val);
1365 kill_buffer_local_variables (struct buffer *buf)
1367 Lisp_Object prev = Qnil;
1370 /* Any which are supposed to be permanent,
1371 make local again, with the same values they had. */
1373 for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
1375 Lisp_Object sym = XCAR (XCAR (alist));
1376 struct symbol_value_buffer_local *bfwd;
1377 /* Variables with a symbol-value-varalias should not be here
1378 (we should have forwarded past them) and there must be a
1379 symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
1380 just forward past it; if the variable has a handler, it was
1382 Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
1384 assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
1385 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
1387 if (!NILP (Fget (sym, Qpermanent_local, Qnil)))
1388 /* prev points to the last alist element that is still
1389 staying around, so *only* update it now. This didn't
1390 used to be the case; this bug has been around since
1391 mly's rewrite two years ago! */
1395 /* Really truly kill it. */
1397 XCDR (prev) = XCDR (alist);
1399 buf->local_var_alist = XCDR (alist);
1401 /* We just effectively changed the value for this variable
1404 /* (1) If the cache is caching BUF, invalidate the cache. */
1405 if (!NILP (bfwd->current_buffer) &&
1406 buf == XBUFFER (bfwd->current_buffer))
1407 bfwd->current_buffer = Qnil;
1409 /* (2) If we changed the value in current_buffer and this
1410 variable forwards to a C variable, we need to change the
1411 value of the C variable. set_up_buffer_local_cache()
1412 will do this. It doesn't hurt to do it whenever
1413 BUF == current_buffer, so just go ahead and do that. */
1414 if (buf == current_buffer)
1415 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
1421 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1422 struct console *con, int swap_it_in,
1423 Lisp_Object symcons, int set_it_p)
1425 Lisp_Object valcontents;
1428 valcontents = XSYMBOL (sym)->value;
1431 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1434 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1436 case SYMVAL_LISP_MAGIC:
1438 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1442 case SYMVAL_VARALIAS:
1443 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1445 /* presto change-o! */
1448 case SYMVAL_BUFFER_LOCAL:
1449 case SYMVAL_SOME_BUFFER_LOCAL:
1451 struct symbol_value_buffer_local *bfwd
1452 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1456 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1457 valcontents = bfwd->current_value;
1461 if (!NILP (bfwd->current_buffer) &&
1462 buf == XBUFFER (bfwd->current_buffer))
1463 valcontents = bfwd->current_value;
1464 else if (NILP (symcons))
1467 valcontents = assq_no_quit (sym, buf->local_var_alist);
1468 if (NILP (valcontents))
1469 valcontents = bfwd->default_value;
1471 valcontents = XCDR (valcontents);
1474 valcontents = XCDR (symcons);
1482 return do_symval_forwarding (valcontents, buf, con);
1486 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1487 bound. Note that it must not be possible to QUIT within this
1491 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
1498 buf = current_buffer;
1501 CHECK_BUFFER (buffer);
1502 buf = XBUFFER (buffer);
1505 return find_symbol_value_1 (sym, buf,
1506 /* If it bombs out at startup due to a
1507 Lisp error, this may be nil. */
1508 CONSOLEP (Vselected_console)
1509 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
1513 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1518 console = Vselected_console;
1520 CHECK_CONSOLE (console);
1522 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1526 /* Return the current value of SYM. The difference between this function
1527 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1528 this updates the CURRENT_VALUE slot of buffer-local variables to
1529 point to the current buffer, while symbol_value_in_buffer doesn't. */
1532 find_symbol_value (Lisp_Object sym)
1534 /* WARNING: This function can be called when current_buffer is 0
1535 and Vselected_console is Qnil, early in initialization. */
1536 struct console *con;
1537 Lisp_Object valcontents;
1541 valcontents = XSYMBOL (sym)->value;
1542 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1545 if (CONSOLEP (Vselected_console))
1546 con = XCONSOLE (Vselected_console);
1549 /* This can also get called while we're preparing to shutdown.
1550 #### What should really happen in that case? Should we
1551 actually fix things so we can't get here in that case? */
1552 assert (!initialized || preparing_for_armageddon);
1556 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
1559 /* This is an optimized function for quick lookup of buffer local symbols
1560 by avoiding O(n) search. This will work when either:
1561 a) We have already found the symbol e.g. by traversing local_var_alist.
1563 b) We know that the symbol will not be found in the current buffer's
1564 list of local variables.
1565 In the former case, find_it_p is 1 and symbol_cons is the element from
1566 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1569 This function is called from set_buffer_internal which does both of these
1573 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1575 /* WARNING: This function can be called when current_buffer is 0
1576 and Vselected_console is Qnil, early in initialization. */
1577 struct console *con;
1578 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1581 if (CONSOLEP (Vselected_console))
1582 con = XCONSOLE (Vselected_console);
1585 /* This can also get called while we're preparing to shutdown.
1586 #### What should really happen in that case? Should we
1587 actually fix things so we can't get here in that case? */
1588 assert (!initialized || preparing_for_armageddon);
1592 return find_symbol_value_1 (sym, current_buffer, con, 1,
1593 find_it_p ? symbol_cons : Qnil,
1597 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1598 Return SYMBOL's value. Error if that is void.
1602 Lisp_Object val = find_symbol_value (symbol);
1605 return Fsignal (Qvoid_variable, list1 (symbol));
1610 DEFUN ("set", Fset, 2, 2, 0, /*
1611 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1615 REGISTER Lisp_Object valcontents;
1616 struct Lisp_Symbol *sym;
1617 /* remember, we're called by Fmakunbound() as well */
1619 CHECK_SYMBOL (symbol);
1622 sym = XSYMBOL (symbol);
1623 valcontents = sym->value;
1625 if (EQ (symbol, Qnil) ||
1627 SYMBOL_IS_KEYWORD (symbol))
1628 reject_constant_symbols (symbol, newval, 0,
1629 UNBOUNDP (newval) ? Qmakunbound : Qset);
1631 if (!SYMBOL_VALUE_MAGIC_P (valcontents) || UNBOUNDP (valcontents))
1633 sym->value = newval;
1637 reject_constant_symbols (symbol, newval, 0,
1638 UNBOUNDP (newval) ? Qmakunbound : Qset);
1642 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1644 case SYMVAL_LISP_MAGIC:
1648 if (UNBOUNDP (newval))
1649 retval = maybe_call_magic_handler (symbol, Qmakunbound, 0);
1651 retval = maybe_call_magic_handler (symbol, Qset, 1, newval);
1652 if (!UNBOUNDP (retval))
1654 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1659 case SYMVAL_VARALIAS:
1660 symbol = follow_varalias_pointers (symbol,
1662 ? Qmakunbound : Qset);
1663 /* presto change-o! */
1666 case SYMVAL_FIXNUM_FORWARD:
1667 case SYMVAL_BOOLEAN_FORWARD:
1668 case SYMVAL_OBJECT_FORWARD:
1669 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1670 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1671 if (UNBOUNDP (newval))
1672 signal_error (Qerror,
1673 list2 (build_string ("Cannot makunbound"), symbol));
1676 /* case SYMVAL_UNBOUND_MARKER: break; */
1678 case SYMVAL_CURRENT_BUFFER_FORWARD:
1680 CONST struct symbol_value_forward *fwd
1681 = XSYMBOL_VALUE_FORWARD (valcontents);
1682 int mask = XINT (*((Lisp_Object *)
1683 symbol_value_forward_forward (fwd)));
1685 /* Setting this variable makes it buffer-local */
1686 current_buffer->local_var_flags |= mask;
1690 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1692 CONST struct symbol_value_forward *fwd
1693 = XSYMBOL_VALUE_FORWARD (valcontents);
1694 int mask = XINT (*((Lisp_Object *)
1695 symbol_value_forward_forward (fwd)));
1697 /* Setting this variable makes it console-local */
1698 XCONSOLE (Vselected_console)->local_var_flags |= mask;
1702 case SYMVAL_BUFFER_LOCAL:
1703 case SYMVAL_SOME_BUFFER_LOCAL:
1705 /* If we want to examine or set the value and
1706 CURRENT-BUFFER is current, we just examine or set
1707 CURRENT-VALUE. If CURRENT-BUFFER is not current, we
1708 store the current CURRENT-VALUE value into
1709 CURRENT-ALIST- ELEMENT, then find the appropriate alist
1710 element for the buffer now current and set up
1711 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
1712 of that element, and store into CURRENT-BUFFER.
1714 If we are setting the variable and the current buffer does
1715 not have an alist entry for this variable, an alist entry is
1718 Note that CURRENT-VALUE can be a forwarding pointer.
1719 Each time it is examined or set, forwarding must be
1721 struct symbol_value_buffer_local *bfwd
1722 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1723 int some_buffer_local_p =
1724 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
1725 /* What value are we caching right now? */
1726 Lisp_Object aelt = bfwd->current_alist_element;
1728 if (!NILP (bfwd->current_buffer) &&
1729 current_buffer == XBUFFER (bfwd->current_buffer)
1730 && ((some_buffer_local_p)
1731 ? 1 /* doesn't automatically become local */
1732 : !NILP (aelt) /* already local */
1735 /* Cache is valid */
1736 valcontents = bfwd->current_value;
1740 /* If the current buffer is not the buffer whose binding is
1741 currently cached, or if it's a SYMVAL_BUFFER_LOCAL and
1742 we're looking at the default value, the cache is invalid; we
1743 need to write it out, and find the new CURRENT-ALIST-ELEMENT
1746 /* Write out the cached value for the old buffer; copy it
1747 back to its alist element. This works if the current
1748 buffer only sees the default value, too. */
1749 write_out_buffer_local_cache (symbol, bfwd);
1751 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1752 aelt = buffer_local_alist_element (current_buffer, symbol, bfwd);
1755 /* This buffer is still seeing the default value. */
1756 if (!some_buffer_local_p)
1758 /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a
1759 new assoc for a local value and set
1760 CURRENT-ALIST-ELEMENT to point to that. */
1762 do_symval_forwarding (bfwd->current_value,
1764 XCONSOLE (Vselected_console));
1765 aelt = Fcons (symbol, aelt);
1766 current_buffer->local_var_alist
1767 = Fcons (aelt, current_buffer->local_var_alist);
1771 /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
1772 we're currently seeing the default value. */
1776 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1777 bfwd->current_alist_element = aelt;
1778 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
1779 XSETBUFFER (bfwd->current_buffer, current_buffer);
1780 valcontents = bfwd->current_value;
1787 store_symval_forwarding (symbol, valcontents, newval);
1793 /* Access or set a buffer-local symbol's default value. */
1795 /* Return the default value of SYM, but don't check for voidness.
1796 Return Qunbound if it is void. */
1799 default_value (Lisp_Object sym)
1801 Lisp_Object valcontents;
1806 valcontents = XSYMBOL (sym)->value;
1809 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1812 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1814 case SYMVAL_LISP_MAGIC:
1816 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1820 case SYMVAL_VARALIAS:
1821 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1822 /* presto change-o! */
1825 case SYMVAL_UNBOUND_MARKER:
1828 case SYMVAL_CURRENT_BUFFER_FORWARD:
1830 CONST struct symbol_value_forward *fwd
1831 = XSYMBOL_VALUE_FORWARD (valcontents);
1832 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1833 + ((char *)symbol_value_forward_forward (fwd)
1834 - (char *)&buffer_local_flags))));
1837 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1839 CONST struct symbol_value_forward *fwd
1840 = XSYMBOL_VALUE_FORWARD (valcontents);
1841 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1842 + ((char *)symbol_value_forward_forward (fwd)
1843 - (char *)&console_local_flags))));
1846 case SYMVAL_BUFFER_LOCAL:
1847 case SYMVAL_SOME_BUFFER_LOCAL:
1849 struct symbol_value_buffer_local *bfwd =
1850 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1852 /* Handle user-created local variables. */
1853 /* If var is set up for a buffer that lacks a local value for it,
1854 the current value is nominally the default value.
1855 But the current value slot may be more up to date, since
1856 ordinary setq stores just that slot. So use that. */
1857 if (NILP (bfwd->current_alist_element))
1858 return do_symval_forwarding (bfwd->current_value, current_buffer,
1859 XCONSOLE (Vselected_console));
1861 return bfwd->default_value;
1864 /* For other variables, get the current value. */
1865 return do_symval_forwarding (valcontents, current_buffer,
1866 XCONSOLE (Vselected_console));
1869 RETURN_NOT_REACHED (Qnil) /* suppress compiler warning */
1872 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /*
1873 Return t if SYMBOL has a non-void default value.
1874 This is the value that is seen in buffers that do not have their own values
1879 return UNBOUNDP (default_value (symbol)) ? Qnil : Qt;
1882 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /*
1883 Return SYMBOL's default value.
1884 This is the value that is seen in buffers that do not have their own values
1885 for this variable. The default value is meaningful for variables with
1886 local bindings in certain buffers.
1890 Lisp_Object value = default_value (symbol);
1892 return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (symbol)) : value;
1895 DEFUN ("set-default", Fset_default, 2, 2, 0, /*
1896 Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.
1897 The default value is seen in buffers that do not have their own values
1902 Lisp_Object valcontents;
1904 CHECK_SYMBOL (symbol);
1907 valcontents = XSYMBOL (symbol)->value;
1910 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1911 return Fset (symbol, value);
1913 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1915 case SYMVAL_LISP_MAGIC:
1916 RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (symbol, Qset_default, 1,
1918 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1922 case SYMVAL_VARALIAS:
1923 symbol = follow_varalias_pointers (symbol, Qset_default);
1924 /* presto change-o! */
1927 case SYMVAL_CURRENT_BUFFER_FORWARD:
1928 set_default_buffer_slot_variable (symbol, value);
1931 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1932 set_default_console_slot_variable (symbol, value);
1935 case SYMVAL_BUFFER_LOCAL:
1936 case SYMVAL_SOME_BUFFER_LOCAL:
1938 /* Store new value into the DEFAULT-VALUE slot */
1939 struct symbol_value_buffer_local *bfwd
1940 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1942 bfwd->default_value = value;
1943 /* If current-buffer doesn't shadow default_value,
1944 * we must set the CURRENT-VALUE slot too */
1945 if (NILP (bfwd->current_alist_element))
1946 store_symval_forwarding (symbol, bfwd->current_value, value);
1951 return Fset (symbol, value);
1955 DEFUN ("setq-default", Fsetq_default, 0, UNEVALLED, 0, /*
1956 Set the default value of variable SYMBOL to VALUE.
1957 SYMBOL, the variable name, is literal (not evaluated);
1958 VALUE is an expression and it is evaluated.
1959 The default value of a variable is seen in buffers
1960 that do not have their own values for the variable.
1962 More generally, you can use multiple variables and values, as in
1963 (setq-default SYMBOL VALUE SYMBOL VALUE...)
1964 This sets each SYMBOL's default value to the corresponding VALUE.
1965 The VALUE for the Nth SYMBOL can refer to the new default values
1966 of previous SYMBOLs.
1970 /* This function can GC */
1971 Lisp_Object symbol, tail, val = Qnil;
1973 struct gcpro gcpro1;
1975 GET_LIST_LENGTH (args, nargs);
1977 if (nargs & 1) /* Odd number of arguments? */
1978 Fsignal (Qwrong_number_of_arguments,
1979 list2 (Qsetq_default, make_int (nargs)));
1983 PROPERTY_LIST_LOOP (tail, symbol, val, args)
1986 Fset_default (symbol, val);
1993 /* Lisp functions for creating and removing buffer-local variables. */
1995 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1,
1996 "vMake Variable Buffer Local: ", /*
1997 Make VARIABLE have a separate value for each buffer.
1998 At any time, the value for the current buffer is in effect.
1999 There is also a default value which is seen in any buffer which has not yet
2001 Using `set' or `setq' to set the variable causes it to have a separate value
2002 for the current buffer if it was previously using the default value.
2003 The function `default-value' gets the default value and `set-default'
2008 Lisp_Object valcontents;
2010 CHECK_SYMBOL (variable);
2013 verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
2015 valcontents = XSYMBOL (variable)->value;
2018 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2020 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2022 case SYMVAL_LISP_MAGIC:
2023 if (!UNBOUNDP (maybe_call_magic_handler
2024 (variable, Qmake_variable_buffer_local, 0)))
2026 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2030 case SYMVAL_VARALIAS:
2031 variable = follow_varalias_pointers (variable,
2032 Qmake_variable_buffer_local);
2033 /* presto change-o! */
2036 case SYMVAL_FIXNUM_FORWARD:
2037 case SYMVAL_BOOLEAN_FORWARD:
2038 case SYMVAL_OBJECT_FORWARD:
2039 case SYMVAL_UNBOUND_MARKER:
2042 case SYMVAL_CURRENT_BUFFER_FORWARD:
2043 case SYMVAL_BUFFER_LOCAL:
2044 /* Already per-each-buffer */
2047 case SYMVAL_SOME_BUFFER_LOCAL:
2049 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
2050 SYMVAL_BUFFER_LOCAL;
2059 struct symbol_value_buffer_local *bfwd
2060 = alloc_lcrecord_type (struct symbol_value_buffer_local,
2061 &lrecord_symbol_value_buffer_local);
2063 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2065 bfwd->default_value = find_symbol_value (variable);
2066 bfwd->current_value = valcontents;
2067 bfwd->current_alist_element = Qnil;
2068 bfwd->current_buffer = Fcurrent_buffer ();
2069 XSETSYMBOL_VALUE_MAGIC (foo, bfwd);
2070 *value_slot_past_magic (variable) = foo;
2071 #if 1 /* #### Yuck! FSFmacs bug-compatibility*/
2072 /* This sets the default-value of any make-variable-buffer-local to nil.
2073 That just sucks. User can just use setq-default to effect that,
2074 but there's no way to do makunbound-default to undo this lossage. */
2075 if (UNBOUNDP (valcontents))
2076 bfwd->default_value = Qnil;
2078 #if 0 /* #### Yuck! */
2079 /* This sets the value to nil in this buffer.
2080 User could use (setq variable nil) to do this.
2081 It isn't as egregious to do this automatically
2082 as it is to do so to the default-value, but it's
2083 still really dubious. */
2084 if (UNBOUNDP (valcontents))
2085 Fset (variable, Qnil);
2091 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1,
2092 "vMake Local Variable: ", /*
2093 Make VARIABLE have a separate value in the current buffer.
2094 Other buffers will continue to share a common default value.
2095 \(The buffer-local value of VARIABLE starts out as the same value
2096 VARIABLE previously had. If VARIABLE was void, it remains void.)
2097 See also `make-variable-buffer-local'.
2099 If the variable is already arranged to become local when set,
2100 this function causes a local value to exist for this buffer,
2101 just as setting the variable would do.
2103 Do not use `make-local-variable' to make a hook variable buffer-local.
2104 Use `make-local-hook' instead.
2108 Lisp_Object valcontents;
2109 struct symbol_value_buffer_local *bfwd;
2111 CHECK_SYMBOL (variable);
2114 verify_ok_for_buffer_local (variable, Qmake_local_variable);
2116 valcontents = XSYMBOL (variable)->value;
2119 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2121 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2123 case SYMVAL_LISP_MAGIC:
2124 if (!UNBOUNDP (maybe_call_magic_handler
2125 (variable, Qmake_local_variable, 0)))
2127 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2131 case SYMVAL_VARALIAS:
2132 variable = follow_varalias_pointers (variable, Qmake_local_variable);
2133 /* presto change-o! */
2136 case SYMVAL_FIXNUM_FORWARD:
2137 case SYMVAL_BOOLEAN_FORWARD:
2138 case SYMVAL_OBJECT_FORWARD:
2139 case SYMVAL_UNBOUND_MARKER:
2142 case SYMVAL_BUFFER_LOCAL:
2143 case SYMVAL_CURRENT_BUFFER_FORWARD:
2145 /* Make sure the symbol has a local value in this particular
2146 buffer, by setting it to the same value it already has. */
2147 Fset (variable, find_symbol_value (variable));
2151 case SYMVAL_SOME_BUFFER_LOCAL:
2153 if (!NILP (buffer_local_alist_element (current_buffer,
2155 (XSYMBOL_VALUE_BUFFER_LOCAL
2157 goto already_local_to_current_buffer;
2159 goto already_local_to_some_other_buffer;
2167 /* Make sure variable is set up to hold per-buffer values */
2168 bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
2169 &lrecord_symbol_value_buffer_local);
2170 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2172 bfwd->current_buffer = Qnil;
2173 bfwd->current_alist_element = Qnil;
2174 bfwd->current_value = valcontents;
2175 /* passing 0 is OK because this should never be a
2176 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2178 bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
2181 if (UNBOUNDP (bfwd->default_value))
2182 bfwd->default_value = Qnil; /* Yuck! */
2185 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
2186 *value_slot_past_magic (variable) = valcontents;
2188 already_local_to_some_other_buffer:
2190 /* Make sure this buffer has its own value of variable */
2191 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2193 if (UNBOUNDP (bfwd->default_value))
2195 /* If default value is unbound, set local value to nil. */
2196 XSETBUFFER (bfwd->current_buffer, current_buffer);
2197 bfwd->current_alist_element = Fcons (variable, Qnil);
2198 current_buffer->local_var_alist =
2199 Fcons (bfwd->current_alist_element, current_buffer->local_var_alist);
2200 store_symval_forwarding (variable, bfwd->current_value, Qnil);
2204 current_buffer->local_var_alist
2205 = Fcons (Fcons (variable, bfwd->default_value),
2206 current_buffer->local_var_alist);
2208 /* Make sure symbol does not think it is set up for this buffer;
2209 force it to look once again for this buffer's value */
2210 if (!NILP (bfwd->current_buffer) &&
2211 current_buffer == XBUFFER (bfwd->current_buffer))
2212 bfwd->current_buffer = Qnil;
2214 already_local_to_current_buffer:
2216 /* If the symbol forwards into a C variable, then swap in the
2217 variable for this buffer immediately. If C code modifies the
2218 variable before we swap in, then that new value will clobber the
2219 default value the next time we swap. */
2220 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2221 if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value))
2223 switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
2225 case SYMVAL_FIXNUM_FORWARD:
2226 case SYMVAL_BOOLEAN_FORWARD:
2227 case SYMVAL_OBJECT_FORWARD:
2228 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2229 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2232 case SYMVAL_UNBOUND_MARKER:
2233 case SYMVAL_CURRENT_BUFFER_FORWARD:
2244 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1,
2245 "vKill Local Variable: ", /*
2246 Make VARIABLE no longer have a separate value in the current buffer.
2247 From now on the default value will apply in this buffer.
2251 Lisp_Object valcontents;
2253 CHECK_SYMBOL (variable);
2256 valcontents = XSYMBOL (variable)->value;
2259 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2262 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2264 case SYMVAL_LISP_MAGIC:
2265 if (!UNBOUNDP (maybe_call_magic_handler
2266 (variable, Qkill_local_variable, 0)))
2268 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2272 case SYMVAL_VARALIAS:
2273 variable = follow_varalias_pointers (variable, Qkill_local_variable);
2274 /* presto change-o! */
2277 case SYMVAL_CURRENT_BUFFER_FORWARD:
2279 CONST struct symbol_value_forward *fwd
2280 = XSYMBOL_VALUE_FORWARD (valcontents);
2281 int offset = ((char *) symbol_value_forward_forward (fwd)
2282 - (char *) &buffer_local_flags);
2284 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2288 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2289 Lisp_Object in_object, int flags) =
2290 symbol_value_forward_magicfun (fwd);
2291 Lisp_Object oldval = * (Lisp_Object *)
2292 (offset + (char *) XBUFFER (Vbuffer_defaults));
2294 (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
2295 *(Lisp_Object *) (offset + (char *) current_buffer)
2297 current_buffer->local_var_flags &= ~mask;
2302 case SYMVAL_BUFFER_LOCAL:
2303 case SYMVAL_SOME_BUFFER_LOCAL:
2305 /* Get rid of this buffer's alist element, if any */
2306 struct symbol_value_buffer_local *bfwd
2307 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2308 Lisp_Object alist = current_buffer->local_var_alist;
2309 Lisp_Object alist_element
2310 = buffer_local_alist_element (current_buffer, variable, bfwd);
2312 if (!NILP (alist_element))
2313 current_buffer->local_var_alist = Fdelq (alist_element, alist);
2315 /* Make sure symbol does not think it is set up for this buffer;
2316 force it to look once again for this buffer's value */
2317 if (!NILP (bfwd->current_buffer) &&
2318 current_buffer == XBUFFER (bfwd->current_buffer))
2319 bfwd->current_buffer = Qnil;
2321 /* We just changed the value in the current_buffer. If this
2322 variable forwards to a C variable, we need to change the
2323 value of the C variable. set_up_buffer_local_cache()
2324 will do this. It doesn't hurt to do it always,
2325 so just go ahead and do that. */
2326 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2333 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2337 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2338 "vKill Console Local Variable: ", /*
2339 Make VARIABLE no longer have a separate value in the selected console.
2340 From now on the default value will apply in this console.
2344 Lisp_Object valcontents;
2346 CHECK_SYMBOL (variable);
2349 valcontents = XSYMBOL (variable)->value;
2352 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2355 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2357 case SYMVAL_LISP_MAGIC:
2358 if (!UNBOUNDP (maybe_call_magic_handler
2359 (variable, Qkill_console_local_variable, 0)))
2361 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2365 case SYMVAL_VARALIAS:
2366 variable = follow_varalias_pointers (variable,
2367 Qkill_console_local_variable);
2368 /* presto change-o! */
2371 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2373 CONST struct symbol_value_forward *fwd
2374 = XSYMBOL_VALUE_FORWARD (valcontents);
2375 int offset = ((char *) symbol_value_forward_forward (fwd)
2376 - (char *) &console_local_flags);
2378 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2382 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2383 Lisp_Object in_object, int flags) =
2384 symbol_value_forward_magicfun (fwd);
2385 Lisp_Object oldval = * (Lisp_Object *)
2386 (offset + (char *) XCONSOLE (Vconsole_defaults));
2388 magicfun (variable, &oldval, Vselected_console, 0);
2389 *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
2391 XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
2401 /* Used by specbind to determine what effects it might have. Returns:
2402 * 0 if symbol isn't buffer-local, and wouldn't be after it is set
2403 * <0 if symbol isn't presently buffer-local, but set would make it so
2404 * >0 if symbol is presently buffer-local
2407 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
2409 Lisp_Object valcontents;
2412 valcontents = XSYMBOL (symbol)->value;
2415 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2417 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2419 case SYMVAL_LISP_MAGIC:
2421 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2425 case SYMVAL_VARALIAS:
2426 symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
2427 /* presto change-o! */
2430 case SYMVAL_CURRENT_BUFFER_FORWARD:
2432 CONST struct symbol_value_forward *fwd
2433 = XSYMBOL_VALUE_FORWARD (valcontents);
2434 int mask = XINT (*((Lisp_Object *)
2435 symbol_value_forward_forward (fwd)));
2436 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
2437 /* Already buffer-local */
2440 /* Would be buffer-local after set */
2443 case SYMVAL_BUFFER_LOCAL:
2444 case SYMVAL_SOME_BUFFER_LOCAL:
2446 struct symbol_value_buffer_local *bfwd
2447 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2449 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
2452 /* Automatically becomes local when set */
2453 return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
2463 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2464 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2466 (symbol, buffer, unbound_value))
2469 CHECK_SYMBOL (symbol);
2470 CHECK_BUFFER (buffer);
2471 value = symbol_value_in_buffer (symbol, buffer);
2472 return UNBOUNDP (value) ? unbound_value : value;
2475 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2476 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2478 (symbol, console, unbound_value))
2481 CHECK_SYMBOL (symbol);
2482 CHECK_CONSOLE (console);
2483 value = symbol_value_in_console (symbol, console);
2484 return UNBOUNDP (value) ? unbound_value : value;
2487 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
2488 If SYMBOL is a built-in variable, return info about this; else return nil.
2489 The returned info will be a symbol, one of
2491 `object' A simple built-in variable.
2492 `const-object' Same, but cannot be set.
2493 `integer' A built-in integer variable.
2494 `const-integer' Same, but cannot be set.
2495 `boolean' A built-in boolean variable.
2496 `const-boolean' Same, but cannot be set.
2497 `const-specifier' Always contains a specifier; e.g. `has-modeline-p'.
2498 `current-buffer' A built-in buffer-local variable.
2499 `const-current-buffer' Same, but cannot be set.
2500 `default-buffer' Forwards to the default value of a built-in
2501 buffer-local variable.
2502 `selected-console' A built-in console-local variable.
2503 `const-selected-console' Same, but cannot be set.
2504 `default-console' Forwards to the default value of a built-in
2505 console-local variable.
2509 REGISTER Lisp_Object valcontents;
2511 CHECK_SYMBOL (symbol);
2514 valcontents = XSYMBOL (symbol)->value;
2517 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2520 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2522 case SYMVAL_LISP_MAGIC:
2523 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2527 case SYMVAL_VARALIAS:
2528 symbol = follow_varalias_pointers (symbol, Qt);
2529 /* presto change-o! */
2532 case SYMVAL_BUFFER_LOCAL:
2533 case SYMVAL_SOME_BUFFER_LOCAL:
2535 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value;
2539 case SYMVAL_FIXNUM_FORWARD: return Qinteger;
2540 case SYMVAL_CONST_FIXNUM_FORWARD: return Qconst_integer;
2541 case SYMVAL_BOOLEAN_FORWARD: return Qboolean;
2542 case SYMVAL_CONST_BOOLEAN_FORWARD: return Qconst_boolean;
2543 case SYMVAL_OBJECT_FORWARD: return Qobject;
2544 case SYMVAL_CONST_OBJECT_FORWARD: return Qconst_object;
2545 case SYMVAL_CONST_SPECIFIER_FORWARD: return Qconst_specifier;
2546 case SYMVAL_DEFAULT_BUFFER_FORWARD: return Qdefault_buffer;
2547 case SYMVAL_CURRENT_BUFFER_FORWARD: return Qcurrent_buffer;
2548 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: return Qconst_current_buffer;
2549 case SYMVAL_DEFAULT_CONSOLE_FORWARD: return Qdefault_console;
2550 case SYMVAL_SELECTED_CONSOLE_FORWARD: return Qselected_console;
2551 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: return Qconst_selected_console;
2552 case SYMVAL_UNBOUND_MARKER: return Qnil;
2555 abort (); return Qnil;
2560 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
2561 Return t if SYMBOL's value is local to BUFFER.
2562 If optional third arg AFTER-SET is true, return t if SYMBOL would be
2563 buffer-local after it is set, regardless of whether it is so presently.
2564 A nil value for BUFFER is *not* the same as (current-buffer), but means
2565 "no buffer". Specifically:
2567 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
2568 the variable is one of the special built-in variables that is always
2569 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
2570 `buffer-undo-list', and others.)
2572 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
2573 the variable has had `make-variable-buffer-local' applied to it.
2575 (symbol, buffer, after_set))
2579 CHECK_SYMBOL (symbol);
2582 buffer = get_buffer (buffer, 1);
2583 local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
2587 local_info = symbol_value_buffer_local_info (symbol, 0);
2590 if (NILP (after_set))
2591 return local_info > 0 ? Qt : Qnil;
2593 return local_info != 0 ? Qt : Qnil;
2598 I've gone ahead and partially implemented this because it's
2599 super-useful for dealing with the compatibility problems in supporting
2600 the old pointer-shape variables, and preventing people from `setq'ing
2601 the new variables. Any other way of handling this problem is way
2602 ugly, likely to be slow, and generally not something I want to waste
2603 my time worrying about.
2605 The interface and/or function name is sure to change before this
2606 gets into its final form. I currently like the way everything is
2607 set up and it has all the features I want it to have, except for
2608 one: I really want to be able to have multiple nested handlers,
2609 to implement an `advice'-like capability. This would allow,
2610 for example, a clean way of implementing `debug-if-set' or
2611 `debug-if-referenced' and such.
2613 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
2614 ************************************************************
2615 **Only** the `set-value', `make-unbound', and `make-local'
2616 handler types are currently implemented. Implementing the
2617 get-value and bound-predicate handlers is somewhat tricky
2618 because there are lots of subfunctions (e.g. find_symbol_value()).
2619 find_symbol_value(), in fact, is called from outside of
2620 this module. You'd have to have it do this:
2622 -- check for a `bound-predicate' handler, call that if so;
2623 if it returns nil, return Qunbound
2624 -- check for a `get-value' handler and call it and return
2627 It gets even trickier when you have to deal with
2628 sub-subfunctions like find_symbol_value_1(), and esp.
2629 when you have to properly handle variable aliases, which
2630 can lead to lots of tricky situations. So I've just
2631 punted on this, since the interface isn't officially
2632 exported and we can get by with just a `set-value'
2635 Actions in unimplemented handler types will correctly
2636 ignore any handlers, and will not fuck anything up or
2639 WARNING WARNING: If you do go and implement another
2640 type of handler, make *sure* to change
2641 would_be_magic_handled() so it knows about this,
2642 or dire things could result.
2643 ************************************************************
2644 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
2646 Real documentation is as follows.
2648 Set a magic handler for VARIABLE.
2649 This allows you to specify arbitrary behavior that results from
2650 accessing or setting a variable. For example, retrieving the
2651 variable's value might actually retrieve the first element off of
2652 a list stored in another variable, and setting the variable's value
2653 might add an element to the front of that list. (This is how the
2654 obsolete variable `unread-command-event' is implemented.)
2656 In general it is NOT good programming practice to use magic variables
2657 in a new package that you are designing. If you feel the need to
2658 do this, it's almost certainly a sign that you should be using a
2659 function instead of a variable. This facility is provided to allow
2660 a package to support obsolete variables and provide compatibility
2661 with similar packages with different variable names and semantics.
2662 By using magic handlers, you can cleanly provide obsoleteness and
2663 compatibility support and separate this support from the core
2664 routines in a package.
2666 VARIABLE should be a symbol naming the variable for which the
2667 magic behavior is provided. HANDLER-TYPE is a symbol specifying
2668 which behavior is being controlled, and HANDLER is the function
2669 that will be called to control this behavior. HARG is a
2670 value that will be passed to HANDLER but is otherwise
2671 uninterpreted. KEEP-EXISTING specifies what to do with existing
2672 handlers of the same type; nil means "erase them all", t means
2673 "keep them but insert at the beginning", the list (t) means
2674 "keep them but insert at the end", a function means "keep
2675 them but insert before the specified function", a list containing
2676 a function means "keep them but insert after the specified
2679 You can specify magic behavior for any type of variable at all,
2680 and for any handler types that are unspecified, the standard
2681 behavior applies. This allows you, for example, to use
2682 `defvaralias' in conjunction with this function. (For that
2683 matter, `defvaralias' could be implemented using this function.)
2685 The behaviors that can be specified in HANDLER-TYPE are
2687 get-value (SYM ARGS FUN HARG HANDLERS)
2688 This means that one of the functions `symbol-value',
2689 `default-value', `symbol-value-in-buffer', or
2690 `symbol-value-in-console' was called on SYM.
2692 set-value (SYM ARGS FUN HARG HANDLERS)
2693 This means that one of the functions `set' or `set-default'
2696 bound-predicate (SYM ARGS FUN HARG HANDLERS)
2697 This means that one of the functions `boundp', `globally-boundp',
2698 or `default-boundp' was called on SYM.
2700 make-unbound (SYM ARGS FUN HARG HANDLERS)
2701 This means that the function `makunbound' was called on SYM.
2703 local-predicate (SYM ARGS FUN HARG HANDLERS)
2704 This means that the function `local-variable-p' was called
2707 make-local (SYM ARGS FUN HARG HANDLERS)
2708 This means that one of the functions `make-local-variable',
2709 `make-variable-buffer-local', `kill-local-variable',
2710 or `kill-console-local-variable' was called on SYM.
2712 The meanings of the arguments are as follows:
2714 SYM is the symbol on which the function was called, and is always
2715 the first argument to the function.
2717 ARGS are the remaining arguments in the original call (i.e. all
2718 but the first). In the case of `set-value' in particular,
2719 the first element of ARGS is the value to which the variable
2720 is being set. In some cases, ARGS is sanitized from what was
2721 actually given. For example, whenever `nil' is passed to an
2722 argument and it means `current-buffer', the current buffer is
2723 substituted instead.
2725 FUN is a symbol indicating which function is being called.
2726 For many of the functions, you can determine the corresponding
2727 function of a different class using
2728 `symbol-function-corresponding-function'.
2730 HARG is the argument that was given in the call
2731 to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
2733 HANDLERS is a structure containing the remaining handlers
2734 for the variable; to call one of them, use
2735 `chain-to-symbol-value-handler'.
2737 NOTE: You may *not* modify the list in ARGS, and if you want to
2738 keep it around after the handler function exits, you must make
2739 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
2742 static enum lisp_magic_handler
2743 decode_magic_handler_type (Lisp_Object symbol)
2745 if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE;
2746 if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE;
2747 if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE;
2748 if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND;
2749 if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE;
2750 if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL;
2752 signal_simple_error ("Unrecognized symbol value handler type", symbol);
2754 return MAGIC_HANDLER_MAX;
2757 static enum lisp_magic_handler
2758 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
2760 if (EQ (funsym, Qsymbol_value)
2761 || EQ (funsym, Qdefault_value)
2762 || EQ (funsym, Qsymbol_value_in_buffer)
2763 || EQ (funsym, Qsymbol_value_in_console))
2764 return MAGIC_HANDLER_GET_VALUE;
2766 if (EQ (funsym, Qset)
2767 || EQ (funsym, Qset_default))
2768 return MAGIC_HANDLER_SET_VALUE;
2770 if (EQ (funsym, Qboundp)
2771 || EQ (funsym, Qglobally_boundp)
2772 || EQ (funsym, Qdefault_boundp))
2773 return MAGIC_HANDLER_BOUND_PREDICATE;
2775 if (EQ (funsym, Qmakunbound))
2776 return MAGIC_HANDLER_MAKE_UNBOUND;
2778 if (EQ (funsym, Qlocal_variable_p))
2779 return MAGIC_HANDLER_LOCAL_PREDICATE;
2781 if (EQ (funsym, Qmake_variable_buffer_local)
2782 || EQ (funsym, Qmake_local_variable))
2783 return MAGIC_HANDLER_MAKE_LOCAL;
2785 if (abort_if_not_found)
2787 signal_simple_error ("Unrecognized symbol-value function", funsym);
2788 return MAGIC_HANDLER_MAX;
2792 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
2794 /* does not take into account variable aliasing. */
2795 Lisp_Object valcontents = XSYMBOL (sym)->value;
2796 enum lisp_magic_handler slot;
2798 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2800 slot = handler_type_from_function_symbol (funsym, 1);
2801 if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND
2802 && slot != MAGIC_HANDLER_MAKE_LOCAL)
2803 /* #### temporary kludge because we haven't implemented
2804 lisp-magic variables completely */
2806 return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
2810 fetch_value_maybe_past_magic (Lisp_Object sym,
2811 Lisp_Object follow_past_lisp_magic)
2813 Lisp_Object value = XSYMBOL (sym)->value;
2814 if (SYMBOL_VALUE_LISP_MAGIC_P (value)
2815 && (EQ (follow_past_lisp_magic, Qt)
2816 || (!NILP (follow_past_lisp_magic)
2817 && !would_be_magic_handled (sym, follow_past_lisp_magic))))
2818 value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed;
2822 static Lisp_Object *
2823 value_slot_past_magic (Lisp_Object sym)
2825 Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
2827 if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
2828 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
2829 return store_pointer;
2833 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
2836 Lisp_Object args[20]; /* should be enough ... */
2838 enum lisp_magic_handler htype;
2839 Lisp_Object legerdemain;
2840 struct symbol_value_lisp_magic *bfwd;
2842 assert (nargs >= 0 && nargs < 20);
2843 legerdemain = XSYMBOL (sym)->value;
2844 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2845 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2847 va_start (vargs, nargs);
2848 for (i = 0; i < nargs; i++)
2849 args[i] = va_arg (vargs, Lisp_Object);
2852 htype = handler_type_from_function_symbol (funsym, 1);
2853 if (NILP (bfwd->handler[htype]))
2855 /* #### should be reusing the arglist, not always consing anew.
2856 Repeated handler invocations should not cause repeated consing.
2857 Doesn't matter for now, because this is just a quick implementation
2858 for obsolescence support. */
2859 return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym,
2860 bfwd->harg[htype], Qnil);
2863 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
2865 Don't you dare use this.
2866 If you do, suffer the wrath of Ben, who is likely to rename
2867 this function (or change the semantics of its arguments) without
2868 pity, thereby invalidating your code.
2870 (variable, handler_type, handler, harg, keep_existing))
2872 Lisp_Object valcontents;
2873 struct symbol_value_lisp_magic *bfwd;
2874 enum lisp_magic_handler htype;
2877 /* #### WARNING, only some handler types are implemented. See above.
2878 Actions of other types will ignore a handler if it's there.
2880 #### Also, `chain-to-symbol-value-handler' and
2881 `symbol-function-corresponding-function' are not implemented. */
2882 CHECK_SYMBOL (variable);
2883 CHECK_SYMBOL (handler_type);
2884 htype = decode_magic_handler_type (handler_type);
2885 valcontents = XSYMBOL (variable)->value;
2886 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2888 bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
2889 &lrecord_symbol_value_lisp_magic);
2890 bfwd->magic.type = SYMVAL_LISP_MAGIC;
2891 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2893 bfwd->handler[i] = Qnil;
2894 bfwd->harg[i] = Qnil;
2896 bfwd->shadowed = valcontents;
2897 XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
2900 bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
2901 bfwd->handler[htype] = handler;
2902 bfwd->harg[htype] = harg;
2904 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2905 if (!NILP (bfwd->handler[i]))
2908 if (i == MAGIC_HANDLER_MAX)
2909 /* there are no remaining handlers, so remove the structure. */
2910 XSYMBOL (variable)->value = bfwd->shadowed;
2916 /* functions for working with variable aliases. */
2918 /* Follow the chain of variable aliases for SYMBOL. Return the
2919 resulting symbol, whose value cell is guaranteed not to be a
2920 symbol-value-varalias.
2922 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
2923 If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
2924 never follow; stop right there. Otherwise FUNSYM should be a
2925 recognized symbol-value function symbol; this means, follow
2926 unless there is a special handler for the named function.
2928 OK, there is at least one reason why it's necessary for
2929 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
2930 can always be sure to catch cyclic variable aliasing. If we never
2931 follow past Lisp magic, then if the following is done:
2934 add some magic behavior to a, but not a "get-value" handler
2937 then an attempt to retrieve a's or b's value would cause infinite
2938 looping in `symbol-value'.
2940 We (of course) can't always follow past Lisp magic, because then
2941 we make any variable that is lisp-magic -> varalias behave as if
2942 the lisp-magic is not present at all.
2946 follow_varalias_pointers (Lisp_Object symbol,
2947 Lisp_Object follow_past_lisp_magic)
2949 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
2950 Lisp_Object tortoise, hare, val;
2953 /* quick out just in case */
2954 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value))
2957 /* Compare implementation of indirect_function(). */
2958 for (hare = tortoise = symbol, count = 0;
2959 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic),
2960 SYMBOL_VALUE_VARALIAS_P (val);
2961 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)),
2964 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue;
2967 tortoise = symbol_value_varalias_aliasee
2968 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic
2969 (tortoise, follow_past_lisp_magic)));
2970 if (EQ (hare, tortoise))
2971 return Fsignal (Qcyclic_variable_indirection, list1 (symbol));
2977 DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
2978 Define a variable as an alias for another variable.
2979 Thenceforth, any operations performed on VARIABLE will actually be
2980 performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
2981 If ALIAS is nil, remove any aliases for VARIABLE.
2982 ALIAS can itself be aliased, and the chain of variable aliases
2983 will be followed appropriately.
2984 If VARIABLE already has a value, this value will be shadowed
2985 until the alias is removed, at which point it will be restored.
2986 Currently VARIABLE cannot be a built-in variable, a variable that
2987 has a buffer-local value in any buffer, or the symbols nil or t.
2988 \(ALIAS, however, can be any type of variable.)
2992 struct symbol_value_varalias *bfwd;
2993 Lisp_Object valcontents;
2995 CHECK_SYMBOL (variable);
2996 reject_constant_symbols (variable, Qunbound, 0, Qt);
2998 valcontents = XSYMBOL (variable)->value;
3002 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3004 XSYMBOL (variable)->value =
3005 symbol_value_varalias_shadowed
3006 (XSYMBOL_VALUE_VARALIAS (valcontents));
3011 CHECK_SYMBOL (alias);
3012 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3015 XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
3019 if (SYMBOL_VALUE_MAGIC_P (valcontents)
3020 && !UNBOUNDP (valcontents))
3021 signal_simple_error ("Variable is magic and cannot be aliased", variable);
3022 reject_constant_symbols (variable, Qunbound, 0, Qt);
3024 bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
3025 &lrecord_symbol_value_varalias);
3026 bfwd->magic.type = SYMVAL_VARALIAS;
3027 bfwd->aliasee = alias;
3028 bfwd->shadowed = valcontents;
3030 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
3031 XSYMBOL (variable)->value = valcontents;
3035 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
3036 If VARIABLE is aliased to another variable, return that variable.
3037 VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
3038 Variable aliases are created with `defvaralias'. See also
3039 `indirect-variable'.
3041 (variable, follow_past_lisp_magic))
3043 Lisp_Object valcontents;
3045 CHECK_SYMBOL (variable);
3046 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3048 CHECK_SYMBOL (follow_past_lisp_magic);
3049 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3052 valcontents = fetch_value_maybe_past_magic (variable,
3053 follow_past_lisp_magic);
3055 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3056 return symbol_value_varalias_aliasee
3057 (XSYMBOL_VALUE_VARALIAS (valcontents));
3062 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /*
3063 Return the variable at the end of OBJECT's variable-alias chain.
3064 If OBJECT is a symbol, follow all variable aliases and return
3065 the final (non-aliased) symbol. Variable aliases are created with
3066 the function `defvaralias'.
3067 If OBJECT is not a symbol, just return it.
3068 Signal a cyclic-variable-indirection error if there is a loop in the
3069 variable chain of symbols.
3071 (object, follow_past_lisp_magic))
3073 if (!SYMBOLP (object))
3075 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3077 CHECK_SYMBOL (follow_past_lisp_magic);
3078 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3080 return follow_varalias_pointers (object, follow_past_lisp_magic);
3084 /************************************************************************/
3085 /* initialization */
3086 /************************************************************************/
3088 /* A dumped XEmacs image has a lot more than 1511 symbols. Last
3089 estimate was that there were actually around 6300. So let's try
3090 making this bigger and see if we get better hashing behavior. */
3091 #define OBARRAY_SIZE 16411
3096 #ifndef Qnull_pointer
3097 Lisp_Object Qnull_pointer;
3100 /* some losing systems can't have static vars at function scope... */
3101 static struct symbol_value_magic guts_of_unbound_marker =
3102 { { symbol_value_forward_lheader_initializer, 0, 69},
3103 SYMVAL_UNBOUND_MARKER };
3106 init_symbols_once_early (void)
3109 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3112 #ifndef Qnull_pointer
3113 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3114 so the following is actually a no-op. */
3115 XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
3118 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3119 called the first time. */
3120 Qnil = Fmake_symbol (make_string_nocopy ((CONST Bufbyte *) "nil", 3));
3121 XSYMBOL (Qnil)->name->plist = Qnil;
3122 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
3123 XSYMBOL (Qnil)->plist = Qnil;
3125 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3126 initial_obarray = Vobarray;
3127 staticpro (&initial_obarray);
3128 /* Intern nil in the obarray */
3130 int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
3131 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3135 /* Required to get around a GCC syntax error on certain
3137 struct symbol_value_magic *tem = &guts_of_unbound_marker;
3139 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3141 if ((CONST void *) XPNTR (Qunbound) !=
3142 (CONST void *)&guts_of_unbound_marker)
3144 /* This might happen on DATA_SEG_BITS machines. */
3146 /* Can't represent a pointer to constant C data using a Lisp_Object.
3147 So heap-allocate it. */
3148 struct symbol_value_magic *urk = xnew (struct symbol_value_magic);
3149 memcpy (urk, &guts_of_unbound_marker, sizeof (*urk));
3150 XSETSYMBOL_VALUE_MAGIC (Qunbound, urk);
3153 XSYMBOL (Qnil)->function = Qunbound;
3155 defsymbol (&Qt, "t");
3156 XSYMBOL (Qt)->value = Qt; /* Veritas aetera */
3161 defsymbol (Lisp_Object *location, CONST char *name)
3163 *location = Fintern (make_string_nocopy ((CONST Bufbyte *) name,
3166 staticpro (location);
3170 defkeyword (Lisp_Object *location, CONST char *name)
3172 defsymbol (location, name);
3173 Fset (*location, *location);
3177 /* Check that nobody spazzed writing a DEFUN. */
3179 check_sane_subr (Lisp_Subr *subr, Lisp_Object sym)
3181 assert (subr->min_args >= 0);
3182 assert (subr->min_args <= SUBR_MAX_ARGS);
3184 if (subr->max_args != MANY &&
3185 subr->max_args != UNEVALLED)
3187 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3188 assert (subr->max_args <= SUBR_MAX_ARGS);
3189 assert (subr->min_args <= subr->max_args);
3192 assert (UNBOUNDP (XSYMBOL (sym)->function));
3195 #define check_sane_subr(subr, sym) /* nothing */
3200 * If we are not in a pure undumped Emacs, we need to make a duplicate of
3201 * the subr. This is because the only time this function will be called
3202 * in a running Emacs is when a dynamically loaded module is adding a
3203 * subr, and we need to make sure that the subr is in allocated, Lisp-
3204 * accessible memory. The address assigned to the static subr struct
3205 * in the shared object will be a trampoline address, so we need to create
3206 * a copy here to ensure that a real address is used.
3208 * Once we have copied everything across, we re-use the original static
3209 * structure to store a pointer to the newly allocated one. This will be
3210 * used in emodules.c by emodules_doc_subr() to find a pointer to the
3211 * allocated object so that we can set its doc string propperly.
3213 * NOTE: We dont actually use the DOC pointer here any more, but we did
3214 * in an earlier implementation of module support. There is no harm in
3215 * setting it here in case we ever need it in future implementations.
3216 * subr->doc will point to the new subr structure that was allocated.
3217 * Code can then get this value from the statis subr structure and use
3220 * FIXME: Should newsubr be staticpro()'ed? I dont think so but I need
3223 #define check_module_subr() \
3225 if (initialized) { \
3226 struct Lisp_Subr *newsubr; \
3227 newsubr = (Lisp_Subr *)xmalloc(sizeof(struct Lisp_Subr)); \
3228 memcpy (newsubr, subr, sizeof(struct Lisp_Subr)); \
3229 subr->doc = (CONST char *)newsubr; \
3233 #else /* ! HAVE_SHLIB */
3234 #define check_module_subr()
3238 defsubr (Lisp_Subr *subr)
3240 Lisp_Object sym = intern (subr_name (subr));
3243 check_sane_subr (subr, sym);
3244 check_module_subr ();
3246 XSETSUBR (fun, subr);
3247 XSYMBOL (sym)->function = fun;
3250 /* Define a lisp macro using a Lisp_Subr. */
3252 defsubr_macro (Lisp_Subr *subr)
3254 Lisp_Object sym = intern (subr_name (subr));
3257 check_sane_subr (subr, sym);
3258 check_module_subr();
3260 XSETSUBR (fun, subr);
3261 XSYMBOL (sym)->function = Fcons (Qmacro, fun);
3265 deferror (Lisp_Object *symbol, CONST char *name, CONST char *messuhhj,
3266 Lisp_Object inherits_from)
3269 defsymbol (symbol, name);
3271 assert (SYMBOLP (inherits_from));
3272 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3273 pure_put (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3274 /* NOT build_translated_string (). This function is called at load time
3275 and the string needs to get translated at run time. (This happens
3276 in the function (display-error) in cmdloop.el.) */
3277 pure_put (*symbol, Qerror_message, build_string (messuhhj));
3281 syms_of_symbols (void)
3283 defsymbol (&Qvariable_documentation, "variable-documentation");
3284 defsymbol (&Qvariable_domain, "variable-domain"); /* I18N3 */
3285 defsymbol (&Qad_advice_info, "ad-advice-info");
3286 defsymbol (&Qad_activate, "ad-activate");
3288 defsymbol (&Qget_value, "get-value");
3289 defsymbol (&Qset_value, "set-value");
3290 defsymbol (&Qbound_predicate, "bound-predicate");
3291 defsymbol (&Qmake_unbound, "make-unbound");
3292 defsymbol (&Qlocal_predicate, "local-predicate");
3293 defsymbol (&Qmake_local, "make-local");
3295 defsymbol (&Qboundp, "boundp");
3296 defsymbol (&Qfboundp, "fboundp");
3297 defsymbol (&Qglobally_boundp, "globally-boundp");
3298 defsymbol (&Qmakunbound, "makunbound");
3299 defsymbol (&Qsymbol_value, "symbol-value");
3300 defsymbol (&Qset, "set");
3301 defsymbol (&Qsetq_default, "setq-default");
3302 defsymbol (&Qdefault_boundp, "default-boundp");
3303 defsymbol (&Qdefault_value, "default-value");
3304 defsymbol (&Qset_default, "set-default");
3305 defsymbol (&Qmake_variable_buffer_local, "make-variable-buffer-local");
3306 defsymbol (&Qmake_local_variable, "make-local-variable");
3307 defsymbol (&Qkill_local_variable, "kill-local-variable");
3308 defsymbol (&Qkill_console_local_variable, "kill-console-local-variable");
3309 defsymbol (&Qsymbol_value_in_buffer, "symbol-value-in-buffer");
3310 defsymbol (&Qsymbol_value_in_console, "symbol-value-in-console");
3311 defsymbol (&Qlocal_variable_p, "local-variable-p");
3313 defsymbol (&Qconst_integer, "const-integer");
3314 defsymbol (&Qconst_boolean, "const-boolean");
3315 defsymbol (&Qconst_object, "const-object");
3316 defsymbol (&Qconst_specifier, "const-specifier");
3317 defsymbol (&Qdefault_buffer, "default-buffer");
3318 defsymbol (&Qcurrent_buffer, "current-buffer");
3319 defsymbol (&Qconst_current_buffer, "const-current-buffer");
3320 defsymbol (&Qdefault_console, "default-console");
3321 defsymbol (&Qselected_console, "selected-console");
3322 defsymbol (&Qconst_selected_console, "const-selected-console");
3325 DEFSUBR (Fintern_soft);
3326 DEFSUBR (Funintern);
3327 DEFSUBR (Fmapatoms);
3328 DEFSUBR (Fapropos_internal);
3330 DEFSUBR (Fsymbol_function);
3331 DEFSUBR (Fsymbol_plist);
3332 DEFSUBR (Fsymbol_name);
3333 DEFSUBR (Fmakunbound);
3334 DEFSUBR (Ffmakunbound);
3336 DEFSUBR (Fglobally_boundp);
3339 DEFSUBR (Fdefine_function);
3340 Ffset (intern ("defalias"), intern ("define-function"));
3341 DEFSUBR (Fsetplist);
3342 DEFSUBR (Fsymbol_value_in_buffer);
3343 DEFSUBR (Fsymbol_value_in_console);
3344 DEFSUBR (Fbuilt_in_variable_type);
3345 DEFSUBR (Fsymbol_value);
3347 DEFSUBR (Fdefault_boundp);
3348 DEFSUBR (Fdefault_value);
3349 DEFSUBR (Fset_default);
3350 DEFSUBR (Fsetq_default);
3351 DEFSUBR (Fmake_variable_buffer_local);
3352 DEFSUBR (Fmake_local_variable);
3353 DEFSUBR (Fkill_local_variable);
3354 DEFSUBR (Fkill_console_local_variable);
3355 DEFSUBR (Flocal_variable_p);
3356 DEFSUBR (Fdefvaralias);
3357 DEFSUBR (Fvariable_alias);
3358 DEFSUBR (Findirect_variable);
3359 DEFSUBR (Fdontusethis_set_symbol_value_handler);
3362 /* Create and initialize a Lisp variable whose value is forwarded to C data */
3364 defvar_magic (CONST char *symbol_name, CONST struct symbol_value_forward *magic)
3366 Lisp_Object sym, kludge;
3368 /* Check that `magic' points somewhere we can represent as a Lisp pointer */
3369 XSETOBJ (kludge, Lisp_Type_Record, magic);
3370 if ((void *)magic != (void*) XPNTR (kludge))
3372 /* This might happen on DATA_SEG_BITS machines. */
3374 /* Copy it to somewhere which is representable. */
3375 struct symbol_value_forward *p = xnew (struct symbol_value_forward);
3376 memcpy (p, magic, sizeof *magic);
3380 #if defined(HAVE_SHLIB)
3382 * As with defsubr(), this will only be called in a dumped Emacs when
3383 * we are adding variables from a dynamically loaded module. That means
3384 * we can't use purespace. Take that into account.
3387 sym = Fintern (build_string (symbol_name), Qnil);
3390 sym = Fintern (make_string_nocopy ((CONST Bufbyte *) symbol_name,
3391 strlen (symbol_name)), Qnil);
3393 XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic);
3397 vars_of_symbols (void)
3399 DEFVAR_LISP ("obarray", &Vobarray /*
3400 Symbol table for use by `intern' and `read'.
3401 It is a vector whose length ought to be prime for best results.
3402 The vector's contents don't make sense if examined from Lisp programs;
3403 to find all the symbols in an obarray, use `mapatoms'.
3405 /* obarray has been initialized long before */