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 */
60 #include "elhash.h" /* for HASHTABLE_NONWEAK and HASHTABLE_EQ */
62 Lisp_Object Qad_advice_info, Qad_activate;
64 Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound;
65 Lisp_Object Qlocal_predicate, Qmake_local;
67 Lisp_Object Qboundp, Qfboundp, Qglobally_boundp, Qmakunbound;
68 Lisp_Object Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value;
69 Lisp_Object Qset_default, Qmake_variable_buffer_local, Qmake_local_variable;
70 Lisp_Object Qkill_local_variable, Qkill_console_local_variable;
71 Lisp_Object Qsymbol_value_in_buffer, Qsymbol_value_in_console;
72 Lisp_Object Qlocal_variable_p;
74 Lisp_Object Qconst_integer, Qconst_boolean, Qconst_object;
75 Lisp_Object Qconst_specifier;
76 Lisp_Object Qdefault_buffer, Qcurrent_buffer, Qconst_current_buffer;
77 Lisp_Object Qdefault_console, Qselected_console, Qconst_selected_console;
79 static Lisp_Object maybe_call_magic_handler (Lisp_Object sym,
82 static Lisp_Object fetch_value_maybe_past_magic (Lisp_Object sym,
84 follow_past_lisp_magic);
85 static Lisp_Object *value_slot_past_magic (Lisp_Object sym);
86 static Lisp_Object follow_varalias_pointers (Lisp_Object object,
88 follow_past_lisp_magic);
94 mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object))
96 struct Lisp_Symbol *sym = XSYMBOL (obj);
99 ((markobj) (sym->value));
100 ((markobj) (sym->function));
101 /* No need to mark through ->obarray, because it only holds nil or t. */
102 /*((markobj) (sym->obarray));*/
103 XSETSTRING (pname, sym->name);
105 if (!symbol_next (sym))
109 ((markobj) (sym->plist));
110 /* Mark the rest of the symbols in the obarray hash-chain */
111 sym = symbol_next (sym);
112 XSETSYMBOL (obj, sym);
117 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
118 mark_symbol, print_symbol, 0, 0, 0,
120 #endif /* LRECORD_SYMBOL */
123 /**********************************************************************/
125 /**********************************************************************/
127 /* #### using a vector here is way bogus. Use a hash table instead. */
129 Lisp_Object Vobarray;
131 static Lisp_Object initial_obarray;
133 /* oblookup stores the bucket number here, for the sake of Funintern. */
135 static int oblookup_last_bucket_number;
138 check_obarray (Lisp_Object obarray)
140 while (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
142 /* If Vobarray is now invalid, force it to be valid. */
143 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
145 obarray = wrong_type_argument (Qvectorp, obarray);
151 intern (CONST char *str)
154 Bytecount len = strlen (str);
155 Lisp_Object obarray = Vobarray;
156 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
157 obarray = check_obarray (obarray);
158 tem = oblookup (obarray, (CONST Bufbyte *) str, len);
162 return Fintern (((purify_flag)
163 ? make_pure_pname ((CONST Bufbyte *) str, len, 0)
164 : make_string ((CONST Bufbyte *) str, len)),
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 sym, *ptr;
179 if (NILP (obarray)) obarray = Vobarray;
180 obarray = check_obarray (obarray);
184 len = XSTRING_LENGTH (str);
185 sym = oblookup (obarray, XSTRING_DATA (str), len);
190 ptr = &XVECTOR_DATA (obarray)[XINT (sym)];
192 if (purify_flag && ! purified (str))
193 str = make_pure_pname (XSTRING_DATA (str), len, 0);
194 sym = Fmake_symbol (str);
195 /* FSFmacs places OBARRAY here, but it is pointless because we do
196 not mark through this slot, so it is not usable later (because
197 the obarray might have been collected). Marking through the
198 ->obarray slot is an even worse idea, because it would keep
199 obarrays from being collected because of symbols pointed to them.
201 NOTE: We place Qt here only if OBARRAY is actually Vobarray. It
202 is safer to do it this way, to avoid hosing with symbols within
204 if (EQ (obarray, Vobarray))
205 XSYMBOL (sym)->obarray = Qt;
208 symbol_next (XSYMBOL (sym)) = XSYMBOL (*ptr);
210 symbol_next (XSYMBOL (sym)) = 0;
215 DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /*
216 Return the canonical symbol whose name is STRING, or nil if none exists.
217 A second optional argument specifies the obarray to use;
218 it defaults to the value of `obarray'.
224 if (NILP (obarray)) obarray = Vobarray;
225 obarray = check_obarray (obarray);
229 tem = oblookup (obarray, XSTRING_DATA (str), XSTRING_LENGTH (str));
235 DEFUN ("unintern", Funintern, 1, 2, 0, /*
236 Delete the symbol named NAME, if any, from OBARRAY.
237 The value is t if a symbol was found and deleted, nil otherwise.
238 NAME may be a string or a symbol. If it is a symbol, that symbol
239 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
240 OBARRAY defaults to the value of the variable `obarray'
244 Lisp_Object string, tem;
247 if (NILP (obarray)) obarray = Vobarray;
248 obarray = check_obarray (obarray);
251 XSETSTRING (string, XSYMBOL (name)->name);
258 tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string));
261 /* If arg was a symbol, don't delete anything but that symbol itself. */
262 if (SYMBOLP (name) && !EQ (name, tem))
265 hash = oblookup_last_bucket_number;
267 if (EQ (XVECTOR_DATA (obarray)[hash], tem))
269 if (XSYMBOL (tem)->next)
270 XSETSYMBOL (XVECTOR_DATA (obarray)[hash], XSYMBOL (tem)->next);
272 XVECTOR_DATA (obarray)[hash] = Qzero;
276 Lisp_Object tail, following;
278 for (tail = XVECTOR_DATA (obarray)[hash];
279 XSYMBOL (tail)->next;
282 XSETSYMBOL (following, XSYMBOL (tail)->next);
283 if (EQ (following, tem))
285 XSYMBOL (tail)->next = XSYMBOL (following)->next;
290 XSYMBOL (tem)->obarray = Qnil;
294 /* Return the symbol in OBARRAY whose names matches the string
295 of SIZE characters at PTR. If there is no such symbol in OBARRAY,
298 Also store the bucket number in oblookup_last_bucket_number. */
301 oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size)
304 struct Lisp_Symbol *tail;
307 if (!VECTORP (obarray) ||
308 (obsize = XVECTOR_LENGTH (obarray)) == 0)
310 obarray = check_obarray (obarray);
311 obsize = XVECTOR_LENGTH (obarray);
315 /* This is sometimes needed in the middle of GC. */
316 obsize &= ~ARRAY_MARK_FLAG;
318 /* Combining next two lines breaks VMS C 2.3. */
319 hash = hash_string (ptr, size);
321 bucket = XVECTOR_DATA (obarray)[hash];
322 oblookup_last_bucket_number = hash;
325 else if (!SYMBOLP (bucket))
326 error ("Bad data in guts of obarray"); /* Like CADR error message */
328 for (tail = XSYMBOL (bucket); ;)
330 if (string_length (tail->name) == size &&
331 !memcmp (string_data (tail->name), ptr, size))
333 XSETSYMBOL (bucket, tail);
336 tail = symbol_next (tail);
340 return make_int (hash);
343 #if 0 /* Emacs 19.34 */
345 hash_string (CONST Bufbyte *ptr, Bytecount len)
347 CONST Bufbyte *p = ptr;
348 CONST Bufbyte *end = p + len;
355 if (c >= 0140) c -= 40;
356 hash = ((hash<<3) + (hash>>28) + c);
358 return hash & 07777777777;
362 /* derived from hashpjw, Dragon Book P436. */
364 hash_string (CONST Bufbyte *ptr, Bytecount len)
371 hash = (hash << 4) + *ptr++;
372 g = hash & 0xf0000000;
374 hash = (hash ^ (g >> 24)) ^ g;
376 return hash & 07777777777;
379 /* Map FN over OBARRAY. The mapping is stopped when FN returns a
382 map_obarray (Lisp_Object obarray,
383 int (*fn) (Lisp_Object, void *), void *arg)
387 CHECK_VECTOR (obarray);
388 for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--)
390 Lisp_Object tail = XVECTOR_DATA (obarray)[i];
394 struct Lisp_Symbol *next;
395 if ((*fn) (tail, arg))
397 next = symbol_next (XSYMBOL (tail));
400 XSETSYMBOL (tail, next);
406 mapatoms_1 (Lisp_Object sym, void *arg)
408 call1 (*(Lisp_Object *)arg, sym);
412 DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /*
413 Call FUNCTION on every symbol in OBARRAY.
414 OBARRAY defaults to the value of `obarray'.
420 obarray = check_obarray (obarray);
422 map_obarray (obarray, mapatoms_1, &function);
427 /**********************************************************************/
429 /**********************************************************************/
431 struct appropos_mapper_closure
434 Lisp_Object predicate;
435 Lisp_Object accumulation;
439 apropos_mapper (Lisp_Object symbol, void *arg)
441 struct appropos_mapper_closure *closure =
442 (struct appropos_mapper_closure *) arg;
443 Bytecount match = fast_lisp_string_match (closure->regexp,
444 Fsymbol_name (symbol));
447 (NILP (closure->predicate) ||
448 !NILP (call1 (closure->predicate, symbol))))
449 closure->accumulation = Fcons (symbol, closure->accumulation);
454 DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /*
455 Show all symbols whose names contain match for REGEXP.
456 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL)
457 is done for each symbol and a symbol is mentioned only if that
459 Return list of symbols found.
463 struct appropos_mapper_closure closure;
465 CHECK_STRING (regexp);
467 closure.regexp = regexp;
468 closure.predicate = predicate;
469 closure.accumulation = Qnil;
470 map_obarray (Vobarray, apropos_mapper, &closure);
471 closure.accumulation = Fsort (closure.accumulation, Qstring_lessp);
472 return closure.accumulation;
476 /* Extract and set components of symbols */
478 static void set_up_buffer_local_cache (Lisp_Object sym,
479 struct symbol_value_buffer_local *bfwd,
481 Lisp_Object new_alist_el,
484 DEFUN ("boundp", Fboundp, 1, 1, 0, /*
485 Return t if SYMBOL's value is not void.
490 return UNBOUNDP (find_symbol_value (sym)) ? Qnil : Qt;
493 DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /*
494 Return t if SYMBOL has a global (non-bound) value.
495 This is for the byte-compiler; you really shouldn't be using this.
500 return UNBOUNDP (top_level_value (sym)) ? Qnil : Qt;
503 DEFUN ("fboundp", Ffboundp, 1, 1, 0, /*
504 Return t if SYMBOL's function definition is not void.
509 return UNBOUNDP (XSYMBOL (sym)->function) ? Qnil : Qt;
512 /* Return non-zero if SYM's value or function (the current contents of
513 which should be passed in as VAL) is constant, i.e. unsettable. */
516 symbol_is_constant (Lisp_Object sym, Lisp_Object val)
518 /* #### - I wonder if it would be better to just have a new magic value
519 type and make nil, t, and all keywords have that same magic
520 constant_symbol value. This test is awfully specific about what is
521 constant and what isn't. --Stig */
522 if (EQ (sym, Qnil) ||
526 if (SYMBOL_VALUE_MAGIC_P (val))
527 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
529 case SYMVAL_CONST_OBJECT_FORWARD:
530 case SYMVAL_CONST_SPECIFIER_FORWARD:
531 case SYMVAL_CONST_FIXNUM_FORWARD:
532 case SYMVAL_CONST_BOOLEAN_FORWARD:
533 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
534 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
536 default: break; /* Warning suppression */
539 /* We don't return true for keywords here because they are handled
540 specially by reject_constant_symbols(). */
544 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
545 non-zero) to NEWVAL. Make sure this is allowed.
546 FOLLOW_PAST_LISP_MAGIC specifies whether we delve past
547 symbol-value-lisp-magic objects. */
550 reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p,
551 Lisp_Object follow_past_lisp_magic)
554 (function_p ? XSYMBOL (sym)->function
555 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
557 if (SYMBOL_VALUE_MAGIC_P (val) &&
558 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
559 signal_simple_error ("Use `set-specifier' to change a specifier's value",
562 if (symbol_is_constant (sym, val)
563 || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)
564 && !NILP (XSYMBOL (sym)->obarray)))
565 signal_error (Qsetting_constant,
566 UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
569 /* Verify that it's ok to make SYM buffer-local. This rejects
570 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC
571 specifies whether we delve into symbol-value-lisp-magic objects.
572 (Should be a symbol indicating what action is being taken; that way,
573 we don't delve if there's a handler for that action, but do otherwise.) */
576 verify_ok_for_buffer_local (Lisp_Object sym,
577 Lisp_Object follow_past_lisp_magic)
579 Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic);
581 if (symbol_is_constant (sym, val))
583 if (SYMBOL_VALUE_MAGIC_P (val))
584 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
586 case SYMVAL_DEFAULT_BUFFER_FORWARD:
587 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
588 /* #### It's theoretically possible for it to be reasonable
589 to have both console-local and buffer-local variables,
590 but I don't want to consider that right now. */
591 case SYMVAL_SELECTED_CONSOLE_FORWARD:
593 default: break; /* Warning suppression */
599 signal_error (Qerror,
600 list2 (build_string ("Symbol may not be buffer-local"), sym));
603 DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /*
604 Make SYMBOL's value be void.
608 Fset (sym, Qunbound);
612 DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /*
613 Make SYMBOL's function definition be void.
618 reject_constant_symbols (sym, Qunbound, 1, Qt);
619 XSYMBOL (sym)->function = Qunbound;
623 DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /*
624 Return SYMBOL's function definition. Error if that is void.
628 CHECK_SYMBOL (symbol);
629 if (UNBOUNDP (XSYMBOL (symbol)->function))
630 return Fsignal (Qvoid_function, list1 (symbol));
631 return XSYMBOL (symbol)->function;
634 DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /*
635 Return SYMBOL's property list.
640 return XSYMBOL (sym)->plist;
643 DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /*
644 Return SYMBOL's name, a string.
651 XSETSTRING (name, XSYMBOL (sym)->name);
655 DEFUN ("fset", Ffset, 2, 2, 0, /*
656 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
660 /* This function can GC */
662 reject_constant_symbols (sym, newdef, 1, Qt);
663 if (!NILP (Vautoload_queue) && !UNBOUNDP (XSYMBOL (sym)->function))
664 Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function),
666 XSYMBOL (sym)->function = newdef;
667 /* Handle automatic advice activation */
668 if (CONSP (XSYMBOL (sym)->plist) && !NILP (Fget (sym, Qad_advice_info,
671 call2 (Qad_activate, sym, Qnil);
672 newdef = XSYMBOL (sym)->function;
678 DEFUN ("define-function", Fdefine_function, 2, 2, 0, /*
679 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
680 Associates the function with the current load file, if any.
684 /* This function can GC */
687 LOADHIST_ATTACH (sym);
692 DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
693 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
698 #if 0 /* Inserted for debugging 6/28/1997 -slb */
699 /* Somebody is setting a property list of integer 0, who? */
700 /* Not this way apparently. */
701 if (EQ(newplist, Qzero)) abort();
704 XSYMBOL (sym)->plist = newplist;
709 /**********************************************************************/
711 /**********************************************************************/
713 /* If the contents of the value cell of a symbol is one of the following
714 three types of objects, then the symbol is "magic" in that setting
715 and retrieving its value doesn't just set or retrieve the raw
716 contents of the value cell. None of these objects can escape to
717 the user level, so there is no loss of generality.
719 If a symbol is "unbound", then the contents of its value cell is
720 Qunbound. Despite appearances, this is *not* a symbol, but is a
721 symbol-value-forward object. This is so that printing it results
722 in "INTERNAL EMACS BUG", in case it leaks to Lisp, somehow.
724 Logically all of the following objects are "symbol-value-magic"
725 objects, and there are some games played w.r.t. this (#### this
726 should be cleaned up). SYMBOL_VALUE_MAGIC_P is true for all of
727 the object types. XSYMBOL_VALUE_MAGIC_TYPE returns the type of
728 symbol-value-magic object. There are more than three types
729 returned by this macro: in particular, symbol-value-forward
730 has eight subtypes, and symbol-value-buffer-local has two. See
733 1. symbol-value-forward
735 symbol-value-forward is used for variables whose actual contents
736 are stored in a C variable of some sort, and for Qunbound. The
737 lcheader.next field (which is only used to chain together free
738 lcrecords) holds a pointer to the actual C variable. Included
739 in this type are "buffer-local" variables that are actually
740 stored in the buffer object itself; in this case, the "pointer"
741 is an offset into the struct buffer structure.
743 The subtypes are as follows:
745 SYMVAL_OBJECT_FORWARD:
746 (declare with DEFVAR_LISP)
747 The value of this variable is stored in a C variable of type
748 "Lisp_Object". Setting this variable sets the C variable.
749 Accessing this variable retrieves a value from the C variable.
750 These variables can be buffer-local -- in this case, the
751 raw symbol-value field gets converted into a
752 symbol-value-buffer-local, whose "current_value" slot contains
753 the symbol-value-forward. (See below.)
755 SYMVAL_FIXNUM_FORWARD:
756 SYMVAL_BOOLEAN_FORWARD:
757 (declare with DEFVAR_INT or DEFVAR_BOOL)
758 Similar to SYMVAL_OBJECT_FORWARD except that the C variable
759 is of type "int" and is an integer or boolean, respectively.
761 SYMVAL_CONST_OBJECT_FORWARD:
762 SYMVAL_CONST_FIXNUM_FORWARD:
763 SYMVAL_CONST_BOOLEAN_FORWARD:
764 (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
766 Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
767 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
770 SYMVAL_CONST_SPECIFIER_FORWARD:
771 (declare with DEFVAR_SPECIFIER)
772 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that error message
773 you get when attempting to set the value says to use
774 `set-specifier' instead.
776 SYMVAL_CURRENT_BUFFER_FORWARD:
777 (declare with DEFVAR_BUFFER_LOCAL)
778 This is used for built-in buffer-local variables -- i.e.
779 Lisp variables whose value is stored in the "struct buffer".
780 Variables of this sort always forward into C "Lisp_Object"
781 fields (although there's no reason in principle that other
782 types for ints and booleans couldn't be added). Note that
783 some of these variables are automatically local in each
784 buffer, while some are only local when they become set
785 (similar to `make-variable-buffer-local'). In these latter
786 cases, of course, the default value shows through in all
787 buffers in which the variable doesn't have a local value.
788 This is implemented by making sure the "struct buffer" field
789 always contains the correct value (whether it's local or
790 a default) and maintaining a mask in the "struct buffer"
791 indicating which fields are local. When `set-default' is
792 called on a variable that's not always local to all buffers,
793 it loops through each buffer and sets the corresponding
794 field in each buffer without a local value for the field,
795 according to the mask.
797 Calling `make-local-variable' on a variable of this sort
798 only has the effect of maybe changing the current buffer's mask.
799 Calling `make-variable-buffer-local' on a variable of this
800 sort has no effect at all.
802 SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
803 (declare with DEFVAR_CONST_BUFFER_LOCAL)
804 Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
807 SYMVAL_DEFAULT_BUFFER_FORWARD:
808 (declare with DEFVAR_BUFFER_DEFAULTS)
809 This is used for the Lisp variables that contain the
810 default values of built-in buffer-local variables. Setting
811 or referencing one of these variables forwards into a slot
812 in the special struct buffer Vbuffer_defaults.
814 SYMVAL_UNBOUND_MARKER:
815 This is used for only one object, Qunbound.
817 SYMVAL_SELECTED_CONSOLE_FORWARD:
818 (declare with DEFVAR_CONSOLE_LOCAL)
819 This is used for built-in console-local variables -- i.e.
820 Lisp variables whose value is stored in the "struct console".
821 These work just like built-in buffer-local variables.
822 However, calling `make-local-variable' or
823 `make-variable-buffer-local' on one of these variables
824 is currently disallowed because that would entail having
825 both console-local and buffer-local variables, which is
826 trickier to implement.
828 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
829 (declare with DEFVAR_CONST_CONSOLE_LOCAL)
830 Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
833 SYMVAL_DEFAULT_CONSOLE_FORWARD:
834 (declare with DEFVAR_CONSOLE_DEFAULTS)
835 This is used for the Lisp variables that contain the
836 default values of built-in console-local variables. Setting
837 or referencing one of these variables forwards into a slot
838 in the special struct console Vconsole_defaults.
841 2. symbol-value-buffer-local
843 symbol-value-buffer-local is used for variables that have had
844 `make-local-variable' or `make-variable-buffer-local' applied
845 to them. This object contains an alist mapping buffers to
846 values. In addition, the object contains a "current value",
847 which is the value in some buffer. Whenever you access the
848 variable with `symbol-value' or set it with `set' or `setq',
849 things are switched around so that the "current value"
850 refers to the current buffer, if it wasn't already. This
851 way, repeated references to a variable in the same buffer
852 are almost as efficient as if the variable weren't buffer
853 local. Note that the alist may not be up-to-date w.r.t.
854 the buffer whose value is current, as the "current value"
855 cache is normally only flushed into the alist when the
856 buffer it refers to changes.
858 Note also that it is possible for `make-local-variable'
859 or `make-variable-buffer-local' to be called on a variable
860 that forwards into a C variable (i.e. a variable whose
861 value cell is a symbol-value-forward). In this case,
862 the value cell becomes a symbol-value-buffer-local (as
863 always), and the symbol-value-forward moves into
864 the "current value" cell in this object. Also, in
865 this case the "current value" *always* refers to the
866 current buffer, so that the values of the C variable
867 always is the correct value for the current buffer.
868 set_buffer_internal() automatically updates the current-value
869 cells of all buffer-local variables that forward into C
870 variables. (There is a list of all buffer-local variables
871 that is maintained for this and other purposes.)
873 Note that only certain types of `symbol-value-forward' objects
874 can find their way into the "current value" cell of a
875 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
876 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
877 SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot
878 be buffer-local because they are unsettable;
879 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
880 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
881 does not have much of an effect (it's already buffer-local); and
882 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
883 that's not currently implemented.
886 3. symbol-value-varalias
888 A symbol-value-varalias object is used for variables that
889 are aliases for other variables. This object contains
890 the symbol that this variable is aliased to.
891 symbol-value-varalias objects cannot occur anywhere within
892 a symbol-value-buffer-local object, and most of the
893 low-level functions below do not accept them; you need
894 to call follow_varalias_pointers to get the actual
895 symbol to operate on. */
898 mark_symbol_value_buffer_local (Lisp_Object obj,
899 void (*markobj) (Lisp_Object))
901 struct symbol_value_buffer_local *bfwd;
903 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
904 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
906 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
907 ((markobj) (bfwd->default_value));
908 ((markobj) (bfwd->current_value));
909 ((markobj) (bfwd->current_buffer));
910 return bfwd->current_alist_element;
914 mark_symbol_value_lisp_magic (Lisp_Object obj,
915 void (*markobj) (Lisp_Object))
917 struct symbol_value_lisp_magic *bfwd;
920 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
922 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
923 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
925 ((markobj) (bfwd->handler[i]));
926 ((markobj) (bfwd->harg[i]));
928 return bfwd->shadowed;
932 mark_symbol_value_varalias (Lisp_Object obj,
933 void (*markobj) (Lisp_Object))
935 struct symbol_value_varalias *bfwd;
937 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
939 bfwd = XSYMBOL_VALUE_VARALIAS (obj);
940 ((markobj) (bfwd->shadowed));
941 return bfwd->aliasee;
944 /* Should never, ever be called. (except by an external debugger) */
946 print_symbol_value_magic (Lisp_Object obj,
947 Lisp_Object printcharfun, int escapeflag)
950 sprintf (buf, "#<INTERNAL EMACS BUG (%s type %d) 0x%p>",
951 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
952 XSYMBOL_VALUE_MAGIC_TYPE (obj),
953 (void *) XPNTR (obj));
954 write_c_string (buf, printcharfun);
957 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
958 symbol_value_forward,
959 this_one_is_unmarkable,
960 print_symbol_value_magic, 0, 0, 0,
961 struct symbol_value_forward);
963 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
964 symbol_value_buffer_local,
965 mark_symbol_value_buffer_local,
966 print_symbol_value_magic, 0, 0, 0,
967 struct symbol_value_buffer_local);
969 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
970 symbol_value_lisp_magic,
971 mark_symbol_value_lisp_magic,
972 print_symbol_value_magic, 0, 0, 0,
973 struct symbol_value_lisp_magic);
975 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
976 symbol_value_varalias,
977 mark_symbol_value_varalias,
978 print_symbol_value_magic, 0, 0, 0,
979 struct symbol_value_varalias);
982 /* Getting and setting values of symbols */
984 /* Given the raw contents of a symbol value cell, return the Lisp value of
985 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
986 symbol-value-lisp-magic, or symbol-value-varalias.
988 BUFFER specifies a buffer, and is used for built-in buffer-local
989 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
990 Note that such variables are never encapsulated in a
991 symbol-value-buffer-local structure.
993 CONSOLE specifies a console, and is used for built-in console-local
994 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
995 Note that such variables are (currently) never encapsulated in a
996 symbol-value-buffer-local structure.
1000 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
1001 struct console *console)
1003 CONST struct symbol_value_forward *fwd;
1005 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1008 fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1009 switch (fwd->magic.type)
1011 case SYMVAL_FIXNUM_FORWARD:
1012 case SYMVAL_CONST_FIXNUM_FORWARD:
1013 return make_int (*((int *)symbol_value_forward_forward (fwd)));
1015 case SYMVAL_BOOLEAN_FORWARD:
1016 case SYMVAL_CONST_BOOLEAN_FORWARD:
1017 return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
1019 case SYMVAL_OBJECT_FORWARD:
1020 case SYMVAL_CONST_OBJECT_FORWARD:
1021 case SYMVAL_CONST_SPECIFIER_FORWARD:
1022 return *((Lisp_Object *)symbol_value_forward_forward (fwd));
1024 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1025 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1026 + ((char *)symbol_value_forward_forward (fwd)
1027 - (char *)&buffer_local_flags))));
1030 case SYMVAL_CURRENT_BUFFER_FORWARD:
1031 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1033 return (*((Lisp_Object *)((char *)buffer
1034 + ((char *)symbol_value_forward_forward (fwd)
1035 - (char *)&buffer_local_flags))));
1037 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1038 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1039 + ((char *)symbol_value_forward_forward (fwd)
1040 - (char *)&console_local_flags))));
1042 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1043 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1045 return (*((Lisp_Object *)((char *)console
1046 + ((char *)symbol_value_forward_forward (fwd)
1047 - (char *)&console_local_flags))));
1049 case SYMVAL_UNBOUND_MARKER:
1055 return Qnil; /* suppress compiler warning */
1058 /* Set the value of default-buffer-local variable SYM to VALUE. */
1061 set_default_buffer_slot_variable (Lisp_Object sym,
1064 /* Handle variables like case-fold-search that have special slots in
1065 the buffer. Make them work apparently like buffer_local variables.
1067 /* At this point, the value cell may not contain a symbol-value-varalias
1068 or symbol-value-buffer-local, and if there's a handler, we should
1069 have already called it. */
1070 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1071 CONST struct symbol_value_forward *fwd
1072 = XSYMBOL_VALUE_FORWARD (valcontents);
1073 int offset = ((char *) symbol_value_forward_forward (fwd)
1074 - (char *) &buffer_local_flags);
1075 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1076 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1077 int flags) = symbol_value_forward_magicfun (fwd);
1079 *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
1082 if (mask > 0) /* Not always per-buffer */
1086 /* Set value in each buffer which hasn't shadowed the default */
1087 LIST_LOOP (tail, Vbuffer_alist)
1089 struct buffer *b = XBUFFER (XCDR (XCAR (tail)));
1090 if (!(b->local_var_flags & mask))
1093 (magicfun) (sym, &value, make_buffer (b), 0);
1094 *((Lisp_Object *) (offset + (char *) b)) = value;
1100 /* Set the value of default-console-local variable SYM to VALUE. */
1103 set_default_console_slot_variable (Lisp_Object sym,
1106 /* Handle variables like case-fold-search that have special slots in
1107 the console. Make them work apparently like console_local variables.
1109 /* At this point, the value cell may not contain a symbol-value-varalias
1110 or symbol-value-buffer-local, and if there's a handler, we should
1111 have already called it. */
1112 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1113 CONST struct symbol_value_forward *fwd
1114 = XSYMBOL_VALUE_FORWARD (valcontents);
1115 int offset = ((char *) symbol_value_forward_forward (fwd)
1116 - (char *) &console_local_flags);
1117 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1118 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1119 int flags) = symbol_value_forward_magicfun (fwd);
1121 *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
1124 if (mask > 0) /* Not always per-console */
1128 /* Set value in each console which hasn't shadowed the default */
1129 LIST_LOOP (tail, Vconsole_list)
1131 Lisp_Object dev = XCAR (tail);
1132 struct console *d = XCONSOLE (dev);
1133 if (!(d->local_var_flags & mask))
1136 (magicfun) (sym, &value, dev, 0);
1137 *((Lisp_Object *) (offset + (char *) d)) = value;
1143 /* Store NEWVAL into SYM.
1145 SYM's value slot may *not* be types (5) or (6) above,
1146 i.e. no symbol-value-varalias objects. (You should have
1147 forwarded past all of these.)
1149 SYM should not be an unsettable symbol or a symbol with
1150 a magic `set-value' handler (unless you want to explicitly
1151 ignore this handler).
1153 OVALUE is the current value of SYM, but forwarded past any
1154 symbol-value-buffer-local and symbol-value-lisp-magic objects.
1155 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1156 the contents of its current-value cell.) NEWVAL may only be
1157 a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
1158 this function will only modify its current-value cell, which should
1159 already be set up to point to the current buffer.
1163 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
1166 if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
1168 Lisp_Object *store_pointer = value_slot_past_magic (sym);
1170 if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
1172 &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
1174 assert (UNBOUNDP (*store_pointer)
1175 || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1176 *store_pointer = newval;
1181 CONST struct symbol_value_forward *fwd
1182 = XSYMBOL_VALUE_FORWARD (ovalue);
1183 int type = XSYMBOL_VALUE_MAGIC_TYPE (ovalue);
1184 int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
1185 Lisp_Object in_object, int flags) =
1186 symbol_value_forward_magicfun (fwd);
1190 case SYMVAL_FIXNUM_FORWARD:
1194 (magicfun) (sym, &newval, Qnil, 0);
1195 *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
1199 case SYMVAL_BOOLEAN_FORWARD:
1202 (magicfun) (sym, &newval, Qnil, 0);
1203 *((int *) symbol_value_forward_forward (fwd))
1204 = ((NILP (newval)) ? 0 : 1);
1208 case SYMVAL_OBJECT_FORWARD:
1211 (magicfun) (sym, &newval, Qnil, 0);
1212 *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
1216 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1218 set_default_buffer_slot_variable (sym, newval);
1222 case SYMVAL_CURRENT_BUFFER_FORWARD:
1225 (magicfun) (sym, &newval, make_buffer (current_buffer), 0);
1226 *((Lisp_Object *) ((char *) current_buffer
1227 + ((char *) symbol_value_forward_forward (fwd)
1228 - (char *) &buffer_local_flags)))
1233 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1235 set_default_console_slot_variable (sym, newval);
1239 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1242 (magicfun) (sym, &newval, Vselected_console, 0);
1243 *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console)
1244 + ((char *) symbol_value_forward_forward (fwd)
1245 - (char *) &console_local_flags)))
1256 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1257 BFWD, locate and return a pointer to the element in BUFFER's
1258 local_var_alist for SYMBOL. The return value will be Qnil if
1259 BUFFER does not have its own value for SYMBOL (i.e. the default
1260 value is seen in that buffer).
1264 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
1265 struct symbol_value_buffer_local *bfwd)
1267 if (!NILP (bfwd->current_buffer) &&
1268 XBUFFER (bfwd->current_buffer) == buffer)
1269 /* This is just an optimization of the below. */
1270 return bfwd->current_alist_element;
1272 return assq_no_quit (symbol, buffer->local_var_alist);
1275 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1276 symbol-value-buffer-local of a per-buffer variable -- i.e. the
1277 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1278 slot -- may be out of date.]
1280 Write out any cached value in buffer-local variable SYMBOL's
1281 buffer-local structure, which is passed in as BFWD.
1285 write_out_buffer_local_cache (Lisp_Object symbol,
1286 struct symbol_value_buffer_local *bfwd)
1288 if (!NILP (bfwd->current_buffer))
1290 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1291 uses it, and that type cannot be inside a symbol-value-buffer-local */
1292 Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0);
1293 if (NILP (bfwd->current_alist_element))
1294 /* current_value may be updated more recently than default_value */
1295 bfwd->default_value = cval;
1297 Fsetcdr (bfwd->current_alist_element, cval);
1301 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1302 Set up BFWD's cache for validity in buffer BUF. This assumes that
1303 the cache is currently in a consistent state (this can include
1304 not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1306 If the cache is already set up for BUF, this function does nothing
1309 Otherwise, if SYM forwards out to a C variable, this also forwards
1310 SYM's value in BUF out to the variable. Therefore, you generally
1311 only want to call this when BUF is, or is about to become, the
1314 (Otherwise, you can just retrieve the value without changing the
1315 cache, at the expense of slower retrieval.)
1319 set_up_buffer_local_cache (Lisp_Object sym,
1320 struct symbol_value_buffer_local *bfwd,
1322 Lisp_Object new_alist_el,
1325 Lisp_Object new_val;
1327 if (!NILP (bfwd->current_buffer)
1328 && buf == XBUFFER (bfwd->current_buffer))
1329 /* Cache is already set up. */
1332 /* Flush out the old cache. */
1333 write_out_buffer_local_cache (sym, bfwd);
1335 /* Retrieve the new alist element and new value. */
1336 if (NILP (new_alist_el)
1338 new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1340 if (NILP (new_alist_el))
1341 new_val = bfwd->default_value;
1343 new_val = Fcdr (new_alist_el);
1345 bfwd->current_alist_element = new_alist_el;
1346 XSETBUFFER (bfwd->current_buffer, buf);
1348 /* Now store the value into the current-value slot.
1349 We don't simply write it there, because the current-value
1350 slot might be a forwarding pointer, in which case we need
1351 to instead write the value into the C variable.
1353 We might also want to call a magic function.
1355 So instead, we call this function. */
1356 store_symval_forwarding (sym, bfwd->current_value, new_val);
1361 kill_buffer_local_variables (struct buffer *buf)
1363 Lisp_Object prev = Qnil;
1366 /* Any which are supposed to be permanent,
1367 make local again, with the same values they had. */
1369 for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
1371 Lisp_Object sym = XCAR (XCAR (alist));
1372 struct symbol_value_buffer_local *bfwd;
1373 /* Variables with a symbol-value-varalias should not be here
1374 (we should have forwarded past them) and there must be a
1375 symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
1376 just forward past it; if the variable has a handler, it was
1378 Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
1380 assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
1381 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
1383 if (!NILP (Fget (sym, Qpermanent_local, Qnil)))
1384 /* prev points to the last alist element that is still
1385 staying around, so *only* update it now. This didn't
1386 used to be the case; this bug has been around since
1387 mly's rewrite two years ago! */
1391 /* Really truly kill it. */
1393 XCDR (prev) = XCDR (alist);
1395 buf->local_var_alist = XCDR (alist);
1397 /* We just effectively changed the value for this variable
1400 /* (1) If the cache is caching BUF, invalidate the cache. */
1401 if (!NILP (bfwd->current_buffer) &&
1402 buf == XBUFFER (bfwd->current_buffer))
1403 bfwd->current_buffer = Qnil;
1405 /* (2) If we changed the value in current_buffer and this
1406 variable forwards to a C variable, we need to change the
1407 value of the C variable. set_up_buffer_local_cache()
1408 will do this. It doesn't hurt to do it whenever
1409 BUF == current_buffer, so just go ahead and do that. */
1410 if (buf == current_buffer)
1411 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
1417 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1418 struct console *con, int swap_it_in,
1419 Lisp_Object symcons, int set_it_p)
1421 Lisp_Object valcontents;
1424 valcontents = XSYMBOL (sym)->value;
1427 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1430 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1432 case SYMVAL_LISP_MAGIC:
1434 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1438 case SYMVAL_VARALIAS:
1439 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1441 /* presto change-o! */
1444 case SYMVAL_BUFFER_LOCAL:
1445 case SYMVAL_SOME_BUFFER_LOCAL:
1447 struct symbol_value_buffer_local *bfwd
1448 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1452 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1453 valcontents = bfwd->current_value;
1457 if (!NILP (bfwd->current_buffer) &&
1458 buf == XBUFFER (bfwd->current_buffer))
1459 valcontents = bfwd->current_value;
1460 else if (NILP (symcons))
1463 valcontents = assq_no_quit (sym, buf->local_var_alist);
1464 if (NILP (valcontents))
1465 valcontents = bfwd->default_value;
1467 valcontents = XCDR (valcontents);
1470 valcontents = XCDR (symcons);
1478 return do_symval_forwarding (valcontents, buf, con);
1482 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1483 bound. Note that it must not be possible to QUIT within this
1487 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
1495 CHECK_BUFFER (buffer);
1496 buf = XBUFFER (buffer);
1499 buf = current_buffer;
1501 return find_symbol_value_1 (sym, buf,
1502 /* If it bombs out at startup due to a
1503 Lisp error, this may be nil. */
1504 CONSOLEP (Vselected_console)
1505 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
1509 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1513 if (!NILP (console))
1514 CHECK_CONSOLE (console);
1516 console = Vselected_console;
1518 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1522 /* Return the current value of SYM. The difference between this function
1523 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1524 this updates the CURRENT_VALUE slot of buffer-local variables to
1525 point to the current buffer, while symbol_value_in_buffer doesn't. */
1528 find_symbol_value (Lisp_Object sym)
1530 /* WARNING: This function can be called when current_buffer is 0
1531 and Vselected_console is Qnil, early in initialization. */
1532 struct console *dev;
1533 Lisp_Object valcontents;
1537 valcontents = XSYMBOL (sym)->value;
1538 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1541 if (CONSOLEP (Vselected_console))
1542 dev = XCONSOLE (Vselected_console);
1545 /* This can also get called while we're preparing to shutdown.
1546 #### What should really happen in that case? Should we
1547 actually fix things so we can't get here in that case? */
1548 assert (!initialized || preparing_for_armageddon);
1552 return find_symbol_value_1 (sym, current_buffer, dev, 1, Qnil, 1);
1555 /* This is an optimized function for quick lookup of buffer local symbols
1556 by avoiding O(n) search. This will work when either:
1557 a) We have already found the symbol e.g. by traversing local_var_alist.
1559 b) We know that the symbol will not be found in the current buffer's
1560 list of local variables.
1561 In the former case, find_it_p is 1 and symbol_cons is the element from
1562 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1565 This function is called from set_buffer_internal which does both of these
1569 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1571 /* WARNING: This function can be called when current_buffer is 0
1572 and Vselected_console is Qnil, early in initialization. */
1573 struct console *dev;
1574 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1577 if (CONSOLEP (Vselected_console))
1578 dev = XCONSOLE (Vselected_console);
1581 /* This can also get called while we're preparing to shutdown.
1582 #### What should really happen in that case? Should we
1583 actually fix things so we can't get here in that case? */
1584 assert (!initialized || preparing_for_armageddon);
1588 return find_symbol_value_1 (sym, current_buffer, dev, 1,
1589 find_it_p ? symbol_cons : Qnil,
1593 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1594 Return SYMBOL's value. Error if that is void.
1598 Lisp_Object val = find_symbol_value (sym);
1601 return Fsignal (Qvoid_variable, list1 (sym));
1606 DEFUN ("set", Fset, 2, 2, 0, /*
1607 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1611 REGISTER Lisp_Object valcontents;
1612 /* remember, we're called by Fmakunbound() as well */
1617 valcontents = XSYMBOL (sym)->value;
1618 if (NILP (sym) || EQ (sym, Qt) || SYMBOL_VALUE_MAGIC_P (valcontents)
1619 || SYMBOL_IS_KEYWORD (sym))
1620 reject_constant_symbols (sym, newval, 0,
1621 UNBOUNDP (newval) ? Qmakunbound : Qset);
1624 XSYMBOL (sym)->value = newval;
1630 if (SYMBOL_VALUE_MAGIC_P (valcontents))
1632 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1634 case SYMVAL_LISP_MAGIC:
1638 if (UNBOUNDP (newval))
1639 retval = maybe_call_magic_handler (sym, Qmakunbound, 0);
1641 retval = maybe_call_magic_handler (sym, Qset, 1, newval);
1642 if (!UNBOUNDP (retval))
1644 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1649 case SYMVAL_VARALIAS:
1650 sym = follow_varalias_pointers (sym,
1652 ? Qmakunbound : Qset);
1653 /* presto change-o! */
1656 case SYMVAL_FIXNUM_FORWARD:
1657 case SYMVAL_BOOLEAN_FORWARD:
1658 case SYMVAL_OBJECT_FORWARD:
1659 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1660 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1661 if (UNBOUNDP (newval))
1662 signal_error (Qerror,
1663 list2 (build_string ("Cannot makunbound"), sym));
1666 case SYMVAL_UNBOUND_MARKER:
1669 case SYMVAL_CURRENT_BUFFER_FORWARD:
1671 CONST struct symbol_value_forward *fwd
1672 = XSYMBOL_VALUE_FORWARD (valcontents);
1673 int mask = XINT (*((Lisp_Object *)
1674 symbol_value_forward_forward (fwd)));
1676 /* Setting this variable makes it buffer-local */
1677 current_buffer->local_var_flags |= mask;
1681 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1683 CONST struct symbol_value_forward *fwd
1684 = XSYMBOL_VALUE_FORWARD (valcontents);
1685 int mask = XINT (*((Lisp_Object *)
1686 symbol_value_forward_forward (fwd)));
1688 /* Setting this variable makes it console-local */
1689 XCONSOLE (Vselected_console)->local_var_flags |= mask;
1693 case SYMVAL_BUFFER_LOCAL:
1694 case SYMVAL_SOME_BUFFER_LOCAL:
1696 /* If we want to examine or set the value and
1697 CURRENT-BUFFER is current, we just examine or set
1698 CURRENT-VALUE. If CURRENT-BUFFER is not current, we
1699 store the current CURRENT-VALUE value into
1700 CURRENT-ALIST- ELEMENT, then find the appropriate alist
1701 element for the buffer now current and set up
1702 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
1703 of that element, and store into CURRENT-BUFFER.
1705 If we are setting the variable and the current buffer does
1706 not have an alist entry for this variable, an alist entry is
1709 Note that CURRENT-VALUE can be a forwarding pointer.
1710 Each time it is examined or set, forwarding must be
1712 struct symbol_value_buffer_local *bfwd
1713 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1714 int some_buffer_local_p =
1715 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
1716 /* What value are we caching right now? */
1717 Lisp_Object aelt = bfwd->current_alist_element;
1719 if (!NILP (bfwd->current_buffer) &&
1720 current_buffer == XBUFFER (bfwd->current_buffer)
1721 && ((some_buffer_local_p)
1722 ? 1 /* doesn't automatically become local */
1723 : !NILP (aelt) /* already local */
1726 /* Cache is valid */
1727 valcontents = bfwd->current_value;
1731 /* If the current buffer is not the buffer whose binding is
1732 currently cached, or if it's a SYMVAL_BUFFER_LOCAL and
1733 we're looking at the default value, the cache is invalid; we
1734 need to write it out, and find the new CURRENT-ALIST-ELEMENT
1737 /* Write out the cached value for the old buffer; copy it
1738 back to its alist element. This works if the current
1739 buffer only sees the default value, too. */
1740 write_out_buffer_local_cache (sym, bfwd);
1742 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1743 aelt = buffer_local_alist_element (current_buffer, sym, bfwd);
1746 /* This buffer is still seeing the default value. */
1747 if (!some_buffer_local_p)
1749 /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a
1750 new assoc for a local value and set
1751 CURRENT-ALIST-ELEMENT to point to that. */
1753 do_symval_forwarding (bfwd->current_value,
1755 XCONSOLE (Vselected_console));
1756 aelt = Fcons (sym, aelt);
1757 current_buffer->local_var_alist
1758 = Fcons (aelt, current_buffer->local_var_alist);
1762 /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
1763 we're currently seeing the default value. */
1767 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1768 bfwd->current_alist_element = aelt;
1769 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
1770 XSETBUFFER (bfwd->current_buffer, current_buffer);
1771 valcontents = bfwd->current_value;
1779 store_symval_forwarding (sym, valcontents, newval);
1785 /* Access or set a buffer-local symbol's default value. */
1787 /* Return the default value of SYM, but don't check for voidness.
1788 Return Qunbound if it is void. */
1791 default_value (Lisp_Object sym)
1793 Lisp_Object valcontents;
1798 valcontents = XSYMBOL (sym)->value;
1801 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1804 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1806 case SYMVAL_LISP_MAGIC:
1808 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1812 case SYMVAL_VARALIAS:
1813 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1814 /* presto change-o! */
1817 case SYMVAL_UNBOUND_MARKER:
1820 case SYMVAL_CURRENT_BUFFER_FORWARD:
1822 CONST struct symbol_value_forward *fwd
1823 = XSYMBOL_VALUE_FORWARD (valcontents);
1824 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1825 + ((char *)symbol_value_forward_forward (fwd)
1826 - (char *)&buffer_local_flags))));
1829 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1831 CONST struct symbol_value_forward *fwd
1832 = XSYMBOL_VALUE_FORWARD (valcontents);
1833 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1834 + ((char *)symbol_value_forward_forward (fwd)
1835 - (char *)&console_local_flags))));
1838 case SYMVAL_BUFFER_LOCAL:
1839 case SYMVAL_SOME_BUFFER_LOCAL:
1841 struct symbol_value_buffer_local *bfwd =
1842 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1844 /* Handle user-created local variables. */
1845 /* If var is set up for a buffer that lacks a local value for it,
1846 the current value is nominally the default value.
1847 But the current value slot may be more up to date, since
1848 ordinary setq stores just that slot. So use that. */
1849 if (NILP (bfwd->current_alist_element))
1850 return do_symval_forwarding (bfwd->current_value, current_buffer,
1851 XCONSOLE (Vselected_console));
1853 return bfwd->default_value;
1856 /* For other variables, get the current value. */
1857 return do_symval_forwarding (valcontents, current_buffer,
1858 XCONSOLE (Vselected_console));
1861 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
1864 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /*
1865 Return t if SYMBOL has a non-void default value.
1866 This is the value that is seen in buffers that do not have their own values
1871 return UNBOUNDP (default_value (sym)) ? Qnil : Qt;
1874 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /*
1875 Return SYMBOL's default value.
1876 This is the value that is seen in buffers that do not have their own values
1877 for this variable. The default value is meaningful for variables with
1878 local bindings in certain buffers.
1882 Lisp_Object value = default_value (sym);
1884 return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (sym)) : value;
1887 DEFUN ("set-default", Fset_default, 2, 2, 0, /*
1888 Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.
1889 The default value is seen in buffers that do not have their own values
1894 Lisp_Object valcontents;
1899 valcontents = XSYMBOL (sym)->value;
1902 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1903 return Fset (sym, value);
1905 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1907 case SYMVAL_LISP_MAGIC:
1908 RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (sym, Qset_default, 1,
1910 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1914 case SYMVAL_VARALIAS:
1915 sym = follow_varalias_pointers (sym, Qset_default);
1916 /* presto change-o! */
1919 case SYMVAL_CURRENT_BUFFER_FORWARD:
1920 set_default_buffer_slot_variable (sym, value);
1923 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1924 set_default_console_slot_variable (sym, value);
1927 case SYMVAL_BUFFER_LOCAL:
1928 case SYMVAL_SOME_BUFFER_LOCAL:
1930 /* Store new value into the DEFAULT-VALUE slot */
1931 struct symbol_value_buffer_local *bfwd
1932 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1934 bfwd->default_value = value;
1935 /* If current-buffer doesn't shadow default_value,
1936 * we must set the CURRENT-VALUE slot too */
1937 if (NILP (bfwd->current_alist_element))
1938 store_symval_forwarding (sym, bfwd->current_value, value);
1943 return Fset (sym, value);
1945 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
1948 DEFUN ("setq-default", Fsetq_default, 2, UNEVALLED, 0, /*
1949 Set the default value of variable SYM to VALUE.
1950 SYM, the variable name, is literal (not evaluated);
1951 VALUE is an expression and it is evaluated.
1952 The default value of a variable is seen in buffers
1953 that do not have their own values for the variable.
1955 More generally, you can use multiple variables and values, as in
1956 (setq-default SYM VALUE SYM VALUE...)
1957 This sets each SYM's default value to the corresponding VALUE.
1958 The VALUE for the Nth SYM can refer to the new default values
1963 /* This function can GC */
1964 Lisp_Object args_left;
1965 Lisp_Object val, sym;
1966 struct gcpro gcpro1;
1976 val = Feval (Fcar (Fcdr (args_left)));
1977 sym = Fcar (args_left);
1978 Fset_default (sym, val);
1979 args_left = Fcdr (Fcdr (args_left));
1981 while (!NILP (args_left));
1987 /* Lisp functions for creating and removing buffer-local variables. */
1989 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1,
1990 "vMake Variable Buffer Local: ", /*
1991 Make VARIABLE have a separate value for each buffer.
1992 At any time, the value for the current buffer is in effect.
1993 There is also a default value which is seen in any buffer which has not yet
1995 Using `set' or `setq' to set the variable causes it to have a separate value
1996 for the current buffer if it was previously using the default value.
1997 The function `default-value' gets the default value and `set-default'
2002 Lisp_Object valcontents;
2004 CHECK_SYMBOL (variable);
2007 verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
2009 valcontents = XSYMBOL (variable)->value;
2012 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2014 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2016 case SYMVAL_LISP_MAGIC:
2017 if (!UNBOUNDP (maybe_call_magic_handler
2018 (variable, Qmake_variable_buffer_local, 0)))
2020 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2024 case SYMVAL_VARALIAS:
2025 variable = follow_varalias_pointers (variable,
2026 Qmake_variable_buffer_local);
2027 /* presto change-o! */
2030 case SYMVAL_FIXNUM_FORWARD:
2031 case SYMVAL_BOOLEAN_FORWARD:
2032 case SYMVAL_OBJECT_FORWARD:
2033 case SYMVAL_UNBOUND_MARKER:
2036 case SYMVAL_CURRENT_BUFFER_FORWARD:
2037 case SYMVAL_BUFFER_LOCAL:
2038 /* Already per-each-buffer */
2041 case SYMVAL_SOME_BUFFER_LOCAL:
2043 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
2044 SYMVAL_BUFFER_LOCAL;
2053 struct symbol_value_buffer_local *bfwd
2054 = alloc_lcrecord_type (struct symbol_value_buffer_local,
2055 lrecord_symbol_value_buffer_local);
2057 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2059 bfwd->default_value = find_symbol_value (variable);
2060 bfwd->current_value = valcontents;
2061 bfwd->current_alist_element = Qnil;
2062 bfwd->current_buffer = Fcurrent_buffer ();
2063 XSETSYMBOL_VALUE_MAGIC (foo, bfwd);
2064 *value_slot_past_magic (variable) = foo;
2065 #if 1 /* #### Yuck! FSFmacs bug-compatibility*/
2066 /* This sets the default-value of any make-variable-buffer-local to nil.
2067 That just sucks. User can just use setq-default to effect that,
2068 but there's no way to do makunbound-default to undo this lossage. */
2069 if (UNBOUNDP (valcontents))
2070 bfwd->default_value = Qnil;
2072 #if 0 /* #### Yuck! */
2073 /* This sets the value to nil in this buffer.
2074 User could use (setq variable nil) to do this.
2075 It isn't as egregious to do this automatically
2076 as it is to do so to the default-value, but it's
2077 still really dubious. */
2078 if (UNBOUNDP (valcontents))
2079 Fset (variable, Qnil);
2085 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1,
2086 "vMake Local Variable: ", /*
2087 Make VARIABLE have a separate value in the current buffer.
2088 Other buffers will continue to share a common default value.
2089 \(The buffer-local value of VARIABLE starts out as the same value
2090 VARIABLE previously had. If VARIABLE was void, it remains void.)
2091 See also `make-variable-buffer-local'.
2093 If the variable is already arranged to become local when set,
2094 this function causes a local value to exist for this buffer,
2095 just as setting the variable would do.
2097 Do not use `make-local-variable' to make a hook variable buffer-local.
2098 Use `make-local-hook' instead.
2102 Lisp_Object valcontents;
2103 struct symbol_value_buffer_local *bfwd;
2105 CHECK_SYMBOL (variable);
2108 verify_ok_for_buffer_local (variable, Qmake_local_variable);
2110 valcontents = XSYMBOL (variable)->value;
2113 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2115 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2117 case SYMVAL_LISP_MAGIC:
2118 if (!UNBOUNDP (maybe_call_magic_handler
2119 (variable, Qmake_local_variable, 0)))
2121 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2125 case SYMVAL_VARALIAS:
2126 variable = follow_varalias_pointers (variable, Qmake_local_variable);
2127 /* presto change-o! */
2130 case SYMVAL_FIXNUM_FORWARD:
2131 case SYMVAL_BOOLEAN_FORWARD:
2132 case SYMVAL_OBJECT_FORWARD:
2133 case SYMVAL_UNBOUND_MARKER:
2136 case SYMVAL_BUFFER_LOCAL:
2137 case SYMVAL_CURRENT_BUFFER_FORWARD:
2139 /* Make sure the symbol has a local value in this particular
2140 buffer, by setting it to the same value it already has. */
2141 Fset (variable, find_symbol_value (variable));
2145 case SYMVAL_SOME_BUFFER_LOCAL:
2147 if (!NILP (buffer_local_alist_element (current_buffer,
2149 (XSYMBOL_VALUE_BUFFER_LOCAL
2151 goto already_local_to_current_buffer;
2153 goto already_local_to_some_other_buffer;
2161 /* Make sure variable is set up to hold per-buffer values */
2162 bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
2163 lrecord_symbol_value_buffer_local);
2164 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2166 bfwd->current_buffer = Qnil;
2167 bfwd->current_alist_element = Qnil;
2168 bfwd->current_value = valcontents;
2169 /* passing 0 is OK because this should never be a
2170 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2172 bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
2175 if (UNBOUNDP (bfwd->default_value))
2176 bfwd->default_value = Qnil; /* Yuck! */
2179 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
2180 *value_slot_past_magic (variable) = valcontents;
2182 already_local_to_some_other_buffer:
2184 /* Make sure this buffer has its own value of variable */
2185 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2187 if (UNBOUNDP (bfwd->default_value))
2189 /* If default value is unbound, set local value to nil. */
2190 XSETBUFFER (bfwd->current_buffer, current_buffer);
2191 bfwd->current_alist_element = Fcons (variable, Qnil);
2192 current_buffer->local_var_alist =
2193 Fcons (bfwd->current_alist_element, current_buffer->local_var_alist);
2194 store_symval_forwarding (variable, bfwd->current_value, Qnil);
2198 current_buffer->local_var_alist
2199 = Fcons (Fcons (variable, bfwd->default_value),
2200 current_buffer->local_var_alist);
2202 /* Make sure symbol does not think it is set up for this buffer;
2203 force it to look once again for this buffer's value */
2204 if (!NILP (bfwd->current_buffer) &&
2205 current_buffer == XBUFFER (bfwd->current_buffer))
2206 bfwd->current_buffer = Qnil;
2208 already_local_to_current_buffer:
2210 /* If the symbol forwards into a C variable, then swap in the
2211 variable for this buffer immediately. If C code modifies the
2212 variable before we swap in, then that new value will clobber the
2213 default value the next time we swap. */
2214 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2215 if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value))
2217 switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
2219 case SYMVAL_FIXNUM_FORWARD:
2220 case SYMVAL_BOOLEAN_FORWARD:
2221 case SYMVAL_OBJECT_FORWARD:
2222 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2223 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2226 case SYMVAL_UNBOUND_MARKER:
2227 case SYMVAL_CURRENT_BUFFER_FORWARD:
2238 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1,
2239 "vKill Local Variable: ", /*
2240 Make VARIABLE no longer have a separate value in the current buffer.
2241 From now on the default value will apply in this buffer.
2245 Lisp_Object valcontents;
2247 CHECK_SYMBOL (variable);
2250 valcontents = XSYMBOL (variable)->value;
2253 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2256 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2258 case SYMVAL_LISP_MAGIC:
2259 if (!UNBOUNDP (maybe_call_magic_handler
2260 (variable, Qkill_local_variable, 0)))
2262 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2266 case SYMVAL_VARALIAS:
2267 variable = follow_varalias_pointers (variable, Qkill_local_variable);
2268 /* presto change-o! */
2271 case SYMVAL_CURRENT_BUFFER_FORWARD:
2273 CONST struct symbol_value_forward *fwd
2274 = XSYMBOL_VALUE_FORWARD (valcontents);
2275 int offset = ((char *) symbol_value_forward_forward (fwd)
2276 - (char *) &buffer_local_flags);
2278 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2282 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2283 Lisp_Object in_object, int flags) =
2284 symbol_value_forward_magicfun (fwd);
2285 Lisp_Object oldval = * (Lisp_Object *)
2286 (offset + (char *) XBUFFER (Vbuffer_defaults));
2288 (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
2289 *(Lisp_Object *) (offset + (char *) current_buffer)
2291 current_buffer->local_var_flags &= ~mask;
2296 case SYMVAL_BUFFER_LOCAL:
2297 case SYMVAL_SOME_BUFFER_LOCAL:
2299 /* Get rid of this buffer's alist element, if any */
2300 struct symbol_value_buffer_local *bfwd
2301 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2302 Lisp_Object alist = current_buffer->local_var_alist;
2303 Lisp_Object alist_element
2304 = buffer_local_alist_element (current_buffer, variable, bfwd);
2306 if (!NILP (alist_element))
2307 current_buffer->local_var_alist = Fdelq (alist_element, alist);
2309 /* Make sure symbol does not think it is set up for this buffer;
2310 force it to look once again for this buffer's value */
2311 if (!NILP (bfwd->current_buffer) &&
2312 current_buffer == XBUFFER (bfwd->current_buffer))
2313 bfwd->current_buffer = Qnil;
2315 /* We just changed the value in the current_buffer. If this
2316 variable forwards to a C variable, we need to change the
2317 value of the C variable. set_up_buffer_local_cache()
2318 will do this. It doesn't hurt to do it always,
2319 so just go ahead and do that. */
2320 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2327 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2331 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2332 "vKill Console Local Variable: ", /*
2333 Make VARIABLE no longer have a separate value in the selected console.
2334 From now on the default value will apply in this console.
2338 Lisp_Object valcontents;
2340 CHECK_SYMBOL (variable);
2343 valcontents = XSYMBOL (variable)->value;
2346 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2349 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2351 case SYMVAL_LISP_MAGIC:
2352 if (!UNBOUNDP (maybe_call_magic_handler
2353 (variable, Qkill_console_local_variable, 0)))
2355 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2359 case SYMVAL_VARALIAS:
2360 variable = follow_varalias_pointers (variable,
2361 Qkill_console_local_variable);
2362 /* presto change-o! */
2365 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2367 CONST struct symbol_value_forward *fwd
2368 = XSYMBOL_VALUE_FORWARD (valcontents);
2369 int offset = ((char *) symbol_value_forward_forward (fwd)
2370 - (char *) &console_local_flags);
2372 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2376 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2377 Lisp_Object in_object, int flags) =
2378 symbol_value_forward_magicfun (fwd);
2379 Lisp_Object oldval = * (Lisp_Object *)
2380 (offset + (char *) XCONSOLE (Vconsole_defaults));
2382 (magicfun) (variable, &oldval, Vselected_console, 0);
2383 *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
2385 XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
2393 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2396 /* Used by specbind to determine what effects it might have. Returns:
2397 * 0 if symbol isn't buffer-local, and wouldn't be after it is set
2398 * <0 if symbol isn't presently buffer-local, but set would make it so
2399 * >0 if symbol is presently buffer-local
2402 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
2404 Lisp_Object valcontents;
2407 valcontents = XSYMBOL (symbol)->value;
2410 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2412 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2414 case SYMVAL_LISP_MAGIC:
2416 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2420 case SYMVAL_VARALIAS:
2421 symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
2422 /* presto change-o! */
2425 case SYMVAL_CURRENT_BUFFER_FORWARD:
2427 CONST struct symbol_value_forward *fwd
2428 = XSYMBOL_VALUE_FORWARD (valcontents);
2429 int mask = XINT (*((Lisp_Object *)
2430 symbol_value_forward_forward (fwd)));
2431 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
2432 /* Already buffer-local */
2435 /* Would be buffer-local after set */
2438 case SYMVAL_BUFFER_LOCAL:
2439 case SYMVAL_SOME_BUFFER_LOCAL:
2441 struct symbol_value_buffer_local *bfwd
2442 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2444 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
2447 /* Automatically becomes local when set */
2448 return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
2458 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2459 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2461 (symbol, buffer, unbound_value))
2464 CHECK_SYMBOL (symbol);
2465 CHECK_BUFFER (buffer);
2466 value = symbol_value_in_buffer (symbol, buffer);
2467 if (UNBOUNDP (value))
2468 return unbound_value;
2473 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2474 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2476 (symbol, console, unbound_value))
2479 CHECK_SYMBOL (symbol);
2480 CHECK_CONSOLE (console);
2481 value = symbol_value_in_console (symbol, console);
2482 if (UNBOUNDP (value))
2483 return unbound_value;
2488 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
2489 If SYM is a built-in variable, return info about this; else return nil.
2490 The returned info will be a symbol, one of
2492 `object' A simple built-in variable.
2493 `const-object' Same, but cannot be set.
2494 `integer' A built-in integer variable.
2495 `const-integer' Same, but cannot be set.
2496 `boolean' A built-in boolean variable.
2497 `const-boolean' Same, but cannot be set.
2498 `const-specifier' Always contains a specifier; e.g. `has-modeline-p'.
2499 `current-buffer' A built-in buffer-local variable.
2500 `const-current-buffer' Same, but cannot be set.
2501 `default-buffer' Forwards to the default value of a built-in
2502 buffer-local variable.
2503 `selected-console' A built-in console-local variable.
2504 `const-selected-console' Same, but cannot be set.
2505 `default-console' Forwards to the default value of a built-in
2506 console-local variable.
2510 REGISTER Lisp_Object valcontents;
2515 valcontents = XSYMBOL (sym)->value;
2518 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 sym = follow_varalias_pointers (sym, 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:
2542 case SYMVAL_CONST_FIXNUM_FORWARD:
2543 return Qconst_integer;
2545 case SYMVAL_BOOLEAN_FORWARD:
2548 case SYMVAL_CONST_BOOLEAN_FORWARD:
2549 return Qconst_boolean;
2551 case SYMVAL_OBJECT_FORWARD:
2554 case SYMVAL_CONST_OBJECT_FORWARD:
2555 return Qconst_object;
2557 case SYMVAL_CONST_SPECIFIER_FORWARD:
2558 return Qconst_specifier;
2560 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2561 return Qdefault_buffer;
2563 case SYMVAL_CURRENT_BUFFER_FORWARD:
2564 return Qcurrent_buffer;
2566 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2567 return Qconst_current_buffer;
2569 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2570 return Qdefault_console;
2572 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2573 return Qselected_console;
2575 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2576 return Qconst_selected_console;
2578 case SYMVAL_UNBOUND_MARKER:
2590 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
2591 Return t if SYMBOL's value is local to BUFFER.
2592 If optional third arg AFTER-SET is true, return t if SYMBOL would be
2593 buffer-local after it is set, regardless of whether it is so presently.
2594 A nil value for BUFFER is *not* the same as (current-buffer), but means
2595 "no buffer". Specifically:
2597 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
2598 the variable is one of the special built-in variables that is always
2599 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
2600 `buffer-undo-list', and others.)
2602 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
2603 the variable has had `make-variable-buffer-local' applied to it.
2605 (symbol, buffer, after_set))
2609 CHECK_SYMBOL (symbol);
2612 buffer = get_buffer (buffer, 1);
2613 local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
2617 local_info = symbol_value_buffer_local_info (symbol, 0);
2620 if (NILP (after_set))
2621 return local_info > 0 ? Qt : Qnil;
2623 return local_info != 0 ? Qt : Qnil;
2628 I've gone ahead and partially implemented this because it's
2629 super-useful for dealing with the compatibility problems in supporting
2630 the old pointer-shape variables, and preventing people from `setq'ing
2631 the new variables. Any other way of handling this problem is way
2632 ugly, likely to be slow, and generally not something I want to waste
2633 my time worrying about.
2635 The interface and/or function name is sure to change before this
2636 gets into its final form. I currently like the way everything is
2637 set up and it has all the features I want it to have, except for
2638 one: I really want to be able to have multiple nested handlers,
2639 to implement an `advice'-like capabiility. This would allow,
2640 for example, a clean way of implementing `debug-if-set' or
2641 `debug-if-referenced' and such.
2643 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
2644 ************************************************************
2645 **Only** the `set-value', `make-unbound', and `make-local'
2646 handler types are currently implemented. Implementing the
2647 get-value and bound-predicate handlers is somewhat tricky
2648 because there are lots of subfunctions (e.g. find_symbol_value()).
2649 find_symbol_value(), in fact, is called from outside of
2650 this module. You'd have to have it do this:
2652 -- check for a `bound-predicate' handler, call that if so;
2653 if it returns nil, return Qunbound
2654 -- check for a `get-value' handler and call it and return
2657 It gets even trickier when you have to deal with
2658 sub-subfunctions like find_symbol_value_1(), and esp.
2659 when you have to properly handle variable aliases, which
2660 can lead to lots of tricky situations. So I've just
2661 punted on this, since the interface isn't officially
2662 exported and we can get by with just a `set-value'
2665 Actions in unimplemented handler types will correctly
2666 ignore any handlers, and will not fuck anything up or
2669 WARNING WARNING: If you do go and implement another
2670 type of handler, make *sure* to change
2671 would_be_magic_handled() so it knows about this,
2672 or dire things could result.
2673 ************************************************************
2674 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
2676 Real documentation is as follows.
2678 Set a magic handler for VARIABLE.
2679 This allows you to specify arbitrary behavior that results from
2680 accessing or setting a variable. For example, retrieving the
2681 variable's value might actually retrieve the first element off of
2682 a list stored in another variable, and setting the variable's value
2683 might add an element to the front of that list. (This is how the
2684 obsolete variable `unread-command-event' is implemented.)
2686 In general it is NOT good programming practice to use magic variables
2687 in a new package that you are designing. If you feel the need to
2688 do this, it's almost certainly a sign that you should be using a
2689 function instead of a variable. This facility is provided to allow
2690 a package to support obsolete variables and provide compatibility
2691 with similar packages with different variable names and semantics.
2692 By using magic handlers, you can cleanly provide obsoleteness and
2693 compatibility support and separate this support from the core
2694 routines in a package.
2696 VARIABLE should be a symbol naming the variable for which the
2697 magic behavior is provided. HANDLER-TYPE is a symbol specifying
2698 which behavior is being controlled, and HANDLER is the function
2699 that will be called to control this behavior. HARG is a
2700 value that will be passed to HANDLER but is otherwise
2701 uninterpreted. KEEP-EXISTING specifies what to do with existing
2702 handlers of the same type; nil means "erase them all", t means
2703 "keep them but insert at the beginning", the list (t) means
2704 "keep them but insert at the end", a function means "keep
2705 them but insert before the specified function", a list containing
2706 a function means "keep them but insert after the specified
2709 You can specify magic behavior for any type of variable at all,
2710 and for any handler types that are unspecified, the standard
2711 behavior applies. This allows you, for example, to use
2712 `defvaralias' in conjunction with this function. (For that
2713 matter, `defvaralias' could be implemented using this function.)
2715 The behaviors that can be specified in HANDLER-TYPE are
2717 get-value (SYM ARGS FUN HARG HANDLERS)
2718 This means that one of the functions `symbol-value',
2719 `default-value', `symbol-value-in-buffer', or
2720 `symbol-value-in-console' was called on SYM.
2722 set-value (SYM ARGS FUN HARG HANDLERS)
2723 This means that one of the functions `set' or `set-default'
2726 bound-predicate (SYM ARGS FUN HARG HANDLERS)
2727 This means that one of the functions `boundp', `globally-boundp',
2728 or `default-boundp' was called on SYM.
2730 make-unbound (SYM ARGS FUN HARG HANDLERS)
2731 This means that the function `makunbound' was called on SYM.
2733 local-predicate (SYM ARGS FUN HARG HANDLERS)
2734 This means that the function `local-variable-p' was called
2737 make-local (SYM ARGS FUN HARG HANDLERS)
2738 This means that one of the functions `make-local-variable',
2739 `make-variable-buffer-local', `kill-local-variable',
2740 or `kill-console-local-variable' was called on SYM.
2742 The meanings of the arguments are as follows:
2744 SYM is the symbol on which the function was called, and is always
2745 the first argument to the function.
2747 ARGS are the remaining arguments in the original call (i.e. all
2748 but the first). In the case of `set-value' in particular,
2749 the first element of ARGS is the value to which the variable
2750 is being set. In some cases, ARGS is sanitized from what was
2751 actually given. For example, whenever `nil' is passed to an
2752 argument and it means `current-buffer', the current buffer is
2753 substituted instead.
2755 FUN is a symbol indicating which function is being called.
2756 For many of the functions, you can determine the corresponding
2757 function of a different class using
2758 `symbol-function-corresponding-function'.
2760 HARG is the argument that was given in the call
2761 to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
2763 HANDLERS is a structure containing the remaining handlers
2764 for the variable; to call one of them, use
2765 `chain-to-symbol-value-handler'.
2767 NOTE: You may *not* modify the list in ARGS, and if you want to
2768 keep it around after the handler function exits, you must make
2769 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
2772 static enum lisp_magic_handler
2773 decode_magic_handler_type (Lisp_Object symbol)
2775 if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE;
2776 if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE;
2777 if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE;
2778 if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND;
2779 if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE;
2780 if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL;
2782 signal_simple_error ("Unrecognized symbol value handler type", symbol);
2784 return MAGIC_HANDLER_MAX;
2787 static enum lisp_magic_handler
2788 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
2790 if (EQ (funsym, Qsymbol_value)
2791 || EQ (funsym, Qdefault_value)
2792 || EQ (funsym, Qsymbol_value_in_buffer)
2793 || EQ (funsym, Qsymbol_value_in_console))
2794 return MAGIC_HANDLER_GET_VALUE;
2796 if (EQ (funsym, Qset)
2797 || EQ (funsym, Qset_default))
2798 return MAGIC_HANDLER_SET_VALUE;
2800 if (EQ (funsym, Qboundp)
2801 || EQ (funsym, Qglobally_boundp)
2802 || EQ (funsym, Qdefault_boundp))
2803 return MAGIC_HANDLER_BOUND_PREDICATE;
2805 if (EQ (funsym, Qmakunbound))
2806 return MAGIC_HANDLER_MAKE_UNBOUND;
2808 if (EQ (funsym, Qlocal_variable_p))
2809 return MAGIC_HANDLER_LOCAL_PREDICATE;
2811 if (EQ (funsym, Qmake_variable_buffer_local)
2812 || EQ (funsym, Qmake_local_variable))
2813 return MAGIC_HANDLER_MAKE_LOCAL;
2815 if (abort_if_not_found)
2817 signal_simple_error ("Unrecognized symbol-value function", funsym);
2818 return MAGIC_HANDLER_MAX;
2822 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
2824 /* does not take into account variable aliasing. */
2825 Lisp_Object valcontents = XSYMBOL (sym)->value;
2826 enum lisp_magic_handler slot;
2828 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2830 slot = handler_type_from_function_symbol (funsym, 1);
2831 if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND
2832 && slot != MAGIC_HANDLER_MAKE_LOCAL)
2833 /* #### temporary kludge because we haven't implemented
2834 lisp-magic variables completely */
2836 return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
2840 fetch_value_maybe_past_magic (Lisp_Object sym,
2841 Lisp_Object follow_past_lisp_magic)
2843 Lisp_Object value = XSYMBOL (sym)->value;
2844 if (SYMBOL_VALUE_LISP_MAGIC_P (value)
2845 && (EQ (follow_past_lisp_magic, Qt)
2846 || (!NILP (follow_past_lisp_magic)
2847 && !would_be_magic_handled (sym, follow_past_lisp_magic))))
2848 value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed;
2852 static Lisp_Object *
2853 value_slot_past_magic (Lisp_Object sym)
2855 Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
2857 if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
2858 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
2859 return store_pointer;
2863 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
2866 Lisp_Object args[20]; /* should be enough ... */
2868 enum lisp_magic_handler htype;
2869 Lisp_Object legerdemain;
2870 struct symbol_value_lisp_magic *bfwd;
2872 assert (nargs >= 0 && nargs < 20);
2873 legerdemain = XSYMBOL (sym)->value;
2874 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2875 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2877 va_start (vargs, nargs);
2878 for (i = 0; i < nargs; i++)
2879 args[i] = va_arg (vargs, Lisp_Object);
2882 htype = handler_type_from_function_symbol (funsym, 1);
2883 if (NILP (bfwd->handler[htype]))
2885 /* #### should be reusing the arglist, not always consing anew.
2886 Repeated handler invocations should not cause repeated consing.
2887 Doesn't matter for now, because this is just a quick implementation
2888 for obsolescence support. */
2889 return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym,
2890 bfwd->harg[htype], Qnil);
2893 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
2895 Don't you dare use this.
2896 If you do, suffer the wrath of Ben, who is likely to rename
2897 this function (or change the semantics of its arguments) without
2898 pity, thereby invalidating your code.
2900 (variable, handler_type, handler, harg, keep_existing))
2902 Lisp_Object valcontents;
2903 struct symbol_value_lisp_magic *bfwd;
2904 enum lisp_magic_handler htype;
2907 /* #### WARNING, only some handler types are implemented. See above.
2908 Actions of other types will ignore a handler if it's there.
2910 #### Also, `chain-to-symbol-value-handler' and
2911 `symbol-function-corresponding-function' are not implemented. */
2912 CHECK_SYMBOL (variable);
2913 CHECK_SYMBOL (handler_type);
2914 htype = decode_magic_handler_type (handler_type);
2915 valcontents = XSYMBOL (variable)->value;
2916 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2918 bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
2919 lrecord_symbol_value_lisp_magic);
2920 bfwd->magic.type = SYMVAL_LISP_MAGIC;
2921 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2923 bfwd->handler[i] = Qnil;
2924 bfwd->harg[i] = Qnil;
2926 bfwd->shadowed = valcontents;
2927 XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
2930 bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
2931 bfwd->handler[htype] = handler;
2932 bfwd->harg[htype] = harg;
2934 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2935 if (!NILP (bfwd->handler[i]))
2938 if (i == MAGIC_HANDLER_MAX)
2939 /* there are no remaining handlers, so remove the structure. */
2940 XSYMBOL (variable)->value = bfwd->shadowed;
2946 /* functions for working with variable aliases. */
2948 /* Follow the chain of variable aliases for OBJECT. Return the
2949 resulting symbol, whose value cell is guaranteed not to be a
2950 symbol-value-varalias.
2952 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
2953 If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
2954 never follow; stop right there. Otherwise FUNSYM should be a
2955 recognized symbol-value function symbol; this means, follow
2956 unless there is a special handler for the named function.
2958 OK, there is at least one reason why it's necessary for
2959 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
2960 can always be sure to catch cyclic variable aliasing. If we never
2961 follow past Lisp magic, then if the following is done:
2964 add some magic behavior to a, but not a "get-value" handler
2967 then an attempt to retrieve a's or b's value would cause infinite
2968 looping in `symbol-value'.
2970 We (of course) can't always follow past Lisp magic, because then
2971 we make any variable that is lisp-magic -> varalias behave as if
2972 the lisp-magic is not present at all.
2976 follow_varalias_pointers (Lisp_Object object,
2977 Lisp_Object follow_past_lisp_magic)
2979 Lisp_Object tortoise = object;
2980 Lisp_Object hare = object;
2982 /* quick out just in case */
2983 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (object)->value))
2986 /* based off of indirect_function() */
2991 value = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic);
2992 if (!SYMBOL_VALUE_VARALIAS_P (value))
2994 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (value));
2995 value = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic);
2996 if (!SYMBOL_VALUE_VARALIAS_P (value))
2998 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (value));
3000 value = fetch_value_maybe_past_magic (tortoise, follow_past_lisp_magic);
3001 tortoise = symbol_value_varalias_aliasee
3002 (XSYMBOL_VALUE_VARALIAS (value));
3004 if (EQ (hare, tortoise))
3005 return Fsignal (Qcyclic_variable_indirection, list1 (object));
3011 DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
3012 Define a variable as an alias for another variable.
3013 Thenceforth, any operations performed on VARIABLE will actually be
3014 performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
3015 If ALIAS is nil, remove any aliases for VARIABLE.
3016 ALIAS can itself be aliased, and the chain of variable aliases
3017 will be followed appropriately.
3018 If VARIABLE already has a value, this value will be shadowed
3019 until the alias is removed, at which point it will be restored.
3020 Currently VARIABLE cannot be a built-in variable, a variable that
3021 has a buffer-local value in any buffer, or the symbols nil or t.
3022 \(ALIAS, however, can be any type of variable.)
3026 struct symbol_value_varalias *bfwd;
3027 Lisp_Object valcontents;
3029 CHECK_SYMBOL (variable);
3030 reject_constant_symbols (variable, Qunbound, 0, Qt);
3032 valcontents = XSYMBOL (variable)->value;
3036 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3038 XSYMBOL (variable)->value =
3039 symbol_value_varalias_shadowed
3040 (XSYMBOL_VALUE_VARALIAS (valcontents));
3045 CHECK_SYMBOL (alias);
3046 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3049 XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
3053 if (SYMBOL_VALUE_MAGIC_P (valcontents)
3054 && !UNBOUNDP (valcontents))
3055 signal_simple_error ("Variable is magic and cannot be aliased", variable);
3056 reject_constant_symbols (variable, Qunbound, 0, Qt);
3058 bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
3059 lrecord_symbol_value_varalias);
3060 bfwd->magic.type = SYMVAL_VARALIAS;
3061 bfwd->aliasee = alias;
3062 bfwd->shadowed = valcontents;
3064 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
3065 XSYMBOL (variable)->value = valcontents;
3069 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
3070 If VARIABLE is aliased to another variable, return that variable.
3071 VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
3072 Variable aliases are created with `defvaralias'. See also
3073 `indirect-variable'.
3075 (variable, follow_past_lisp_magic))
3077 Lisp_Object valcontents;
3079 CHECK_SYMBOL (variable);
3080 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3082 CHECK_SYMBOL (follow_past_lisp_magic);
3083 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3086 valcontents = fetch_value_maybe_past_magic (variable,
3087 follow_past_lisp_magic);
3089 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3090 return symbol_value_varalias_aliasee
3091 (XSYMBOL_VALUE_VARALIAS (valcontents));
3096 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /*
3097 Return the variable at the end of OBJECT's variable-alias chain.
3098 If OBJECT is a symbol, follow all variable aliases and return
3099 the final (non-aliased) symbol. Variable aliases are created with
3100 the function `defvaralias'.
3101 If OBJECT is not a symbol, just return it.
3102 Signal a cyclic-variable-indirection error if there is a loop in the
3103 variable chain of symbols.
3105 (object, follow_past_lisp_magic))
3107 if (!SYMBOLP (object))
3109 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3111 CHECK_SYMBOL (follow_past_lisp_magic);
3112 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3114 return follow_varalias_pointers (object, follow_past_lisp_magic);
3118 /************************************************************************/
3119 /* initialization */
3120 /************************************************************************/
3122 /* A dumped XEmacs image has a lot more than 1511 symbols. Last
3123 estimate was that there were actually around 6300. So let's try
3124 making this bigger and see if we get better hashing behavior. */
3125 #define OBARRAY_SIZE 16411
3130 #ifndef Qnull_pointer
3131 Lisp_Object Qnull_pointer;
3134 /* some losing systems can't have static vars at function scope... */
3135 static struct symbol_value_magic guts_of_unbound_marker =
3136 { { symbol_value_forward_lheader_initializer, 0, 69},
3137 SYMVAL_UNBOUND_MARKER };
3139 Lisp_Object Vpure_uninterned_symbol_table;
3142 init_symbols_once_early (void)
3145 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3148 #ifndef Qnull_pointer
3149 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3150 so the following is a actually a no-op. */
3151 XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
3154 /* see comment in Fpurecopy() */
3155 Vpure_uninterned_symbol_table =
3156 make_lisp_hashtable (50, HASHTABLE_NONWEAK, HASHTABLE_EQ);
3157 staticpro (&Vpure_uninterned_symbol_table);
3159 Qnil = Fmake_symbol (make_pure_pname ((CONST Bufbyte *) "nil", 3, 1));
3160 /* Bootstrapping problem: Qnil isn't set when make_pure_pname is
3161 called the first time. */
3162 XSYMBOL (Qnil)->name->plist = Qnil;
3163 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
3164 XSYMBOL (Qnil)->plist = Qnil;
3166 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3167 initial_obarray = Vobarray;
3168 staticpro (&initial_obarray);
3169 /* Intern nil in the obarray */
3171 int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
3172 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3173 XSYMBOL (Qnil)->obarray = Qt;
3177 /* Required to get around a GCC syntax error on certain
3179 struct symbol_value_magic *tem = &guts_of_unbound_marker;
3181 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3183 if ((CONST void *) XPNTR (Qunbound) !=
3184 (CONST void *)&guts_of_unbound_marker)
3186 /* This might happen on DATA_SEG_BITS machines. */
3188 /* Can't represent a pointer to constant C data using a Lisp_Object.
3189 So heap-allocate it. */
3190 struct symbol_value_magic *urk = xnew (struct symbol_value_magic);
3191 memcpy (urk, &guts_of_unbound_marker, sizeof (*urk));
3192 XSETSYMBOL_VALUE_MAGIC (Qunbound, urk);
3195 XSYMBOL (Qnil)->function = Qunbound;
3197 defsymbol (&Qt, "t");
3198 XSYMBOL (Qt)->value = Qt; /* Veritas aetera */
3203 defsymbol (Lisp_Object *location, CONST char *name)
3205 *location = Fintern (make_pure_pname ((CONST Bufbyte *) name,
3208 staticpro (location);
3212 defkeyword (Lisp_Object *location, CONST char *name)
3214 defsymbol (location, name);
3215 Fset (*location, *location);
3219 defsubr (struct Lisp_Subr *subr)
3221 Lisp_Object sym = intern (subr_name (subr));
3224 /* Check that nobody spazzed writing a DEFUN. */
3225 assert (subr->min_args >= 0);
3226 assert (subr->min_args <= SUBR_MAX_ARGS);
3228 if (subr->max_args != MANY && subr->max_args != UNEVALLED)
3230 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3231 assert (subr->max_args <= SUBR_MAX_ARGS);
3232 assert (subr->min_args <= subr->max_args);
3235 assert (UNBOUNDP (XSYMBOL (sym)->function));
3236 #endif /* DEBUG_XEMACS */
3238 XSETSUBR (XSYMBOL (sym)->function, subr);
3242 deferror (Lisp_Object *symbol, CONST char *name, CONST char *messuhhj,
3243 Lisp_Object inherits_from)
3246 defsymbol (symbol, name);
3248 assert (SYMBOLP (inherits_from));
3249 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3250 pure_put (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3251 /* NOT build_translated_string (). This function is called at load time
3252 and the string needs to get translated at run time. (This happens
3253 in the function (display-error) in cmdloop.el.) */
3254 pure_put (*symbol, Qerror_message, build_string (messuhhj));
3258 syms_of_symbols (void)
3260 defsymbol (&Qvariable_documentation, "variable-documentation");
3261 defsymbol (&Qvariable_domain, "variable-domain"); /* I18N3 */
3262 defsymbol (&Qad_advice_info, "ad-advice-info");
3263 defsymbol (&Qad_activate, "ad-activate");
3265 defsymbol (&Qget_value, "get-value");
3266 defsymbol (&Qset_value, "set-value");
3267 defsymbol (&Qbound_predicate, "bound-predicate");
3268 defsymbol (&Qmake_unbound, "make-unbound");
3269 defsymbol (&Qlocal_predicate, "local-predicate");
3270 defsymbol (&Qmake_local, "make-local");
3272 defsymbol (&Qboundp, "boundp");
3273 defsymbol (&Qfboundp, "fboundp");
3274 defsymbol (&Qglobally_boundp, "globally-boundp");
3275 defsymbol (&Qmakunbound, "makunbound");
3276 defsymbol (&Qsymbol_value, "symbol-value");
3277 defsymbol (&Qset, "set");
3278 defsymbol (&Qdefault_boundp, "default-boundp");
3279 defsymbol (&Qdefault_value, "default-value");
3280 defsymbol (&Qset_default, "set-default");
3281 defsymbol (&Qmake_variable_buffer_local, "make-variable-buffer-local");
3282 defsymbol (&Qmake_local_variable, "make-local-variable");
3283 defsymbol (&Qkill_local_variable, "kill-local-variable");
3284 defsymbol (&Qkill_console_local_variable, "kill-console-local-variable");
3285 defsymbol (&Qsymbol_value_in_buffer, "symbol-value-in-buffer");
3286 defsymbol (&Qsymbol_value_in_console, "symbol-value-in-console");
3287 defsymbol (&Qlocal_variable_p, "local-variable-p");
3289 defsymbol (&Qconst_integer, "const-integer");
3290 defsymbol (&Qconst_boolean, "const-boolean");
3291 defsymbol (&Qconst_object, "const-object");
3292 defsymbol (&Qconst_specifier, "const-specifier");
3293 defsymbol (&Qdefault_buffer, "default-buffer");
3294 defsymbol (&Qcurrent_buffer, "current-buffer");
3295 defsymbol (&Qconst_current_buffer, "const-current-buffer");
3296 defsymbol (&Qdefault_console, "default-console");
3297 defsymbol (&Qselected_console, "selected-console");
3298 defsymbol (&Qconst_selected_console, "const-selected-console");
3301 DEFSUBR (Fintern_soft);
3302 DEFSUBR (Funintern);
3303 DEFSUBR (Fmapatoms);
3304 DEFSUBR (Fapropos_internal);
3306 DEFSUBR (Fsymbol_function);
3307 DEFSUBR (Fsymbol_plist);
3308 DEFSUBR (Fsymbol_name);
3309 DEFSUBR (Fmakunbound);
3310 DEFSUBR (Ffmakunbound);
3312 DEFSUBR (Fglobally_boundp);
3315 DEFSUBR (Fdefine_function);
3316 DEFSUBR (Fsetplist);
3317 DEFSUBR (Fsymbol_value_in_buffer);
3318 DEFSUBR (Fsymbol_value_in_console);
3319 DEFSUBR (Fbuilt_in_variable_type);
3320 DEFSUBR (Fsymbol_value);
3322 DEFSUBR (Fdefault_boundp);
3323 DEFSUBR (Fdefault_value);
3324 DEFSUBR (Fset_default);
3325 DEFSUBR (Fsetq_default);
3326 DEFSUBR (Fmake_variable_buffer_local);
3327 DEFSUBR (Fmake_local_variable);
3328 DEFSUBR (Fkill_local_variable);
3329 DEFSUBR (Fkill_console_local_variable);
3330 DEFSUBR (Flocal_variable_p);
3331 DEFSUBR (Fdefvaralias);
3332 DEFSUBR (Fvariable_alias);
3333 DEFSUBR (Findirect_variable);
3334 DEFSUBR (Fdontusethis_set_symbol_value_handler);
3337 /* Create and initialize a variable whose value is forwarded to C data */
3339 defvar_mumble (CONST char *namestring, CONST void *magic, size_t sizeof_magic)
3342 Lisp_Object sym = Fintern (make_pure_pname ((CONST Bufbyte *) namestring,
3343 strlen (namestring),
3347 /* Check that magic points somewhere we can represent as a Lisp pointer */
3348 XSETOBJ (kludge, Lisp_Type_Record, magic);
3349 if (magic != (CONST void *) XPNTR (kludge))
3351 /* This might happen on DATA_SEG_BITS machines. */
3353 /* Copy it to somewhere which is representable. */
3354 void *f = xmalloc (sizeof_magic);
3355 memcpy (f, magic, sizeof_magic);
3356 XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, f);
3359 XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic);
3363 vars_of_symbols (void)
3365 DEFVAR_LISP ("obarray", &Vobarray /*
3366 Symbol table for use by `intern' and `read'.
3367 It is a vector whose length ought to be prime for best results.
3368 The vector's contents don't make sense if examined from Lisp programs;
3369 to find all the symbols in an obarray, use `mapatoms'.
3371 /* obarray has been initialized long before */