1 /* "intern" and friends -- moved here from lread.c and data.c
2 Copyright (C) 1985-1989, 1992-1994 Free Software Foundation, Inc.
3 Copyright (C) 1995 Ben Wing.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: FSF 19.30. */
24 /* This file has been Mule-ized. */
28 The value cell of a symbol can contain a simple value or one of
29 various symbol-value-magic objects. Some of these objects can
30 chain into other kinds of objects. Here is a table of possibilities:
34 1c) symbol-value-forward, excluding Qunbound
35 2) symbol-value-buffer-local -> 1a or 1b or 1c
36 3) symbol-value-lisp-magic -> 1a or 1b or 1c
37 4) symbol-value-lisp-magic -> symbol-value-buffer-local -> 1a or 1b or 1c
38 5) symbol-value-varalias
39 6) symbol-value-lisp-magic -> symbol-value-varalias
41 The "chain" of a symbol-value-buffer-local is its current_value slot.
43 The "chain" of a symbol-value-lisp-magic is its shadowed slot, which
44 applies for handler types without associated handlers.
46 All other fields in all the structures (including the "shadowed" slot
47 in a symbol-value-varalias) can *only* contain a simple value or Qunbound.
51 /* #### Ugh, though, this file does awful things with symbol-value-magic
52 objects. This ought to be cleaned up. */
57 #include "buffer.h" /* for Vbuffer_defaults */
61 Lisp_Object Qad_advice_info, Qad_activate;
63 Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound;
64 Lisp_Object Qlocal_predicate, Qmake_local;
66 Lisp_Object Qboundp, Qfboundp, Qglobally_boundp, Qmakunbound;
67 Lisp_Object Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value;
68 Lisp_Object Qset_default, Qsetq_default;
69 Lisp_Object Qmake_variable_buffer_local, Qmake_local_variable;
70 Lisp_Object Qkill_local_variable, Qkill_console_local_variable;
71 Lisp_Object Qsymbol_value_in_buffer, Qsymbol_value_in_console;
72 Lisp_Object Qlocal_variable_p;
74 Lisp_Object Qconst_integer, Qconst_boolean, Qconst_object;
75 Lisp_Object Qconst_specifier;
76 Lisp_Object Qdefault_buffer, Qcurrent_buffer, Qconst_current_buffer;
77 Lisp_Object Qdefault_console, Qselected_console, Qconst_selected_console;
79 static Lisp_Object maybe_call_magic_handler (Lisp_Object sym,
82 static Lisp_Object fetch_value_maybe_past_magic (Lisp_Object sym,
83 Lisp_Object follow_past_lisp_magic);
84 static Lisp_Object *value_slot_past_magic (Lisp_Object sym);
85 static Lisp_Object follow_varalias_pointers (Lisp_Object symbol,
86 Lisp_Object follow_past_lisp_magic);
92 mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object))
94 struct Lisp_Symbol *sym = XSYMBOL (obj);
98 markobj (sym->function);
99 /* No need to mark through ->obarray, because it only holds nil or t. */
100 /* markobj (sym->obarray);*/
101 XSETSTRING (pname, sym->name);
103 if (!symbol_next (sym))
107 markobj (sym->plist);
108 /* Mark the rest of the symbols in the obarray hash-chain */
109 sym = symbol_next (sym);
110 XSETSYMBOL (obj, sym);
115 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
116 mark_symbol, print_symbol, 0, 0, 0,
118 #endif /* LRECORD_SYMBOL */
121 /**********************************************************************/
123 /**********************************************************************/
125 /* #### using a vector here is way bogus. Use a hash table instead. */
127 Lisp_Object Vobarray;
129 static Lisp_Object initial_obarray;
131 /* oblookup stores the bucket number here, for the sake of Funintern. */
133 static int oblookup_last_bucket_number;
136 check_obarray (Lisp_Object obarray)
138 while (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
140 /* If Vobarray is now invalid, force it to be valid. */
141 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
143 obarray = wrong_type_argument (Qvectorp, obarray);
149 intern (CONST char *str)
151 Bytecount len = strlen (str);
152 CONST Bufbyte *buf = (CONST Bufbyte *) str;
153 Lisp_Object obarray = Vobarray;
155 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
156 obarray = check_obarray (obarray);
159 Lisp_Object tem = oblookup (obarray, buf, len);
164 return Fintern ((purify_flag
165 ? make_pure_pname (buf, len, 0)
166 : make_string (buf, len)),
170 DEFUN ("intern", Fintern, 1, 2, 0, /*
171 Return the canonical symbol whose name is STRING.
172 If there is none, one is created by this function and returned.
173 A second optional argument specifies the obarray to use;
174 it defaults to the value of `obarray'.
178 Lisp_Object sym, *ptr;
181 if (NILP (obarray)) obarray = Vobarray;
182 obarray = check_obarray (obarray);
184 CHECK_STRING (string);
186 len = XSTRING_LENGTH (string);
187 sym = oblookup (obarray, XSTRING_DATA (string), len);
192 ptr = &XVECTOR_DATA (obarray)[XINT (sym)];
194 if (purify_flag && ! purified (string))
195 string = make_pure_pname (XSTRING_DATA (string), len, 0);
196 sym = Fmake_symbol (string);
197 /* FSFmacs places OBARRAY here, but it is pointless because we do
198 not mark through this slot, so it is not usable later (because
199 the obarray might have been collected). Marking through the
200 ->obarray slot is an even worse idea, because it would keep
201 obarrays from being collected because of symbols pointed to them.
203 NOTE: We place Qt here only if OBARRAY is actually Vobarray. It
204 is safer to do it this way, to avoid hosing with symbols within
206 if (EQ (obarray, Vobarray))
207 XSYMBOL (sym)->obarray = Qt;
210 symbol_next (XSYMBOL (sym)) = XSYMBOL (*ptr);
212 symbol_next (XSYMBOL (sym)) = 0;
217 DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /*
218 Return the canonical symbol whose name is STRING, or nil if none exists.
219 A second optional argument specifies the obarray to use;
220 it defaults to the value of `obarray'.
226 if (NILP (obarray)) obarray = Vobarray;
227 obarray = check_obarray (obarray);
229 CHECK_STRING (string);
231 tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string));
232 return !INTP (tem) ? tem : Qnil;
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,
296 return the index into OBARRAY that the string hashes to.
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 hash = hash_string (ptr, size) % obsize;
319 oblookup_last_bucket_number = hash;
320 bucket = XVECTOR_DATA (obarray)[hash];
323 else if (!SYMBOLP (bucket))
324 error ("Bad data in guts of obarray"); /* Like CADR error message */
326 for (tail = XSYMBOL (bucket); ;)
328 if (string_length (tail->name) == size &&
329 !memcmp (string_data (tail->name), ptr, size))
331 XSETSYMBOL (bucket, tail);
334 tail = symbol_next (tail);
338 return make_int (hash);
341 #if 0 /* Emacs 19.34 */
343 hash_string (CONST Bufbyte *ptr, Bytecount len)
345 CONST Bufbyte *p = ptr;
346 CONST Bufbyte *end = p + len;
353 if (c >= 0140) c -= 40;
354 hash = ((hash<<3) + (hash>>28) + c);
356 return hash & 07777777777;
360 /* derived from hashpjw, Dragon Book P436. */
362 hash_string (CONST Bufbyte *ptr, Bytecount len)
369 hash = (hash << 4) + *ptr++;
370 g = hash & 0xf0000000;
372 hash = (hash ^ (g >> 24)) ^ g;
374 return hash & 07777777777;
377 /* Map FN over OBARRAY. The mapping is stopped when FN returns a
380 map_obarray (Lisp_Object obarray,
381 int (*fn) (Lisp_Object, void *), void *arg)
385 CHECK_VECTOR (obarray);
386 for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--)
388 Lisp_Object tail = XVECTOR_DATA (obarray)[i];
392 struct Lisp_Symbol *next;
393 if ((*fn) (tail, arg))
395 next = symbol_next (XSYMBOL (tail));
398 XSETSYMBOL (tail, next);
404 mapatoms_1 (Lisp_Object sym, void *arg)
406 call1 (*(Lisp_Object *)arg, sym);
410 DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /*
411 Call FUNCTION on every symbol in OBARRAY.
412 OBARRAY defaults to the value of `obarray'.
418 obarray = check_obarray (obarray);
420 map_obarray (obarray, mapatoms_1, &function);
425 /**********************************************************************/
427 /**********************************************************************/
429 struct appropos_mapper_closure
432 Lisp_Object predicate;
433 Lisp_Object accumulation;
437 apropos_mapper (Lisp_Object symbol, void *arg)
439 struct appropos_mapper_closure *closure =
440 (struct appropos_mapper_closure *) arg;
441 Bytecount match = fast_lisp_string_match (closure->regexp,
442 Fsymbol_name (symbol));
445 (NILP (closure->predicate) ||
446 !NILP (call1 (closure->predicate, symbol))))
447 closure->accumulation = Fcons (symbol, closure->accumulation);
452 DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /*
453 Show all symbols whose names contain match for REGEXP.
454 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL)
455 is done for each symbol and a symbol is mentioned only if that
457 Return list of symbols found.
461 struct appropos_mapper_closure closure;
463 CHECK_STRING (regexp);
465 closure.regexp = regexp;
466 closure.predicate = predicate;
467 closure.accumulation = Qnil;
468 map_obarray (Vobarray, apropos_mapper, &closure);
469 closure.accumulation = Fsort (closure.accumulation, Qstring_lessp);
470 return closure.accumulation;
474 /* Extract and set components of symbols */
476 static void set_up_buffer_local_cache (Lisp_Object sym,
477 struct symbol_value_buffer_local *bfwd,
479 Lisp_Object new_alist_el,
482 DEFUN ("boundp", Fboundp, 1, 1, 0, /*
483 Return t if SYMBOL's value is not void.
487 CHECK_SYMBOL (symbol);
488 return UNBOUNDP (find_symbol_value (symbol)) ? Qnil : Qt;
491 DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /*
492 Return t if SYMBOL has a global (non-bound) value.
493 This is for the byte-compiler; you really shouldn't be using this.
497 CHECK_SYMBOL (symbol);
498 return UNBOUNDP (top_level_value (symbol)) ? Qnil : Qt;
501 DEFUN ("fboundp", Ffboundp, 1, 1, 0, /*
502 Return t if SYMBOL's function definition is not void.
506 CHECK_SYMBOL (symbol);
507 return UNBOUNDP (XSYMBOL (symbol)->function) ? Qnil : Qt;
510 /* Return non-zero if SYM's value or function (the current contents of
511 which should be passed in as VAL) is constant, i.e. unsettable. */
514 symbol_is_constant (Lisp_Object sym, Lisp_Object val)
516 /* #### - I wonder if it would be better to just have a new magic value
517 type and make nil, t, and all keywords have that same magic
518 constant_symbol value. This test is awfully specific about what is
519 constant and what isn't. --Stig */
520 if (EQ (sym, Qnil) ||
524 if (SYMBOL_VALUE_MAGIC_P (val))
525 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
527 case SYMVAL_CONST_OBJECT_FORWARD:
528 case SYMVAL_CONST_SPECIFIER_FORWARD:
529 case SYMVAL_CONST_FIXNUM_FORWARD:
530 case SYMVAL_CONST_BOOLEAN_FORWARD:
531 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
532 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
534 default: break; /* Warning suppression */
537 /* We don't return true for keywords here because they are handled
538 specially by reject_constant_symbols(). */
542 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
543 non-zero) to NEWVAL. Make sure this is allowed.
544 FOLLOW_PAST_LISP_MAGIC specifies whether we delve past
545 symbol-value-lisp-magic objects. */
548 reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p,
549 Lisp_Object follow_past_lisp_magic)
552 (function_p ? XSYMBOL (sym)->function
553 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
555 if (SYMBOL_VALUE_MAGIC_P (val) &&
556 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
557 signal_simple_error ("Use `set-specifier' to change a specifier's value",
560 if (symbol_is_constant (sym, val)
561 || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)
562 && !NILP (XSYMBOL (sym)->obarray)))
563 signal_error (Qsetting_constant,
564 UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
567 /* Verify that it's ok to make SYM buffer-local. This rejects
568 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC
569 specifies whether we delve into symbol-value-lisp-magic objects.
570 (Should be a symbol indicating what action is being taken; that way,
571 we don't delve if there's a handler for that action, but do otherwise.) */
574 verify_ok_for_buffer_local (Lisp_Object sym,
575 Lisp_Object follow_past_lisp_magic)
577 Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic);
579 if (symbol_is_constant (sym, val))
581 if (SYMBOL_VALUE_MAGIC_P (val))
582 switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
584 case SYMVAL_DEFAULT_BUFFER_FORWARD:
585 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
586 /* #### It's theoretically possible for it to be reasonable
587 to have both console-local and buffer-local variables,
588 but I don't want to consider that right now. */
589 case SYMVAL_SELECTED_CONSOLE_FORWARD:
591 default: break; /* Warning suppression */
597 signal_error (Qerror,
598 list2 (build_string ("Symbol may not be buffer-local"), sym));
601 DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /*
602 Make SYMBOL's value be void.
606 Fset (symbol, Qunbound);
610 DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /*
611 Make SYMBOL's function definition be void.
615 CHECK_SYMBOL (symbol);
616 reject_constant_symbols (symbol, Qunbound, 1, Qt);
617 XSYMBOL (symbol)->function = Qunbound;
621 DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /*
622 Return SYMBOL's function definition. Error if that is void.
626 CHECK_SYMBOL (symbol);
627 if (UNBOUNDP (XSYMBOL (symbol)->function))
628 signal_void_function_error (symbol);
629 return XSYMBOL (symbol)->function;
632 DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /*
633 Return SYMBOL's property list.
637 CHECK_SYMBOL (symbol);
638 return XSYMBOL (symbol)->plist;
641 DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /*
642 Return SYMBOL's name, a string.
648 CHECK_SYMBOL (symbol);
649 XSETSTRING (name, XSYMBOL (symbol)->name);
653 DEFUN ("fset", Ffset, 2, 2, 0, /*
654 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
658 /* This function can GC */
659 CHECK_SYMBOL (symbol);
660 reject_constant_symbols (symbol, newdef, 1, Qt);
661 if (!NILP (Vautoload_queue) && !UNBOUNDP (XSYMBOL (symbol)->function))
662 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
664 XSYMBOL (symbol)->function = newdef;
665 /* Handle automatic advice activation */
666 if (CONSP (XSYMBOL (symbol)->plist) &&
667 !NILP (Fget (symbol, Qad_advice_info, Qnil)))
669 call2 (Qad_activate, symbol, Qnil);
670 newdef = XSYMBOL (symbol)->function;
676 DEFUN ("define-function", Fdefine_function, 2, 2, 0, /*
677 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
678 Associates the function with the current load file, if any.
682 /* This function can GC */
683 Ffset (symbol, newdef);
684 LOADHIST_ATTACH (symbol);
689 DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
690 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
694 CHECK_SYMBOL (symbol);
695 #if 0 /* Inserted for debugging 6/28/1997 -slb */
696 /* Somebody is setting a property list of integer 0, who? */
697 /* Not this way apparently. */
698 if (EQ(newplist, Qzero)) abort();
701 XSYMBOL (symbol)->plist = newplist;
706 /**********************************************************************/
708 /**********************************************************************/
710 /* If the contents of the value cell of a symbol is one of the following
711 three types of objects, then the symbol is "magic" in that setting
712 and retrieving its value doesn't just set or retrieve the raw
713 contents of the value cell. None of these objects can escape to
714 the user level, so there is no loss of generality.
716 If a symbol is "unbound", then the contents of its value cell is
717 Qunbound. Despite appearances, this is *not* a symbol, but is a
718 symbol-value-forward object. This is so that printing it results
719 in "INTERNAL OBJECT (XEmacs bug?)", in case it leaks to Lisp, somehow.
721 Logically all of the following objects are "symbol-value-magic"
722 objects, and there are some games played w.r.t. this (#### this
723 should be cleaned up). SYMBOL_VALUE_MAGIC_P is true for all of
724 the object types. XSYMBOL_VALUE_MAGIC_TYPE returns the type of
725 symbol-value-magic object. There are more than three types
726 returned by this macro: in particular, symbol-value-forward
727 has eight subtypes, and symbol-value-buffer-local has two. See
730 1. symbol-value-forward
732 symbol-value-forward is used for variables whose actual contents
733 are stored in a C variable of some sort, and for Qunbound. The
734 lcheader.next field (which is only used to chain together free
735 lcrecords) holds a pointer to the actual C variable. Included
736 in this type are "buffer-local" variables that are actually
737 stored in the buffer object itself; in this case, the "pointer"
738 is an offset into the struct buffer structure.
740 The subtypes are as follows:
742 SYMVAL_OBJECT_FORWARD:
743 (declare with DEFVAR_LISP)
744 The value of this variable is stored in a C variable of type
745 "Lisp_Object". Setting this variable sets the C variable.
746 Accessing this variable retrieves a value from the C variable.
747 These variables can be buffer-local -- in this case, the
748 raw symbol-value field gets converted into a
749 symbol-value-buffer-local, whose "current_value" slot contains
750 the symbol-value-forward. (See below.)
752 SYMVAL_FIXNUM_FORWARD:
753 SYMVAL_BOOLEAN_FORWARD:
754 (declare with DEFVAR_INT or DEFVAR_BOOL)
755 Similar to SYMVAL_OBJECT_FORWARD except that the C variable
756 is of type "int" and is an integer or boolean, respectively.
758 SYMVAL_CONST_OBJECT_FORWARD:
759 SYMVAL_CONST_FIXNUM_FORWARD:
760 SYMVAL_CONST_BOOLEAN_FORWARD:
761 (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
763 Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
764 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
767 SYMVAL_CONST_SPECIFIER_FORWARD:
768 (declare with DEFVAR_SPECIFIER)
769 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that error message
770 you get when attempting to set the value says to use
771 `set-specifier' instead.
773 SYMVAL_CURRENT_BUFFER_FORWARD:
774 (declare with DEFVAR_BUFFER_LOCAL)
775 This is used for built-in buffer-local variables -- i.e.
776 Lisp variables whose value is stored in the "struct buffer".
777 Variables of this sort always forward into C "Lisp_Object"
778 fields (although there's no reason in principle that other
779 types for ints and booleans couldn't be added). Note that
780 some of these variables are automatically local in each
781 buffer, while some are only local when they become set
782 (similar to `make-variable-buffer-local'). In these latter
783 cases, of course, the default value shows through in all
784 buffers in which the variable doesn't have a local value.
785 This is implemented by making sure the "struct buffer" field
786 always contains the correct value (whether it's local or
787 a default) and maintaining a mask in the "struct buffer"
788 indicating which fields are local. When `set-default' is
789 called on a variable that's not always local to all buffers,
790 it loops through each buffer and sets the corresponding
791 field in each buffer without a local value for the field,
792 according to the mask.
794 Calling `make-local-variable' on a variable of this sort
795 only has the effect of maybe changing the current buffer's mask.
796 Calling `make-variable-buffer-local' on a variable of this
797 sort has no effect at all.
799 SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
800 (declare with DEFVAR_CONST_BUFFER_LOCAL)
801 Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
804 SYMVAL_DEFAULT_BUFFER_FORWARD:
805 (declare with DEFVAR_BUFFER_DEFAULTS)
806 This is used for the Lisp variables that contain the
807 default values of built-in buffer-local variables. Setting
808 or referencing one of these variables forwards into a slot
809 in the special struct buffer Vbuffer_defaults.
811 SYMVAL_UNBOUND_MARKER:
812 This is used for only one object, Qunbound.
814 SYMVAL_SELECTED_CONSOLE_FORWARD:
815 (declare with DEFVAR_CONSOLE_LOCAL)
816 This is used for built-in console-local variables -- i.e.
817 Lisp variables whose value is stored in the "struct console".
818 These work just like built-in buffer-local variables.
819 However, calling `make-local-variable' or
820 `make-variable-buffer-local' on one of these variables
821 is currently disallowed because that would entail having
822 both console-local and buffer-local variables, which is
823 trickier to implement.
825 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
826 (declare with DEFVAR_CONST_CONSOLE_LOCAL)
827 Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
830 SYMVAL_DEFAULT_CONSOLE_FORWARD:
831 (declare with DEFVAR_CONSOLE_DEFAULTS)
832 This is used for the Lisp variables that contain the
833 default values of built-in console-local variables. Setting
834 or referencing one of these variables forwards into a slot
835 in the special struct console Vconsole_defaults.
838 2. symbol-value-buffer-local
840 symbol-value-buffer-local is used for variables that have had
841 `make-local-variable' or `make-variable-buffer-local' applied
842 to them. This object contains an alist mapping buffers to
843 values. In addition, the object contains a "current value",
844 which is the value in some buffer. Whenever you access the
845 variable with `symbol-value' or set it with `set' or `setq',
846 things are switched around so that the "current value"
847 refers to the current buffer, if it wasn't already. This
848 way, repeated references to a variable in the same buffer
849 are almost as efficient as if the variable weren't buffer
850 local. Note that the alist may not be up-to-date w.r.t.
851 the buffer whose value is current, as the "current value"
852 cache is normally only flushed into the alist when the
853 buffer it refers to changes.
855 Note also that it is possible for `make-local-variable'
856 or `make-variable-buffer-local' to be called on a variable
857 that forwards into a C variable (i.e. a variable whose
858 value cell is a symbol-value-forward). In this case,
859 the value cell becomes a symbol-value-buffer-local (as
860 always), and the symbol-value-forward moves into
861 the "current value" cell in this object. Also, in
862 this case the "current value" *always* refers to the
863 current buffer, so that the values of the C variable
864 always is the correct value for the current buffer.
865 set_buffer_internal() automatically updates the current-value
866 cells of all buffer-local variables that forward into C
867 variables. (There is a list of all buffer-local variables
868 that is maintained for this and other purposes.)
870 Note that only certain types of `symbol-value-forward' objects
871 can find their way into the "current value" cell of a
872 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
873 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
874 SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot
875 be buffer-local because they are unsettable;
876 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
877 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
878 does not have much of an effect (it's already buffer-local); and
879 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
880 that's not currently implemented.
883 3. symbol-value-varalias
885 A symbol-value-varalias object is used for variables that
886 are aliases for other variables. This object contains
887 the symbol that this variable is aliased to.
888 symbol-value-varalias objects cannot occur anywhere within
889 a symbol-value-buffer-local object, and most of the
890 low-level functions below do not accept them; you need
891 to call follow_varalias_pointers to get the actual
892 symbol to operate on. */
895 mark_symbol_value_buffer_local (Lisp_Object obj,
896 void (*markobj) (Lisp_Object))
898 struct symbol_value_buffer_local *bfwd;
900 #ifdef ERROR_CHECK_TYPECHECK
901 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
902 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
905 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
906 markobj (bfwd->default_value);
907 markobj (bfwd->current_value);
908 markobj (bfwd->current_buffer);
909 return bfwd->current_alist_element;
913 mark_symbol_value_lisp_magic (Lisp_Object obj,
914 void (*markobj) (Lisp_Object))
916 struct symbol_value_lisp_magic *bfwd;
919 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
921 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
922 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
924 markobj (bfwd->handler[i]);
925 markobj (bfwd->harg[i]);
927 return bfwd->shadowed;
931 mark_symbol_value_varalias (Lisp_Object obj,
932 void (*markobj) (Lisp_Object))
934 struct symbol_value_varalias *bfwd;
936 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
938 bfwd = XSYMBOL_VALUE_VARALIAS (obj);
939 markobj (bfwd->shadowed);
940 return bfwd->aliasee;
943 /* Should never, ever be called. (except by an external debugger) */
945 print_symbol_value_magic (Lisp_Object obj,
946 Lisp_Object printcharfun, int escapeflag)
949 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s type %d) 0x%lx>",
950 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
951 XSYMBOL_VALUE_MAGIC_TYPE (obj),
953 write_c_string (buf, printcharfun);
956 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
957 symbol_value_forward,
958 this_one_is_unmarkable,
959 print_symbol_value_magic, 0, 0, 0,
960 struct symbol_value_forward);
962 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
963 symbol_value_buffer_local,
964 mark_symbol_value_buffer_local,
965 print_symbol_value_magic, 0, 0, 0,
966 struct symbol_value_buffer_local);
968 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
969 symbol_value_lisp_magic,
970 mark_symbol_value_lisp_magic,
971 print_symbol_value_magic, 0, 0, 0,
972 struct symbol_value_lisp_magic);
974 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
975 symbol_value_varalias,
976 mark_symbol_value_varalias,
977 print_symbol_value_magic, 0, 0, 0,
978 struct symbol_value_varalias);
981 /* Getting and setting values of symbols */
983 /* Given the raw contents of a symbol value cell, return the Lisp value of
984 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local,
985 symbol-value-lisp-magic, or symbol-value-varalias.
987 BUFFER specifies a buffer, and is used for built-in buffer-local
988 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
989 Note that such variables are never encapsulated in a
990 symbol-value-buffer-local structure.
992 CONSOLE specifies a console, and is used for built-in console-local
993 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
994 Note that such variables are (currently) never encapsulated in a
995 symbol-value-buffer-local structure.
999 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
1000 struct console *console)
1002 CONST struct symbol_value_forward *fwd;
1004 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1007 fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1008 switch (fwd->magic.type)
1010 case SYMVAL_FIXNUM_FORWARD:
1011 case SYMVAL_CONST_FIXNUM_FORWARD:
1012 return make_int (*((int *)symbol_value_forward_forward (fwd)));
1014 case SYMVAL_BOOLEAN_FORWARD:
1015 case SYMVAL_CONST_BOOLEAN_FORWARD:
1016 return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
1018 case SYMVAL_OBJECT_FORWARD:
1019 case SYMVAL_CONST_OBJECT_FORWARD:
1020 case SYMVAL_CONST_SPECIFIER_FORWARD:
1021 return *((Lisp_Object *)symbol_value_forward_forward (fwd));
1023 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1024 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1025 + ((char *)symbol_value_forward_forward (fwd)
1026 - (char *)&buffer_local_flags))));
1029 case SYMVAL_CURRENT_BUFFER_FORWARD:
1030 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1032 return (*((Lisp_Object *)((char *)buffer
1033 + ((char *)symbol_value_forward_forward (fwd)
1034 - (char *)&buffer_local_flags))));
1036 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1037 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1038 + ((char *)symbol_value_forward_forward (fwd)
1039 - (char *)&console_local_flags))));
1041 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1042 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1044 return (*((Lisp_Object *)((char *)console
1045 + ((char *)symbol_value_forward_forward (fwd)
1046 - (char *)&console_local_flags))));
1048 case SYMVAL_UNBOUND_MARKER:
1054 return Qnil; /* suppress compiler warning */
1057 /* Set the value of default-buffer-local variable SYM to VALUE. */
1060 set_default_buffer_slot_variable (Lisp_Object sym,
1063 /* Handle variables like case-fold-search that have special slots in
1064 the buffer. Make them work apparently like buffer_local variables.
1066 /* At this point, the value cell may not contain a symbol-value-varalias
1067 or symbol-value-buffer-local, and if there's a handler, we should
1068 have already called it. */
1069 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1070 CONST struct symbol_value_forward *fwd
1071 = XSYMBOL_VALUE_FORWARD (valcontents);
1072 int offset = ((char *) symbol_value_forward_forward (fwd)
1073 - (char *) &buffer_local_flags);
1074 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1075 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1076 int flags) = symbol_value_forward_magicfun (fwd);
1078 *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
1081 if (mask > 0) /* Not always per-buffer */
1085 /* Set value in each buffer which hasn't shadowed the default */
1086 LIST_LOOP_2 (elt, Vbuffer_alist)
1088 struct buffer *b = XBUFFER (XCDR (elt));
1089 if (!(b->local_var_flags & mask))
1092 magicfun (sym, &value, make_buffer (b), 0);
1093 *((Lisp_Object *) (offset + (char *) b)) = value;
1099 /* Set the value of default-console-local variable SYM to VALUE. */
1102 set_default_console_slot_variable (Lisp_Object sym,
1105 /* Handle variables like case-fold-search that have special slots in
1106 the console. Make them work apparently like console_local variables.
1108 /* At this point, the value cell may not contain a symbol-value-varalias
1109 or symbol-value-buffer-local, and if there's a handler, we should
1110 have already called it. */
1111 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1112 CONST struct symbol_value_forward *fwd
1113 = XSYMBOL_VALUE_FORWARD (valcontents);
1114 int offset = ((char *) symbol_value_forward_forward (fwd)
1115 - (char *) &console_local_flags);
1116 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1117 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1118 int flags) = symbol_value_forward_magicfun (fwd);
1120 *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
1123 if (mask > 0) /* Not always per-console */
1125 Lisp_Object console;
1127 /* Set value in each console which hasn't shadowed the default */
1128 LIST_LOOP_2 (console, Vconsole_list)
1130 struct console *d = XCONSOLE (console);
1131 if (!(d->local_var_flags & mask))
1134 magicfun (sym, &value, console, 0);
1135 *((Lisp_Object *) (offset + (char *) d)) = value;
1141 /* Store NEWVAL into SYM.
1143 SYM's value slot may *not* be types (5) or (6) above,
1144 i.e. no symbol-value-varalias objects. (You should have
1145 forwarded past all of these.)
1147 SYM should not be an unsettable symbol or a symbol with
1148 a magic `set-value' handler (unless you want to explicitly
1149 ignore this handler).
1151 OVALUE is the current value of SYM, but forwarded past any
1152 symbol-value-buffer-local and symbol-value-lisp-magic objects.
1153 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1154 the contents of its current-value cell.) NEWVAL may only be
1155 a simple value or Qunbound. If SYM is a symbol-value-buffer-local,
1156 this function will only modify its current-value cell, which should
1157 already be set up to point to the current buffer.
1161 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
1164 if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
1166 Lisp_Object *store_pointer = value_slot_past_magic (sym);
1168 if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
1170 &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
1172 assert (UNBOUNDP (*store_pointer)
1173 || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1174 *store_pointer = newval;
1178 CONST struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue);
1179 int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
1180 Lisp_Object in_object, int flags)
1181 = symbol_value_forward_magicfun (fwd);
1183 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue))
1185 case SYMVAL_FIXNUM_FORWARD:
1188 magicfun (sym, &newval, Qnil, 0);
1189 *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
1192 case SYMVAL_BOOLEAN_FORWARD:
1194 magicfun (sym, &newval, Qnil, 0);
1195 *((int *) symbol_value_forward_forward (fwd))
1196 = ((NILP (newval)) ? 0 : 1);
1199 case SYMVAL_OBJECT_FORWARD:
1201 magicfun (sym, &newval, Qnil, 0);
1202 *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
1205 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1206 set_default_buffer_slot_variable (sym, newval);
1209 case SYMVAL_CURRENT_BUFFER_FORWARD:
1211 magicfun (sym, &newval, make_buffer (current_buffer), 0);
1212 *((Lisp_Object *) ((char *) current_buffer
1213 + ((char *) symbol_value_forward_forward (fwd)
1214 - (char *) &buffer_local_flags)))
1218 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1219 set_default_console_slot_variable (sym, newval);
1222 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1224 magicfun (sym, &newval, Vselected_console, 0);
1225 *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console)
1226 + ((char *) symbol_value_forward_forward (fwd)
1227 - (char *) &console_local_flags)))
1237 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1238 BFWD, locate and return a pointer to the element in BUFFER's
1239 local_var_alist for SYMBOL. The return value will be Qnil if
1240 BUFFER does not have its own value for SYMBOL (i.e. the default
1241 value is seen in that buffer).
1245 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
1246 struct symbol_value_buffer_local *bfwd)
1248 if (!NILP (bfwd->current_buffer) &&
1249 XBUFFER (bfwd->current_buffer) == buffer)
1250 /* This is just an optimization of the below. */
1251 return bfwd->current_alist_element;
1253 return assq_no_quit (symbol, buffer->local_var_alist);
1256 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1257 symbol-value-buffer-local of a per-buffer variable -- i.e. the
1258 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1259 slot -- may be out of date.]
1261 Write out any cached value in buffer-local variable SYMBOL's
1262 buffer-local structure, which is passed in as BFWD.
1266 write_out_buffer_local_cache (Lisp_Object symbol,
1267 struct symbol_value_buffer_local *bfwd)
1269 if (!NILP (bfwd->current_buffer))
1271 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1272 uses it, and that type cannot be inside a symbol-value-buffer-local */
1273 Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0);
1274 if (NILP (bfwd->current_alist_element))
1275 /* current_value may be updated more recently than default_value */
1276 bfwd->default_value = cval;
1278 Fsetcdr (bfwd->current_alist_element, cval);
1282 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1283 Set up BFWD's cache for validity in buffer BUF. This assumes that
1284 the cache is currently in a consistent state (this can include
1285 not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1287 If the cache is already set up for BUF, this function does nothing
1290 Otherwise, if SYM forwards out to a C variable, this also forwards
1291 SYM's value in BUF out to the variable. Therefore, you generally
1292 only want to call this when BUF is, or is about to become, the
1295 (Otherwise, you can just retrieve the value without changing the
1296 cache, at the expense of slower retrieval.)
1300 set_up_buffer_local_cache (Lisp_Object sym,
1301 struct symbol_value_buffer_local *bfwd,
1303 Lisp_Object new_alist_el,
1306 Lisp_Object new_val;
1308 if (!NILP (bfwd->current_buffer)
1309 && buf == XBUFFER (bfwd->current_buffer))
1310 /* Cache is already set up. */
1313 /* Flush out the old cache. */
1314 write_out_buffer_local_cache (sym, bfwd);
1316 /* Retrieve the new alist element and new value. */
1317 if (NILP (new_alist_el)
1319 new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1321 if (NILP (new_alist_el))
1322 new_val = bfwd->default_value;
1324 new_val = Fcdr (new_alist_el);
1326 bfwd->current_alist_element = new_alist_el;
1327 XSETBUFFER (bfwd->current_buffer, buf);
1329 /* Now store the value into the current-value slot.
1330 We don't simply write it there, because the current-value
1331 slot might be a forwarding pointer, in which case we need
1332 to instead write the value into the C variable.
1334 We might also want to call a magic function.
1336 So instead, we call this function. */
1337 store_symval_forwarding (sym, bfwd->current_value, new_val);
1342 kill_buffer_local_variables (struct buffer *buf)
1344 Lisp_Object prev = Qnil;
1347 /* Any which are supposed to be permanent,
1348 make local again, with the same values they had. */
1350 for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
1352 Lisp_Object sym = XCAR (XCAR (alist));
1353 struct symbol_value_buffer_local *bfwd;
1354 /* Variables with a symbol-value-varalias should not be here
1355 (we should have forwarded past them) and there must be a
1356 symbol-value-buffer-local. If there's a symbol-value-lisp-magic,
1357 just forward past it; if the variable has a handler, it was
1359 Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
1361 assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
1362 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
1364 if (!NILP (Fget (sym, Qpermanent_local, Qnil)))
1365 /* prev points to the last alist element that is still
1366 staying around, so *only* update it now. This didn't
1367 used to be the case; this bug has been around since
1368 mly's rewrite two years ago! */
1372 /* Really truly kill it. */
1374 XCDR (prev) = XCDR (alist);
1376 buf->local_var_alist = XCDR (alist);
1378 /* We just effectively changed the value for this variable
1381 /* (1) If the cache is caching BUF, invalidate the cache. */
1382 if (!NILP (bfwd->current_buffer) &&
1383 buf == XBUFFER (bfwd->current_buffer))
1384 bfwd->current_buffer = Qnil;
1386 /* (2) If we changed the value in current_buffer and this
1387 variable forwards to a C variable, we need to change the
1388 value of the C variable. set_up_buffer_local_cache()
1389 will do this. It doesn't hurt to do it whenever
1390 BUF == current_buffer, so just go ahead and do that. */
1391 if (buf == current_buffer)
1392 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
1398 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1399 struct console *con, int swap_it_in,
1400 Lisp_Object symcons, int set_it_p)
1402 Lisp_Object valcontents;
1405 valcontents = XSYMBOL (sym)->value;
1408 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1411 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1413 case SYMVAL_LISP_MAGIC:
1415 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1419 case SYMVAL_VARALIAS:
1420 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1422 /* presto change-o! */
1425 case SYMVAL_BUFFER_LOCAL:
1426 case SYMVAL_SOME_BUFFER_LOCAL:
1428 struct symbol_value_buffer_local *bfwd
1429 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1433 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1434 valcontents = bfwd->current_value;
1438 if (!NILP (bfwd->current_buffer) &&
1439 buf == XBUFFER (bfwd->current_buffer))
1440 valcontents = bfwd->current_value;
1441 else if (NILP (symcons))
1444 valcontents = assq_no_quit (sym, buf->local_var_alist);
1445 if (NILP (valcontents))
1446 valcontents = bfwd->default_value;
1448 valcontents = XCDR (valcontents);
1451 valcontents = XCDR (symcons);
1459 return do_symval_forwarding (valcontents, buf, con);
1463 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1464 bound. Note that it must not be possible to QUIT within this
1468 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
1475 buf = current_buffer;
1478 CHECK_BUFFER (buffer);
1479 buf = XBUFFER (buffer);
1482 return find_symbol_value_1 (sym, buf,
1483 /* If it bombs out at startup due to a
1484 Lisp error, this may be nil. */
1485 CONSOLEP (Vselected_console)
1486 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
1490 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1495 console = Vselected_console;
1497 CHECK_CONSOLE (console);
1499 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1503 /* Return the current value of SYM. The difference between this function
1504 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1505 this updates the CURRENT_VALUE slot of buffer-local variables to
1506 point to the current buffer, while symbol_value_in_buffer doesn't. */
1509 find_symbol_value (Lisp_Object sym)
1511 /* WARNING: This function can be called when current_buffer is 0
1512 and Vselected_console is Qnil, early in initialization. */
1513 struct console *con;
1514 Lisp_Object valcontents;
1518 valcontents = XSYMBOL (sym)->value;
1519 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1522 if (CONSOLEP (Vselected_console))
1523 con = XCONSOLE (Vselected_console);
1526 /* This can also get called while we're preparing to shutdown.
1527 #### What should really happen in that case? Should we
1528 actually fix things so we can't get here in that case? */
1529 assert (!initialized || preparing_for_armageddon);
1533 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
1536 /* This is an optimized function for quick lookup of buffer local symbols
1537 by avoiding O(n) search. This will work when either:
1538 a) We have already found the symbol e.g. by traversing local_var_alist.
1540 b) We know that the symbol will not be found in the current buffer's
1541 list of local variables.
1542 In the former case, find_it_p is 1 and symbol_cons is the element from
1543 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1546 This function is called from set_buffer_internal which does both of these
1550 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1552 /* WARNING: This function can be called when current_buffer is 0
1553 and Vselected_console is Qnil, early in initialization. */
1554 struct console *con;
1555 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1558 if (CONSOLEP (Vselected_console))
1559 con = XCONSOLE (Vselected_console);
1562 /* This can also get called while we're preparing to shutdown.
1563 #### What should really happen in that case? Should we
1564 actually fix things so we can't get here in that case? */
1565 assert (!initialized || preparing_for_armageddon);
1569 return find_symbol_value_1 (sym, current_buffer, con, 1,
1570 find_it_p ? symbol_cons : Qnil,
1574 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1575 Return SYMBOL's value. Error if that is void.
1579 Lisp_Object val = find_symbol_value (symbol);
1582 return Fsignal (Qvoid_variable, list1 (symbol));
1587 DEFUN ("set", Fset, 2, 2, 0, /*
1588 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1592 REGISTER Lisp_Object valcontents;
1593 struct Lisp_Symbol *sym;
1594 /* remember, we're called by Fmakunbound() as well */
1596 CHECK_SYMBOL (symbol);
1599 sym = XSYMBOL (symbol);
1600 valcontents = sym->value;
1602 if (EQ (symbol, Qnil) ||
1604 SYMBOL_IS_KEYWORD (symbol))
1605 reject_constant_symbols (symbol, newval, 0,
1606 UNBOUNDP (newval) ? Qmakunbound : Qset);
1608 if (!SYMBOL_VALUE_MAGIC_P (valcontents) || UNBOUNDP (valcontents))
1610 sym->value = newval;
1614 reject_constant_symbols (symbol, newval, 0,
1615 UNBOUNDP (newval) ? Qmakunbound : Qset);
1619 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1621 case SYMVAL_LISP_MAGIC:
1625 if (UNBOUNDP (newval))
1626 retval = maybe_call_magic_handler (symbol, Qmakunbound, 0);
1628 retval = maybe_call_magic_handler (symbol, Qset, 1, newval);
1629 if (!UNBOUNDP (retval))
1631 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1636 case SYMVAL_VARALIAS:
1637 symbol = follow_varalias_pointers (symbol,
1639 ? Qmakunbound : Qset);
1640 /* presto change-o! */
1643 case SYMVAL_FIXNUM_FORWARD:
1644 case SYMVAL_BOOLEAN_FORWARD:
1645 case SYMVAL_OBJECT_FORWARD:
1646 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1647 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1648 if (UNBOUNDP (newval))
1649 signal_error (Qerror,
1650 list2 (build_string ("Cannot makunbound"), symbol));
1653 /* case SYMVAL_UNBOUND_MARKER: break; */
1655 case SYMVAL_CURRENT_BUFFER_FORWARD:
1657 CONST struct symbol_value_forward *fwd
1658 = XSYMBOL_VALUE_FORWARD (valcontents);
1659 int mask = XINT (*((Lisp_Object *)
1660 symbol_value_forward_forward (fwd)));
1662 /* Setting this variable makes it buffer-local */
1663 current_buffer->local_var_flags |= mask;
1667 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1669 CONST struct symbol_value_forward *fwd
1670 = XSYMBOL_VALUE_FORWARD (valcontents);
1671 int mask = XINT (*((Lisp_Object *)
1672 symbol_value_forward_forward (fwd)));
1674 /* Setting this variable makes it console-local */
1675 XCONSOLE (Vselected_console)->local_var_flags |= mask;
1679 case SYMVAL_BUFFER_LOCAL:
1680 case SYMVAL_SOME_BUFFER_LOCAL:
1682 /* If we want to examine or set the value and
1683 CURRENT-BUFFER is current, we just examine or set
1684 CURRENT-VALUE. If CURRENT-BUFFER is not current, we
1685 store the current CURRENT-VALUE value into
1686 CURRENT-ALIST- ELEMENT, then find the appropriate alist
1687 element for the buffer now current and set up
1688 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out
1689 of that element, and store into CURRENT-BUFFER.
1691 If we are setting the variable and the current buffer does
1692 not have an alist entry for this variable, an alist entry is
1695 Note that CURRENT-VALUE can be a forwarding pointer.
1696 Each time it is examined or set, forwarding must be
1698 struct symbol_value_buffer_local *bfwd
1699 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1700 int some_buffer_local_p =
1701 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
1702 /* What value are we caching right now? */
1703 Lisp_Object aelt = bfwd->current_alist_element;
1705 if (!NILP (bfwd->current_buffer) &&
1706 current_buffer == XBUFFER (bfwd->current_buffer)
1707 && ((some_buffer_local_p)
1708 ? 1 /* doesn't automatically become local */
1709 : !NILP (aelt) /* already local */
1712 /* Cache is valid */
1713 valcontents = bfwd->current_value;
1717 /* If the current buffer is not the buffer whose binding is
1718 currently cached, or if it's a SYMVAL_BUFFER_LOCAL and
1719 we're looking at the default value, the cache is invalid; we
1720 need to write it out, and find the new CURRENT-ALIST-ELEMENT
1723 /* Write out the cached value for the old buffer; copy it
1724 back to its alist element. This works if the current
1725 buffer only sees the default value, too. */
1726 write_out_buffer_local_cache (symbol, bfwd);
1728 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1729 aelt = buffer_local_alist_element (current_buffer, symbol, bfwd);
1732 /* This buffer is still seeing the default value. */
1733 if (!some_buffer_local_p)
1735 /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a
1736 new assoc for a local value and set
1737 CURRENT-ALIST-ELEMENT to point to that. */
1739 do_symval_forwarding (bfwd->current_value,
1741 XCONSOLE (Vselected_console));
1742 aelt = Fcons (symbol, aelt);
1743 current_buffer->local_var_alist
1744 = Fcons (aelt, current_buffer->local_var_alist);
1748 /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
1749 we're currently seeing the default value. */
1753 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1754 bfwd->current_alist_element = aelt;
1755 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
1756 XSETBUFFER (bfwd->current_buffer, current_buffer);
1757 valcontents = bfwd->current_value;
1764 store_symval_forwarding (symbol, valcontents, newval);
1770 /* Access or set a buffer-local symbol's default value. */
1772 /* Return the default value of SYM, but don't check for voidness.
1773 Return Qunbound if it is void. */
1776 default_value (Lisp_Object sym)
1778 Lisp_Object valcontents;
1783 valcontents = XSYMBOL (sym)->value;
1786 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1789 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1791 case SYMVAL_LISP_MAGIC:
1793 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1797 case SYMVAL_VARALIAS:
1798 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1799 /* presto change-o! */
1802 case SYMVAL_UNBOUND_MARKER:
1805 case SYMVAL_CURRENT_BUFFER_FORWARD:
1807 CONST struct symbol_value_forward *fwd
1808 = XSYMBOL_VALUE_FORWARD (valcontents);
1809 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1810 + ((char *)symbol_value_forward_forward (fwd)
1811 - (char *)&buffer_local_flags))));
1814 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1816 CONST struct symbol_value_forward *fwd
1817 = XSYMBOL_VALUE_FORWARD (valcontents);
1818 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1819 + ((char *)symbol_value_forward_forward (fwd)
1820 - (char *)&console_local_flags))));
1823 case SYMVAL_BUFFER_LOCAL:
1824 case SYMVAL_SOME_BUFFER_LOCAL:
1826 struct symbol_value_buffer_local *bfwd =
1827 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1829 /* Handle user-created local variables. */
1830 /* If var is set up for a buffer that lacks a local value for it,
1831 the current value is nominally the default value.
1832 But the current value slot may be more up to date, since
1833 ordinary setq stores just that slot. So use that. */
1834 if (NILP (bfwd->current_alist_element))
1835 return do_symval_forwarding (bfwd->current_value, current_buffer,
1836 XCONSOLE (Vselected_console));
1838 return bfwd->default_value;
1841 /* For other variables, get the current value. */
1842 return do_symval_forwarding (valcontents, current_buffer,
1843 XCONSOLE (Vselected_console));
1846 RETURN_NOT_REACHED (Qnil) /* suppress compiler warning */
1849 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /*
1850 Return t if SYMBOL has a non-void default value.
1851 This is the value that is seen in buffers that do not have their own values
1856 return UNBOUNDP (default_value (symbol)) ? Qnil : Qt;
1859 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /*
1860 Return SYMBOL's default value.
1861 This is the value that is seen in buffers that do not have their own values
1862 for this variable. The default value is meaningful for variables with
1863 local bindings in certain buffers.
1867 Lisp_Object value = default_value (symbol);
1869 return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (symbol)) : value;
1872 DEFUN ("set-default", Fset_default, 2, 2, 0, /*
1873 Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.
1874 The default value is seen in buffers that do not have their own values
1879 Lisp_Object valcontents;
1881 CHECK_SYMBOL (symbol);
1884 valcontents = XSYMBOL (symbol)->value;
1887 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1888 return Fset (symbol, value);
1890 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1892 case SYMVAL_LISP_MAGIC:
1893 RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (symbol, Qset_default, 1,
1895 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1899 case SYMVAL_VARALIAS:
1900 symbol = follow_varalias_pointers (symbol, Qset_default);
1901 /* presto change-o! */
1904 case SYMVAL_CURRENT_BUFFER_FORWARD:
1905 set_default_buffer_slot_variable (symbol, value);
1908 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1909 set_default_console_slot_variable (symbol, value);
1912 case SYMVAL_BUFFER_LOCAL:
1913 case SYMVAL_SOME_BUFFER_LOCAL:
1915 /* Store new value into the DEFAULT-VALUE slot */
1916 struct symbol_value_buffer_local *bfwd
1917 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1919 bfwd->default_value = value;
1920 /* If current-buffer doesn't shadow default_value,
1921 * we must set the CURRENT-VALUE slot too */
1922 if (NILP (bfwd->current_alist_element))
1923 store_symval_forwarding (symbol, bfwd->current_value, value);
1928 return Fset (symbol, value);
1932 DEFUN ("setq-default", Fsetq_default, 0, UNEVALLED, 0, /*
1933 Set the default value of variable SYMBOL to VALUE.
1934 SYMBOL, the variable name, is literal (not evaluated);
1935 VALUE is an expression and it is evaluated.
1936 The default value of a variable is seen in buffers
1937 that do not have their own values for the variable.
1939 More generally, you can use multiple variables and values, as in
1940 (setq-default SYMBOL VALUE SYMBOL VALUE...)
1941 This sets each SYMBOL's default value to the corresponding VALUE.
1942 The VALUE for the Nth SYMBOL can refer to the new default values
1943 of previous SYMBOLs.
1947 /* This function can GC */
1948 Lisp_Object symbol, tail, val = Qnil;
1950 struct gcpro gcpro1;
1952 GET_LIST_LENGTH (args, nargs);
1954 if (nargs & 1) /* Odd number of arguments? */
1955 Fsignal (Qwrong_number_of_arguments,
1956 list2 (Qsetq_default, make_int (nargs)));
1960 PROPERTY_LIST_LOOP (tail, symbol, val, args)
1963 Fset_default (symbol, val);
1970 /* Lisp functions for creating and removing buffer-local variables. */
1972 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1,
1973 "vMake Variable Buffer Local: ", /*
1974 Make VARIABLE have a separate value for each buffer.
1975 At any time, the value for the current buffer is in effect.
1976 There is also a default value which is seen in any buffer which has not yet
1978 Using `set' or `setq' to set the variable causes it to have a separate value
1979 for the current buffer if it was previously using the default value.
1980 The function `default-value' gets the default value and `set-default'
1985 Lisp_Object valcontents;
1987 CHECK_SYMBOL (variable);
1990 verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
1992 valcontents = XSYMBOL (variable)->value;
1995 if (SYMBOL_VALUE_MAGIC_P (valcontents))
1997 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1999 case SYMVAL_LISP_MAGIC:
2000 if (!UNBOUNDP (maybe_call_magic_handler
2001 (variable, Qmake_variable_buffer_local, 0)))
2003 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2007 case SYMVAL_VARALIAS:
2008 variable = follow_varalias_pointers (variable,
2009 Qmake_variable_buffer_local);
2010 /* presto change-o! */
2013 case SYMVAL_FIXNUM_FORWARD:
2014 case SYMVAL_BOOLEAN_FORWARD:
2015 case SYMVAL_OBJECT_FORWARD:
2016 case SYMVAL_UNBOUND_MARKER:
2019 case SYMVAL_CURRENT_BUFFER_FORWARD:
2020 case SYMVAL_BUFFER_LOCAL:
2021 /* Already per-each-buffer */
2024 case SYMVAL_SOME_BUFFER_LOCAL:
2026 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
2027 SYMVAL_BUFFER_LOCAL;
2036 struct symbol_value_buffer_local *bfwd
2037 = alloc_lcrecord_type (struct symbol_value_buffer_local,
2038 lrecord_symbol_value_buffer_local);
2040 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2042 bfwd->default_value = find_symbol_value (variable);
2043 bfwd->current_value = valcontents;
2044 bfwd->current_alist_element = Qnil;
2045 bfwd->current_buffer = Fcurrent_buffer ();
2046 XSETSYMBOL_VALUE_MAGIC (foo, bfwd);
2047 *value_slot_past_magic (variable) = foo;
2048 #if 1 /* #### Yuck! FSFmacs bug-compatibility*/
2049 /* This sets the default-value of any make-variable-buffer-local to nil.
2050 That just sucks. User can just use setq-default to effect that,
2051 but there's no way to do makunbound-default to undo this lossage. */
2052 if (UNBOUNDP (valcontents))
2053 bfwd->default_value = Qnil;
2055 #if 0 /* #### Yuck! */
2056 /* This sets the value to nil in this buffer.
2057 User could use (setq variable nil) to do this.
2058 It isn't as egregious to do this automatically
2059 as it is to do so to the default-value, but it's
2060 still really dubious. */
2061 if (UNBOUNDP (valcontents))
2062 Fset (variable, Qnil);
2068 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1,
2069 "vMake Local Variable: ", /*
2070 Make VARIABLE have a separate value in the current buffer.
2071 Other buffers will continue to share a common default value.
2072 \(The buffer-local value of VARIABLE starts out as the same value
2073 VARIABLE previously had. If VARIABLE was void, it remains void.)
2074 See also `make-variable-buffer-local'.
2076 If the variable is already arranged to become local when set,
2077 this function causes a local value to exist for this buffer,
2078 just as setting the variable would do.
2080 Do not use `make-local-variable' to make a hook variable buffer-local.
2081 Use `make-local-hook' instead.
2085 Lisp_Object valcontents;
2086 struct symbol_value_buffer_local *bfwd;
2088 CHECK_SYMBOL (variable);
2091 verify_ok_for_buffer_local (variable, Qmake_local_variable);
2093 valcontents = XSYMBOL (variable)->value;
2096 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2098 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2100 case SYMVAL_LISP_MAGIC:
2101 if (!UNBOUNDP (maybe_call_magic_handler
2102 (variable, Qmake_local_variable, 0)))
2104 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2108 case SYMVAL_VARALIAS:
2109 variable = follow_varalias_pointers (variable, Qmake_local_variable);
2110 /* presto change-o! */
2113 case SYMVAL_FIXNUM_FORWARD:
2114 case SYMVAL_BOOLEAN_FORWARD:
2115 case SYMVAL_OBJECT_FORWARD:
2116 case SYMVAL_UNBOUND_MARKER:
2119 case SYMVAL_BUFFER_LOCAL:
2120 case SYMVAL_CURRENT_BUFFER_FORWARD:
2122 /* Make sure the symbol has a local value in this particular
2123 buffer, by setting it to the same value it already has. */
2124 Fset (variable, find_symbol_value (variable));
2128 case SYMVAL_SOME_BUFFER_LOCAL:
2130 if (!NILP (buffer_local_alist_element (current_buffer,
2132 (XSYMBOL_VALUE_BUFFER_LOCAL
2134 goto already_local_to_current_buffer;
2136 goto already_local_to_some_other_buffer;
2144 /* Make sure variable is set up to hold per-buffer values */
2145 bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
2146 lrecord_symbol_value_buffer_local);
2147 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2149 bfwd->current_buffer = Qnil;
2150 bfwd->current_alist_element = Qnil;
2151 bfwd->current_value = valcontents;
2152 /* passing 0 is OK because this should never be a
2153 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2155 bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
2158 if (UNBOUNDP (bfwd->default_value))
2159 bfwd->default_value = Qnil; /* Yuck! */
2162 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
2163 *value_slot_past_magic (variable) = valcontents;
2165 already_local_to_some_other_buffer:
2167 /* Make sure this buffer has its own value of variable */
2168 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2170 if (UNBOUNDP (bfwd->default_value))
2172 /* If default value is unbound, set local value to nil. */
2173 XSETBUFFER (bfwd->current_buffer, current_buffer);
2174 bfwd->current_alist_element = Fcons (variable, Qnil);
2175 current_buffer->local_var_alist =
2176 Fcons (bfwd->current_alist_element, current_buffer->local_var_alist);
2177 store_symval_forwarding (variable, bfwd->current_value, Qnil);
2181 current_buffer->local_var_alist
2182 = Fcons (Fcons (variable, bfwd->default_value),
2183 current_buffer->local_var_alist);
2185 /* Make sure symbol does not think it is set up for this buffer;
2186 force it to look once again for this buffer's value */
2187 if (!NILP (bfwd->current_buffer) &&
2188 current_buffer == XBUFFER (bfwd->current_buffer))
2189 bfwd->current_buffer = Qnil;
2191 already_local_to_current_buffer:
2193 /* If the symbol forwards into a C variable, then swap in the
2194 variable for this buffer immediately. If C code modifies the
2195 variable before we swap in, then that new value will clobber the
2196 default value the next time we swap. */
2197 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2198 if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value))
2200 switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
2202 case SYMVAL_FIXNUM_FORWARD:
2203 case SYMVAL_BOOLEAN_FORWARD:
2204 case SYMVAL_OBJECT_FORWARD:
2205 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2206 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2209 case SYMVAL_UNBOUND_MARKER:
2210 case SYMVAL_CURRENT_BUFFER_FORWARD:
2221 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1,
2222 "vKill Local Variable: ", /*
2223 Make VARIABLE no longer have a separate value in the current buffer.
2224 From now on the default value will apply in this buffer.
2228 Lisp_Object valcontents;
2230 CHECK_SYMBOL (variable);
2233 valcontents = XSYMBOL (variable)->value;
2236 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2239 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2241 case SYMVAL_LISP_MAGIC:
2242 if (!UNBOUNDP (maybe_call_magic_handler
2243 (variable, Qkill_local_variable, 0)))
2245 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2249 case SYMVAL_VARALIAS:
2250 variable = follow_varalias_pointers (variable, Qkill_local_variable);
2251 /* presto change-o! */
2254 case SYMVAL_CURRENT_BUFFER_FORWARD:
2256 CONST struct symbol_value_forward *fwd
2257 = XSYMBOL_VALUE_FORWARD (valcontents);
2258 int offset = ((char *) symbol_value_forward_forward (fwd)
2259 - (char *) &buffer_local_flags);
2261 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2265 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2266 Lisp_Object in_object, int flags) =
2267 symbol_value_forward_magicfun (fwd);
2268 Lisp_Object oldval = * (Lisp_Object *)
2269 (offset + (char *) XBUFFER (Vbuffer_defaults));
2271 (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
2272 *(Lisp_Object *) (offset + (char *) current_buffer)
2274 current_buffer->local_var_flags &= ~mask;
2279 case SYMVAL_BUFFER_LOCAL:
2280 case SYMVAL_SOME_BUFFER_LOCAL:
2282 /* Get rid of this buffer's alist element, if any */
2283 struct symbol_value_buffer_local *bfwd
2284 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2285 Lisp_Object alist = current_buffer->local_var_alist;
2286 Lisp_Object alist_element
2287 = buffer_local_alist_element (current_buffer, variable, bfwd);
2289 if (!NILP (alist_element))
2290 current_buffer->local_var_alist = Fdelq (alist_element, alist);
2292 /* Make sure symbol does not think it is set up for this buffer;
2293 force it to look once again for this buffer's value */
2294 if (!NILP (bfwd->current_buffer) &&
2295 current_buffer == XBUFFER (bfwd->current_buffer))
2296 bfwd->current_buffer = Qnil;
2298 /* We just changed the value in the current_buffer. If this
2299 variable forwards to a C variable, we need to change the
2300 value of the C variable. set_up_buffer_local_cache()
2301 will do this. It doesn't hurt to do it always,
2302 so just go ahead and do that. */
2303 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2310 RETURN_NOT_REACHED(Qnil) /* suppress compiler warning */
2314 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2315 "vKill Console Local Variable: ", /*
2316 Make VARIABLE no longer have a separate value in the selected console.
2317 From now on the default value will apply in this console.
2321 Lisp_Object valcontents;
2323 CHECK_SYMBOL (variable);
2326 valcontents = XSYMBOL (variable)->value;
2329 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2332 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2334 case SYMVAL_LISP_MAGIC:
2335 if (!UNBOUNDP (maybe_call_magic_handler
2336 (variable, Qkill_console_local_variable, 0)))
2338 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2342 case SYMVAL_VARALIAS:
2343 variable = follow_varalias_pointers (variable,
2344 Qkill_console_local_variable);
2345 /* presto change-o! */
2348 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2350 CONST struct symbol_value_forward *fwd
2351 = XSYMBOL_VALUE_FORWARD (valcontents);
2352 int offset = ((char *) symbol_value_forward_forward (fwd)
2353 - (char *) &console_local_flags);
2355 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2359 int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2360 Lisp_Object in_object, int flags) =
2361 symbol_value_forward_magicfun (fwd);
2362 Lisp_Object oldval = * (Lisp_Object *)
2363 (offset + (char *) XCONSOLE (Vconsole_defaults));
2365 magicfun (variable, &oldval, Vselected_console, 0);
2366 *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
2368 XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
2378 /* Used by specbind to determine what effects it might have. Returns:
2379 * 0 if symbol isn't buffer-local, and wouldn't be after it is set
2380 * <0 if symbol isn't presently buffer-local, but set would make it so
2381 * >0 if symbol is presently buffer-local
2384 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
2386 Lisp_Object valcontents;
2389 valcontents = XSYMBOL (symbol)->value;
2392 if (SYMBOL_VALUE_MAGIC_P (valcontents))
2394 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2396 case SYMVAL_LISP_MAGIC:
2398 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2402 case SYMVAL_VARALIAS:
2403 symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
2404 /* presto change-o! */
2407 case SYMVAL_CURRENT_BUFFER_FORWARD:
2409 CONST struct symbol_value_forward *fwd
2410 = XSYMBOL_VALUE_FORWARD (valcontents);
2411 int mask = XINT (*((Lisp_Object *)
2412 symbol_value_forward_forward (fwd)));
2413 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
2414 /* Already buffer-local */
2417 /* Would be buffer-local after set */
2420 case SYMVAL_BUFFER_LOCAL:
2421 case SYMVAL_SOME_BUFFER_LOCAL:
2423 struct symbol_value_buffer_local *bfwd
2424 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2426 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
2429 /* Automatically becomes local when set */
2430 return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
2440 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2441 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2443 (symbol, buffer, unbound_value))
2446 CHECK_SYMBOL (symbol);
2447 CHECK_BUFFER (buffer);
2448 value = symbol_value_in_buffer (symbol, buffer);
2449 return UNBOUNDP (value) ? unbound_value : value;
2452 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2453 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2455 (symbol, console, unbound_value))
2458 CHECK_SYMBOL (symbol);
2459 CHECK_CONSOLE (console);
2460 value = symbol_value_in_console (symbol, console);
2461 return UNBOUNDP (value) ? unbound_value : value;
2464 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
2465 If SYMBOL is a built-in variable, return info about this; else return nil.
2466 The returned info will be a symbol, one of
2468 `object' A simple built-in variable.
2469 `const-object' Same, but cannot be set.
2470 `integer' A built-in integer variable.
2471 `const-integer' Same, but cannot be set.
2472 `boolean' A built-in boolean variable.
2473 `const-boolean' Same, but cannot be set.
2474 `const-specifier' Always contains a specifier; e.g. `has-modeline-p'.
2475 `current-buffer' A built-in buffer-local variable.
2476 `const-current-buffer' Same, but cannot be set.
2477 `default-buffer' Forwards to the default value of a built-in
2478 buffer-local variable.
2479 `selected-console' A built-in console-local variable.
2480 `const-selected-console' Same, but cannot be set.
2481 `default-console' Forwards to the default value of a built-in
2482 console-local variable.
2486 REGISTER Lisp_Object valcontents;
2488 CHECK_SYMBOL (symbol);
2491 valcontents = XSYMBOL (symbol)->value;
2494 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2497 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2499 case SYMVAL_LISP_MAGIC:
2500 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2504 case SYMVAL_VARALIAS:
2505 symbol = follow_varalias_pointers (symbol, Qt);
2506 /* presto change-o! */
2509 case SYMVAL_BUFFER_LOCAL:
2510 case SYMVAL_SOME_BUFFER_LOCAL:
2512 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value;
2516 case SYMVAL_FIXNUM_FORWARD: return Qinteger;
2517 case SYMVAL_CONST_FIXNUM_FORWARD: return Qconst_integer;
2518 case SYMVAL_BOOLEAN_FORWARD: return Qboolean;
2519 case SYMVAL_CONST_BOOLEAN_FORWARD: return Qconst_boolean;
2520 case SYMVAL_OBJECT_FORWARD: return Qobject;
2521 case SYMVAL_CONST_OBJECT_FORWARD: return Qconst_object;
2522 case SYMVAL_CONST_SPECIFIER_FORWARD: return Qconst_specifier;
2523 case SYMVAL_DEFAULT_BUFFER_FORWARD: return Qdefault_buffer;
2524 case SYMVAL_CURRENT_BUFFER_FORWARD: return Qcurrent_buffer;
2525 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: return Qconst_current_buffer;
2526 case SYMVAL_DEFAULT_CONSOLE_FORWARD: return Qdefault_console;
2527 case SYMVAL_SELECTED_CONSOLE_FORWARD: return Qselected_console;
2528 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: return Qconst_selected_console;
2529 case SYMVAL_UNBOUND_MARKER: return Qnil;
2532 abort (); return Qnil;
2537 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
2538 Return t if SYMBOL's value is local to BUFFER.
2539 If optional third arg AFTER-SET is true, return t if SYMBOL would be
2540 buffer-local after it is set, regardless of whether it is so presently.
2541 A nil value for BUFFER is *not* the same as (current-buffer), but means
2542 "no buffer". Specifically:
2544 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
2545 the variable is one of the special built-in variables that is always
2546 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
2547 `buffer-undo-list', and others.)
2549 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
2550 the variable has had `make-variable-buffer-local' applied to it.
2552 (symbol, buffer, after_set))
2556 CHECK_SYMBOL (symbol);
2559 buffer = get_buffer (buffer, 1);
2560 local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
2564 local_info = symbol_value_buffer_local_info (symbol, 0);
2567 if (NILP (after_set))
2568 return local_info > 0 ? Qt : Qnil;
2570 return local_info != 0 ? Qt : Qnil;
2575 I've gone ahead and partially implemented this because it's
2576 super-useful for dealing with the compatibility problems in supporting
2577 the old pointer-shape variables, and preventing people from `setq'ing
2578 the new variables. Any other way of handling this problem is way
2579 ugly, likely to be slow, and generally not something I want to waste
2580 my time worrying about.
2582 The interface and/or function name is sure to change before this
2583 gets into its final form. I currently like the way everything is
2584 set up and it has all the features I want it to have, except for
2585 one: I really want to be able to have multiple nested handlers,
2586 to implement an `advice'-like capability. This would allow,
2587 for example, a clean way of implementing `debug-if-set' or
2588 `debug-if-referenced' and such.
2590 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
2591 ************************************************************
2592 **Only** the `set-value', `make-unbound', and `make-local'
2593 handler types are currently implemented. Implementing the
2594 get-value and bound-predicate handlers is somewhat tricky
2595 because there are lots of subfunctions (e.g. find_symbol_value()).
2596 find_symbol_value(), in fact, is called from outside of
2597 this module. You'd have to have it do this:
2599 -- check for a `bound-predicate' handler, call that if so;
2600 if it returns nil, return Qunbound
2601 -- check for a `get-value' handler and call it and return
2604 It gets even trickier when you have to deal with
2605 sub-subfunctions like find_symbol_value_1(), and esp.
2606 when you have to properly handle variable aliases, which
2607 can lead to lots of tricky situations. So I've just
2608 punted on this, since the interface isn't officially
2609 exported and we can get by with just a `set-value'
2612 Actions in unimplemented handler types will correctly
2613 ignore any handlers, and will not fuck anything up or
2616 WARNING WARNING: If you do go and implement another
2617 type of handler, make *sure* to change
2618 would_be_magic_handled() so it knows about this,
2619 or dire things could result.
2620 ************************************************************
2621 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
2623 Real documentation is as follows.
2625 Set a magic handler for VARIABLE.
2626 This allows you to specify arbitrary behavior that results from
2627 accessing or setting a variable. For example, retrieving the
2628 variable's value might actually retrieve the first element off of
2629 a list stored in another variable, and setting the variable's value
2630 might add an element to the front of that list. (This is how the
2631 obsolete variable `unread-command-event' is implemented.)
2633 In general it is NOT good programming practice to use magic variables
2634 in a new package that you are designing. If you feel the need to
2635 do this, it's almost certainly a sign that you should be using a
2636 function instead of a variable. This facility is provided to allow
2637 a package to support obsolete variables and provide compatibility
2638 with similar packages with different variable names and semantics.
2639 By using magic handlers, you can cleanly provide obsoleteness and
2640 compatibility support and separate this support from the core
2641 routines in a package.
2643 VARIABLE should be a symbol naming the variable for which the
2644 magic behavior is provided. HANDLER-TYPE is a symbol specifying
2645 which behavior is being controlled, and HANDLER is the function
2646 that will be called to control this behavior. HARG is a
2647 value that will be passed to HANDLER but is otherwise
2648 uninterpreted. KEEP-EXISTING specifies what to do with existing
2649 handlers of the same type; nil means "erase them all", t means
2650 "keep them but insert at the beginning", the list (t) means
2651 "keep them but insert at the end", a function means "keep
2652 them but insert before the specified function", a list containing
2653 a function means "keep them but insert after the specified
2656 You can specify magic behavior for any type of variable at all,
2657 and for any handler types that are unspecified, the standard
2658 behavior applies. This allows you, for example, to use
2659 `defvaralias' in conjunction with this function. (For that
2660 matter, `defvaralias' could be implemented using this function.)
2662 The behaviors that can be specified in HANDLER-TYPE are
2664 get-value (SYM ARGS FUN HARG HANDLERS)
2665 This means that one of the functions `symbol-value',
2666 `default-value', `symbol-value-in-buffer', or
2667 `symbol-value-in-console' was called on SYM.
2669 set-value (SYM ARGS FUN HARG HANDLERS)
2670 This means that one of the functions `set' or `set-default'
2673 bound-predicate (SYM ARGS FUN HARG HANDLERS)
2674 This means that one of the functions `boundp', `globally-boundp',
2675 or `default-boundp' was called on SYM.
2677 make-unbound (SYM ARGS FUN HARG HANDLERS)
2678 This means that the function `makunbound' was called on SYM.
2680 local-predicate (SYM ARGS FUN HARG HANDLERS)
2681 This means that the function `local-variable-p' was called
2684 make-local (SYM ARGS FUN HARG HANDLERS)
2685 This means that one of the functions `make-local-variable',
2686 `make-variable-buffer-local', `kill-local-variable',
2687 or `kill-console-local-variable' was called on SYM.
2689 The meanings of the arguments are as follows:
2691 SYM is the symbol on which the function was called, and is always
2692 the first argument to the function.
2694 ARGS are the remaining arguments in the original call (i.e. all
2695 but the first). In the case of `set-value' in particular,
2696 the first element of ARGS is the value to which the variable
2697 is being set. In some cases, ARGS is sanitized from what was
2698 actually given. For example, whenever `nil' is passed to an
2699 argument and it means `current-buffer', the current buffer is
2700 substituted instead.
2702 FUN is a symbol indicating which function is being called.
2703 For many of the functions, you can determine the corresponding
2704 function of a different class using
2705 `symbol-function-corresponding-function'.
2707 HARG is the argument that was given in the call
2708 to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
2710 HANDLERS is a structure containing the remaining handlers
2711 for the variable; to call one of them, use
2712 `chain-to-symbol-value-handler'.
2714 NOTE: You may *not* modify the list in ARGS, and if you want to
2715 keep it around after the handler function exits, you must make
2716 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
2719 static enum lisp_magic_handler
2720 decode_magic_handler_type (Lisp_Object symbol)
2722 if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE;
2723 if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE;
2724 if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE;
2725 if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND;
2726 if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE;
2727 if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL;
2729 signal_simple_error ("Unrecognized symbol value handler type", symbol);
2731 return MAGIC_HANDLER_MAX;
2734 static enum lisp_magic_handler
2735 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
2737 if (EQ (funsym, Qsymbol_value)
2738 || EQ (funsym, Qdefault_value)
2739 || EQ (funsym, Qsymbol_value_in_buffer)
2740 || EQ (funsym, Qsymbol_value_in_console))
2741 return MAGIC_HANDLER_GET_VALUE;
2743 if (EQ (funsym, Qset)
2744 || EQ (funsym, Qset_default))
2745 return MAGIC_HANDLER_SET_VALUE;
2747 if (EQ (funsym, Qboundp)
2748 || EQ (funsym, Qglobally_boundp)
2749 || EQ (funsym, Qdefault_boundp))
2750 return MAGIC_HANDLER_BOUND_PREDICATE;
2752 if (EQ (funsym, Qmakunbound))
2753 return MAGIC_HANDLER_MAKE_UNBOUND;
2755 if (EQ (funsym, Qlocal_variable_p))
2756 return MAGIC_HANDLER_LOCAL_PREDICATE;
2758 if (EQ (funsym, Qmake_variable_buffer_local)
2759 || EQ (funsym, Qmake_local_variable))
2760 return MAGIC_HANDLER_MAKE_LOCAL;
2762 if (abort_if_not_found)
2764 signal_simple_error ("Unrecognized symbol-value function", funsym);
2765 return MAGIC_HANDLER_MAX;
2769 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
2771 /* does not take into account variable aliasing. */
2772 Lisp_Object valcontents = XSYMBOL (sym)->value;
2773 enum lisp_magic_handler slot;
2775 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2777 slot = handler_type_from_function_symbol (funsym, 1);
2778 if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND
2779 && slot != MAGIC_HANDLER_MAKE_LOCAL)
2780 /* #### temporary kludge because we haven't implemented
2781 lisp-magic variables completely */
2783 return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
2787 fetch_value_maybe_past_magic (Lisp_Object sym,
2788 Lisp_Object follow_past_lisp_magic)
2790 Lisp_Object value = XSYMBOL (sym)->value;
2791 if (SYMBOL_VALUE_LISP_MAGIC_P (value)
2792 && (EQ (follow_past_lisp_magic, Qt)
2793 || (!NILP (follow_past_lisp_magic)
2794 && !would_be_magic_handled (sym, follow_past_lisp_magic))))
2795 value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed;
2799 static Lisp_Object *
2800 value_slot_past_magic (Lisp_Object sym)
2802 Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
2804 if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
2805 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
2806 return store_pointer;
2810 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
2813 Lisp_Object args[20]; /* should be enough ... */
2815 enum lisp_magic_handler htype;
2816 Lisp_Object legerdemain;
2817 struct symbol_value_lisp_magic *bfwd;
2819 assert (nargs >= 0 && nargs < 20);
2820 legerdemain = XSYMBOL (sym)->value;
2821 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2822 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2824 va_start (vargs, nargs);
2825 for (i = 0; i < nargs; i++)
2826 args[i] = va_arg (vargs, Lisp_Object);
2829 htype = handler_type_from_function_symbol (funsym, 1);
2830 if (NILP (bfwd->handler[htype]))
2832 /* #### should be reusing the arglist, not always consing anew.
2833 Repeated handler invocations should not cause repeated consing.
2834 Doesn't matter for now, because this is just a quick implementation
2835 for obsolescence support. */
2836 return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym,
2837 bfwd->harg[htype], Qnil);
2840 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
2842 Don't you dare use this.
2843 If you do, suffer the wrath of Ben, who is likely to rename
2844 this function (or change the semantics of its arguments) without
2845 pity, thereby invalidating your code.
2847 (variable, handler_type, handler, harg, keep_existing))
2849 Lisp_Object valcontents;
2850 struct symbol_value_lisp_magic *bfwd;
2851 enum lisp_magic_handler htype;
2854 /* #### WARNING, only some handler types are implemented. See above.
2855 Actions of other types will ignore a handler if it's there.
2857 #### Also, `chain-to-symbol-value-handler' and
2858 `symbol-function-corresponding-function' are not implemented. */
2859 CHECK_SYMBOL (variable);
2860 CHECK_SYMBOL (handler_type);
2861 htype = decode_magic_handler_type (handler_type);
2862 valcontents = XSYMBOL (variable)->value;
2863 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2865 bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
2866 lrecord_symbol_value_lisp_magic);
2867 bfwd->magic.type = SYMVAL_LISP_MAGIC;
2868 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2870 bfwd->handler[i] = Qnil;
2871 bfwd->harg[i] = Qnil;
2873 bfwd->shadowed = valcontents;
2874 XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
2877 bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
2878 bfwd->handler[htype] = handler;
2879 bfwd->harg[htype] = harg;
2881 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2882 if (!NILP (bfwd->handler[i]))
2885 if (i == MAGIC_HANDLER_MAX)
2886 /* there are no remaining handlers, so remove the structure. */
2887 XSYMBOL (variable)->value = bfwd->shadowed;
2893 /* functions for working with variable aliases. */
2895 /* Follow the chain of variable aliases for SYMBOL. Return the
2896 resulting symbol, whose value cell is guaranteed not to be a
2897 symbol-value-varalias.
2899 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
2900 If FUNSYM is t, always follow in such a case. If FUNSYM is nil,
2901 never follow; stop right there. Otherwise FUNSYM should be a
2902 recognized symbol-value function symbol; this means, follow
2903 unless there is a special handler for the named function.
2905 OK, there is at least one reason why it's necessary for
2906 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
2907 can always be sure to catch cyclic variable aliasing. If we never
2908 follow past Lisp magic, then if the following is done:
2911 add some magic behavior to a, but not a "get-value" handler
2914 then an attempt to retrieve a's or b's value would cause infinite
2915 looping in `symbol-value'.
2917 We (of course) can't always follow past Lisp magic, because then
2918 we make any variable that is lisp-magic -> varalias behave as if
2919 the lisp-magic is not present at all.
2923 follow_varalias_pointers (Lisp_Object symbol,
2924 Lisp_Object follow_past_lisp_magic)
2926 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
2927 Lisp_Object tortoise, hare, val;
2930 /* quick out just in case */
2931 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value))
2934 /* Compare implementation of indirect_function(). */
2935 for (hare = tortoise = symbol, count = 0;
2936 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic),
2937 SYMBOL_VALUE_VARALIAS_P (val);
2938 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)),
2941 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue;
2944 tortoise = symbol_value_varalias_aliasee
2945 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic
2946 (tortoise, follow_past_lisp_magic)));
2947 if (EQ (hare, tortoise))
2948 return Fsignal (Qcyclic_variable_indirection, list1 (symbol));
2954 DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
2955 Define a variable as an alias for another variable.
2956 Thenceforth, any operations performed on VARIABLE will actually be
2957 performed on ALIAS. Both VARIABLE and ALIAS should be symbols.
2958 If ALIAS is nil, remove any aliases for VARIABLE.
2959 ALIAS can itself be aliased, and the chain of variable aliases
2960 will be followed appropriately.
2961 If VARIABLE already has a value, this value will be shadowed
2962 until the alias is removed, at which point it will be restored.
2963 Currently VARIABLE cannot be a built-in variable, a variable that
2964 has a buffer-local value in any buffer, or the symbols nil or t.
2965 \(ALIAS, however, can be any type of variable.)
2969 struct symbol_value_varalias *bfwd;
2970 Lisp_Object valcontents;
2972 CHECK_SYMBOL (variable);
2973 reject_constant_symbols (variable, Qunbound, 0, Qt);
2975 valcontents = XSYMBOL (variable)->value;
2979 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
2981 XSYMBOL (variable)->value =
2982 symbol_value_varalias_shadowed
2983 (XSYMBOL_VALUE_VARALIAS (valcontents));
2988 CHECK_SYMBOL (alias);
2989 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
2992 XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
2996 if (SYMBOL_VALUE_MAGIC_P (valcontents)
2997 && !UNBOUNDP (valcontents))
2998 signal_simple_error ("Variable is magic and cannot be aliased", variable);
2999 reject_constant_symbols (variable, Qunbound, 0, Qt);
3001 bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
3002 lrecord_symbol_value_varalias);
3003 bfwd->magic.type = SYMVAL_VARALIAS;
3004 bfwd->aliasee = alias;
3005 bfwd->shadowed = valcontents;
3007 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
3008 XSYMBOL (variable)->value = valcontents;
3012 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
3013 If VARIABLE is aliased to another variable, return that variable.
3014 VARIABLE should be a symbol. If VARIABLE is not aliased, return nil.
3015 Variable aliases are created with `defvaralias'. See also
3016 `indirect-variable'.
3018 (variable, follow_past_lisp_magic))
3020 Lisp_Object valcontents;
3022 CHECK_SYMBOL (variable);
3023 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3025 CHECK_SYMBOL (follow_past_lisp_magic);
3026 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3029 valcontents = fetch_value_maybe_past_magic (variable,
3030 follow_past_lisp_magic);
3032 if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3033 return symbol_value_varalias_aliasee
3034 (XSYMBOL_VALUE_VARALIAS (valcontents));
3039 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /*
3040 Return the variable at the end of OBJECT's variable-alias chain.
3041 If OBJECT is a symbol, follow all variable aliases and return
3042 the final (non-aliased) symbol. Variable aliases are created with
3043 the function `defvaralias'.
3044 If OBJECT is not a symbol, just return it.
3045 Signal a cyclic-variable-indirection error if there is a loop in the
3046 variable chain of symbols.
3048 (object, follow_past_lisp_magic))
3050 if (!SYMBOLP (object))
3052 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3054 CHECK_SYMBOL (follow_past_lisp_magic);
3055 handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3057 return follow_varalias_pointers (object, follow_past_lisp_magic);
3061 /************************************************************************/
3062 /* initialization */
3063 /************************************************************************/
3065 /* A dumped XEmacs image has a lot more than 1511 symbols. Last
3066 estimate was that there were actually around 6300. So let's try
3067 making this bigger and see if we get better hashing behavior. */
3068 #define OBARRAY_SIZE 16411
3073 #ifndef Qnull_pointer
3074 Lisp_Object Qnull_pointer;
3077 /* some losing systems can't have static vars at function scope... */
3078 static struct symbol_value_magic guts_of_unbound_marker =
3079 { { symbol_value_forward_lheader_initializer, 0, 69},
3080 SYMVAL_UNBOUND_MARKER };
3082 Lisp_Object Vpure_uninterned_symbol_table;
3085 init_symbols_once_early (void)
3088 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3091 #ifndef Qnull_pointer
3092 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3093 so the following is actually a no-op. */
3094 XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
3097 /* see comment in Fpurecopy() */
3098 Vpure_uninterned_symbol_table =
3099 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3100 staticpro (&Vpure_uninterned_symbol_table);
3102 Qnil = Fmake_symbol (make_pure_pname ((CONST Bufbyte *) "nil", 3, 1));
3103 /* Bootstrapping problem: Qnil isn't set when make_pure_pname is
3104 called the first time. */
3105 XSYMBOL (Qnil)->name->plist = Qnil;
3106 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
3107 XSYMBOL (Qnil)->plist = Qnil;
3109 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3110 initial_obarray = Vobarray;
3111 staticpro (&initial_obarray);
3112 /* Intern nil in the obarray */
3114 int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
3115 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3116 XSYMBOL (Qnil)->obarray = Qt;
3120 /* Required to get around a GCC syntax error on certain
3122 struct symbol_value_magic *tem = &guts_of_unbound_marker;
3124 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3126 if ((CONST void *) XPNTR (Qunbound) !=
3127 (CONST void *)&guts_of_unbound_marker)
3129 /* This might happen on DATA_SEG_BITS machines. */
3131 /* Can't represent a pointer to constant C data using a Lisp_Object.
3132 So heap-allocate it. */
3133 struct symbol_value_magic *urk = xnew (struct symbol_value_magic);
3134 memcpy (urk, &guts_of_unbound_marker, sizeof (*urk));
3135 XSETSYMBOL_VALUE_MAGIC (Qunbound, urk);
3138 XSYMBOL (Qnil)->function = Qunbound;
3140 defsymbol (&Qt, "t");
3141 XSYMBOL (Qt)->value = Qt; /* Veritas aetera */
3146 defsymbol (Lisp_Object *location, CONST char *name)
3148 *location = Fintern (make_pure_pname ((CONST Bufbyte *) name,
3151 staticpro (location);
3155 defkeyword (Lisp_Object *location, CONST char *name)
3157 defsymbol (location, name);
3158 Fset (*location, *location);
3162 /* Check that nobody spazzed writing a DEFUN. */
3164 check_sane_subr (Lisp_Subr *subr, Lisp_Object sym)
3166 assert (subr->min_args >= 0);
3167 assert (subr->min_args <= SUBR_MAX_ARGS);
3169 if (subr->max_args != MANY &&
3170 subr->max_args != UNEVALLED)
3172 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3173 assert (subr->max_args <= SUBR_MAX_ARGS);
3174 assert (subr->min_args <= subr->max_args);
3177 assert (UNBOUNDP (XSYMBOL (sym)->function));
3180 #define check_sane_subr(subr, sym) /* nothing */
3185 * If we are not in a pure undumped Emacs, we need to make a duplicate of
3186 * the subr. This is because the only time this function will be called
3187 * in a running Emacs is when a dynamically loaded module is adding a
3188 * subr, and we need to make sure that the subr is in allocated, Lisp-
3189 * accessible memory. The address assigned to the static subr struct
3190 * in the shared object will be a trampoline address, so we need to create
3191 * a copy here to ensure that a real address is used.
3193 * Once we have copied everything across, we re-use the original static
3194 * structure to store a pointer to the newly allocated one. This will be
3195 * used in emodules.c by emodules_doc_subr() to find a pointer to the
3196 * allocated object so that we can set its doc string propperly.
3198 * NOTE: We dont actually use the DOC pointer here any more, but we did
3199 * in an earlier implementation of module support. There is no harm in
3200 * setting it here in case we ever need it in future implementations.
3201 * subr->doc will point to the new subr structure that was allocated.
3202 * Code can then get this value from the statis subr structure and use
3205 * FIXME: Should newsubr be staticpro()'ed? I dont think so but I need
3208 #define check_module_subr() \
3210 if (initialized) { \
3211 struct Lisp_Subr *newsubr; \
3212 newsubr = (Lisp_Subr *)xmalloc(sizeof(struct Lisp_Subr)); \
3213 memcpy (newsubr, subr, sizeof(struct Lisp_Subr)); \
3214 subr->doc = (CONST char *)newsubr; \
3218 #else /* ! HAVE_SHLIB */
3219 #define check_module_subr()
3223 defsubr (Lisp_Subr *subr)
3225 Lisp_Object sym = intern (subr_name (subr));
3228 check_sane_subr (subr, sym);
3229 check_module_subr ();
3231 XSETSUBR (fun, subr);
3232 XSYMBOL (sym)->function = fun;
3235 /* Define a lisp macro using a Lisp_Subr. */
3237 defsubr_macro (Lisp_Subr *subr)
3239 Lisp_Object sym = intern (subr_name (subr));
3242 check_sane_subr (subr, sym);
3243 check_module_subr();
3245 XSETSUBR (fun, subr);
3246 XSYMBOL (sym)->function = Fcons (Qmacro, fun);
3250 deferror (Lisp_Object *symbol, CONST char *name, CONST char *messuhhj,
3251 Lisp_Object inherits_from)
3254 defsymbol (symbol, name);
3256 assert (SYMBOLP (inherits_from));
3257 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3258 pure_put (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3259 /* NOT build_translated_string (). This function is called at load time
3260 and the string needs to get translated at run time. (This happens
3261 in the function (display-error) in cmdloop.el.) */
3262 pure_put (*symbol, Qerror_message, build_string (messuhhj));
3266 syms_of_symbols (void)
3268 defsymbol (&Qvariable_documentation, "variable-documentation");
3269 defsymbol (&Qvariable_domain, "variable-domain"); /* I18N3 */
3270 defsymbol (&Qad_advice_info, "ad-advice-info");
3271 defsymbol (&Qad_activate, "ad-activate");
3273 defsymbol (&Qget_value, "get-value");
3274 defsymbol (&Qset_value, "set-value");
3275 defsymbol (&Qbound_predicate, "bound-predicate");
3276 defsymbol (&Qmake_unbound, "make-unbound");
3277 defsymbol (&Qlocal_predicate, "local-predicate");
3278 defsymbol (&Qmake_local, "make-local");
3280 defsymbol (&Qboundp, "boundp");
3281 defsymbol (&Qfboundp, "fboundp");
3282 defsymbol (&Qglobally_boundp, "globally-boundp");
3283 defsymbol (&Qmakunbound, "makunbound");
3284 defsymbol (&Qsymbol_value, "symbol-value");
3285 defsymbol (&Qset, "set");
3286 defsymbol (&Qsetq_default, "setq-default");
3287 defsymbol (&Qdefault_boundp, "default-boundp");
3288 defsymbol (&Qdefault_value, "default-value");
3289 defsymbol (&Qset_default, "set-default");
3290 defsymbol (&Qmake_variable_buffer_local, "make-variable-buffer-local");
3291 defsymbol (&Qmake_local_variable, "make-local-variable");
3292 defsymbol (&Qkill_local_variable, "kill-local-variable");
3293 defsymbol (&Qkill_console_local_variable, "kill-console-local-variable");
3294 defsymbol (&Qsymbol_value_in_buffer, "symbol-value-in-buffer");
3295 defsymbol (&Qsymbol_value_in_console, "symbol-value-in-console");
3296 defsymbol (&Qlocal_variable_p, "local-variable-p");
3298 defsymbol (&Qconst_integer, "const-integer");
3299 defsymbol (&Qconst_boolean, "const-boolean");
3300 defsymbol (&Qconst_object, "const-object");
3301 defsymbol (&Qconst_specifier, "const-specifier");
3302 defsymbol (&Qdefault_buffer, "default-buffer");
3303 defsymbol (&Qcurrent_buffer, "current-buffer");
3304 defsymbol (&Qconst_current_buffer, "const-current-buffer");
3305 defsymbol (&Qdefault_console, "default-console");
3306 defsymbol (&Qselected_console, "selected-console");
3307 defsymbol (&Qconst_selected_console, "const-selected-console");
3310 DEFSUBR (Fintern_soft);
3311 DEFSUBR (Funintern);
3312 DEFSUBR (Fmapatoms);
3313 DEFSUBR (Fapropos_internal);
3315 DEFSUBR (Fsymbol_function);
3316 DEFSUBR (Fsymbol_plist);
3317 DEFSUBR (Fsymbol_name);
3318 DEFSUBR (Fmakunbound);
3319 DEFSUBR (Ffmakunbound);
3321 DEFSUBR (Fglobally_boundp);
3324 DEFSUBR (Fdefine_function);
3325 Ffset (intern ("defalias"), intern ("define-function"));
3326 DEFSUBR (Fsetplist);
3327 DEFSUBR (Fsymbol_value_in_buffer);
3328 DEFSUBR (Fsymbol_value_in_console);
3329 DEFSUBR (Fbuilt_in_variable_type);
3330 DEFSUBR (Fsymbol_value);
3332 DEFSUBR (Fdefault_boundp);
3333 DEFSUBR (Fdefault_value);
3334 DEFSUBR (Fset_default);
3335 DEFSUBR (Fsetq_default);
3336 DEFSUBR (Fmake_variable_buffer_local);
3337 DEFSUBR (Fmake_local_variable);
3338 DEFSUBR (Fkill_local_variable);
3339 DEFSUBR (Fkill_console_local_variable);
3340 DEFSUBR (Flocal_variable_p);
3341 DEFSUBR (Fdefvaralias);
3342 DEFSUBR (Fvariable_alias);
3343 DEFSUBR (Findirect_variable);
3344 DEFSUBR (Fdontusethis_set_symbol_value_handler);
3347 /* Create and initialize a Lisp variable whose value is forwarded to C data */
3349 defvar_magic (CONST char *symbol_name, CONST struct symbol_value_forward *magic)
3351 Lisp_Object sym, kludge;
3353 /* Check that `magic' points somewhere we can represent as a Lisp pointer */
3354 XSETOBJ (kludge, Lisp_Type_Record, magic);
3355 if ((void *)magic != (void*) XPNTR (kludge))
3357 /* This might happen on DATA_SEG_BITS machines. */
3359 /* Copy it to somewhere which is representable. */
3360 struct symbol_value_forward *p = xnew (struct symbol_value_forward);
3361 memcpy (p, magic, sizeof *magic);
3365 #if defined(HAVE_SHLIB)
3367 * As with defsubr(), this will only be called in a dumped Emacs when
3368 * we are adding variables from a dynamically loaded module. That means
3369 * we can't use purespace. Take that into account.
3372 sym = Fintern (build_string (symbol_name), Qnil);
3375 sym = Fintern (make_pure_pname ((CONST Bufbyte *) symbol_name,
3376 strlen (symbol_name), 1), Qnil);
3378 XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic);
3382 vars_of_symbols (void)
3384 DEFVAR_LISP ("obarray", &Vobarray /*
3385 Symbol table for use by `intern' and `read'.
3386 It is a vector whose length ought to be prime for best results.
3387 The vector's contents don't make sense if examined from Lisp programs;
3388 to find all the symbols in an obarray, use `mapatoms'.
3390 /* obarray has been initialized long before */