git.chise.org Git - chise/xemacs-chise.git.1/blob - src/symbols.c

   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.
   4
   5 This file is part of XEmacs.
   6
   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
  10 later version.
  11
  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
  15 for more details.
  16
  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.  */
  21
  22 /* Synched up with: FSF 19.30. */
  23
  24 /* This file has been Mule-ized. */
  25
  26 /* NOTE:
  27
  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:
  31
  32    1a) simple value
  33    1b) Qunbound
  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
  40
  41    The "chain" of a symbol-value-buffer-local is its current_value slot.
  42
  43    The "chain" of a symbol-value-lisp-magic is its shadowed slot, which
  44    applies for handler types without associated handlers.
  45
  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.
  48
  49 */
  50
  51 /* #### Ugh, though, this file does awful things with symbol-value-magic
  52    objects.  This ought to be cleaned up. */
  53
  54 #include <config.h>
  55 #include "lisp.h"
  56
  57 #include "buffer.h"             /* for Vbuffer_defaults */
  58 #include "console.h"
  59 #include "elhash.h"
  60
  61 Lisp_Object Qad_advice_info, Qad_activate;
  62
  63 Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound;
  64 Lisp_Object Qlocal_predicate, Qmake_local;
  65
  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;
  73
  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;
  78
  79 static Lisp_Object maybe_call_magic_handler (Lisp_Object sym,
  80                                              Lisp_Object funsym,
  81                                              int nargs, ...);
  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);
  87
  88 \f
  89 #ifdef LRECORD_SYMBOL
  90
  91 static Lisp_Object
  92 mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object))
  93 {
  94   struct Lisp_Symbol *sym = XSYMBOL (obj);
  95   Lisp_Object pname;
  96
  97   markobj (sym->value);
  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);
 102   markobj (pname);
 103   if (!symbol_next (sym))
 104     return sym->plist;
 105   else
 106   {
 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);
 111     return obj;
 112   }
 113 }
 114
 115 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
 116                                      mark_symbol, print_symbol, 0, 0, 0,
 117                                      struct Lisp_Symbol);
 118 #endif /* LRECORD_SYMBOL */
 119
 120 \f
 121 /**********************************************************************/
 122 /*                              Intern                                */
 123 /**********************************************************************/
 124
 125 /* #### using a vector here is way bogus.  Use a hash table instead. */
 126
 127 Lisp_Object Vobarray;
 128
 129 static Lisp_Object initial_obarray;
 130
 131 /* oblookup stores the bucket number here, for the sake of Funintern.  */
 132
 133 static int oblookup_last_bucket_number;
 134
 135 static Lisp_Object
 136 check_obarray (Lisp_Object obarray)
 137 {
 138   while (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
 139     {
 140       /* If Vobarray is now invalid, force it to be valid.  */
 141       if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
 142
 143       obarray = wrong_type_argument (Qvectorp, obarray);
 144     }
 145   return obarray;
 146 }
 147
 148 Lisp_Object
 149 intern (CONST char *str)
 150 {
 151   Bytecount len = strlen (str);
 152   CONST Bufbyte *buf = (CONST Bufbyte *) str;
 153   Lisp_Object obarray = Vobarray;
 154
 155   if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
 156     obarray = check_obarray (obarray);
 157
 158   {
 159     Lisp_Object tem = oblookup (obarray, buf, len);
 160     if (SYMBOLP (tem))
 161       return tem;
 162   }
 163
 164   return Fintern ((purify_flag
 165                    ? make_pure_pname (buf, len, 0)
 166                    : make_string (buf, len)),
 167                   obarray);
 168 }
 169
 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'.
 175 */
 176        (string, obarray))
 177 {
 178   Lisp_Object sym, *ptr;
 179   Bytecount len;
 180
 181   if (NILP (obarray)) obarray = Vobarray;
 182   obarray = check_obarray (obarray);
 183
 184   CHECK_STRING (string);
 185
 186   len = XSTRING_LENGTH (string);
 187   sym = oblookup (obarray, XSTRING_DATA (string), len);
 188   if (!INTP (sym))
 189     /* Found it */
 190     return sym;
 191
 192   ptr = &XVECTOR_DATA (obarray)[XINT (sym)];
 193
 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.
 202
 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
 205      pure objects.  */
 206   if (EQ (obarray, Vobarray))
 207     XSYMBOL (sym)->obarray = Qt;
 208
 209   if (SYMBOLP (*ptr))
 210     symbol_next (XSYMBOL (sym)) = XSYMBOL (*ptr);
 211   else
 212     symbol_next (XSYMBOL (sym)) = 0;
 213   *ptr = sym;
 214   return sym;
 215 }
 216
 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'.
 221 */
 222        (string, obarray))
 223 {
 224   Lisp_Object tem;
 225
 226   if (NILP (obarray)) obarray = Vobarray;
 227   obarray = check_obarray (obarray);
 228
 229   CHECK_STRING (string);
 230
 231   tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string));
 232   return !INTP (tem) ? tem : Qnil;
 233 }
 234 \f
 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'
 241 */
 242        (name, obarray))
 243 {
 244   Lisp_Object string, tem;
 245   int hash;
 246
 247   if (NILP (obarray)) obarray = Vobarray;
 248   obarray = check_obarray (obarray);
 249
 250   if (SYMBOLP (name))
 251     XSETSTRING (string, XSYMBOL (name)->name);
 252   else
 253     {
 254       CHECK_STRING (name);
 255       string = name;
 256     }
 257
 258   tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string));
 259   if (INTP (tem))
 260     return Qnil;
 261   /* If arg was a symbol, don't delete anything but that symbol itself.  */
 262   if (SYMBOLP (name) && !EQ (name, tem))
 263     return Qnil;
 264
 265   hash = oblookup_last_bucket_number;
 266
 267   if (EQ (XVECTOR_DATA (obarray)[hash], tem))
 268     {
 269       if (XSYMBOL (tem)->next)
 270         XSETSYMBOL (XVECTOR_DATA (obarray)[hash], XSYMBOL (tem)->next);
 271       else
 272         XVECTOR_DATA (obarray)[hash] = Qzero;
 273     }
 274   else
 275     {
 276       Lisp_Object tail, following;
 277
 278       for (tail = XVECTOR_DATA (obarray)[hash];
 279            XSYMBOL (tail)->next;
 280            tail = following)
 281         {
 282           XSETSYMBOL (following, XSYMBOL (tail)->next);
 283           if (EQ (following, tem))
 284             {
 285               XSYMBOL (tail)->next = XSYMBOL (following)->next;
 286               break;
 287             }
 288         }
 289     }
 290   XSYMBOL (tem)->obarray = Qnil;
 291   return Qt;
 292 }
 293 \f
 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.
 297
 298    Also store the bucket number in oblookup_last_bucket_number.  */
 299
 300 Lisp_Object
 301 oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size)
 302 {
 303   int hash, obsize;
 304   struct Lisp_Symbol *tail;
 305   Lisp_Object bucket;
 306
 307   if (!VECTORP (obarray) ||
 308       (obsize = XVECTOR_LENGTH (obarray)) == 0)
 309     {
 310       obarray = check_obarray (obarray);
 311       obsize = XVECTOR_LENGTH (obarray);
 312     }
 313 #if 0 /* FSFmacs */
 314   /* #### Huh? */
 315   /* This is sometimes needed in the middle of GC.  */
 316   obsize &= ~ARRAY_MARK_FLAG;
 317 #endif
 318   hash = hash_string (ptr, size) % obsize;
 319   oblookup_last_bucket_number = hash;
 320   bucket = XVECTOR_DATA (obarray)[hash];
 321   if (ZEROP (bucket))
 322     ;
 323   else if (!SYMBOLP (bucket))
 324     error ("Bad data in guts of obarray"); /* Like CADR error message */
 325   else
 326     for (tail = XSYMBOL (bucket); ;)
 327       {
 328         if (string_length (tail->name) == size &&
 329             !memcmp (string_data (tail->name), ptr, size))
 330           {
 331             XSETSYMBOL (bucket, tail);
 332             return bucket;
 333           }
 334         tail = symbol_next (tail);
 335         if (!tail)
 336           break;
 337       }
 338   return make_int (hash);
 339 }
 340
 341 #if 0 /* Emacs 19.34 */
 342 int
 343 hash_string (CONST Bufbyte *ptr, Bytecount len)
 344 {
 345   CONST Bufbyte *p = ptr;
 346   CONST Bufbyte *end = p + len;
 347   Bufbyte c;
 348   int hash = 0;
 349
 350   while (p != end)
 351     {
 352       c = *p++;
 353       if (c >= 0140) c -= 40;
 354       hash = ((hash<<3) + (hash>>28) + c);
 355     }
 356   return hash & 07777777777;
 357 }
 358 #endif
 359
 360 /* derived from hashpjw, Dragon Book P436. */
 361 int
 362 hash_string (CONST Bufbyte *ptr, Bytecount len)
 363 {
 364   int hash = 0;
 365
 366   while (len-- > 0)
 367     {
 368       int g;
 369       hash = (hash << 4) + *ptr++;
 370       g = hash & 0xf0000000;
 371       if (g)
 372         hash = (hash ^ (g >> 24)) ^ g;
 373     }
 374   return hash & 07777777777;
 375 }
 376
 377 /* Map FN over OBARRAY.  The mapping is stopped when FN returns a
 378    non-zero value.  */
 379 void
 380 map_obarray (Lisp_Object obarray,
 381              int (*fn) (Lisp_Object, void *), void *arg)
 382 {
 383   REGISTER int i;
 384
 385   CHECK_VECTOR (obarray);
 386   for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--)
 387     {
 388       Lisp_Object tail = XVECTOR_DATA (obarray)[i];
 389       if (SYMBOLP (tail))
 390         while (1)
 391           {
 392             struct Lisp_Symbol *next;
 393             if ((*fn) (tail, arg))
 394               return;
 395             next = symbol_next (XSYMBOL (tail));
 396             if (!next)
 397               break;
 398             XSETSYMBOL (tail, next);
 399           }
 400     }
 401 }
 402
 403 static int
 404 mapatoms_1 (Lisp_Object sym, void *arg)
 405 {
 406   call1 (*(Lisp_Object *)arg, sym);
 407   return 0;
 408 }
 409
 410 DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /*
 411 Call FUNCTION on every symbol in OBARRAY.
 412 OBARRAY defaults to the value of `obarray'.
 413 */
 414        (function, obarray))
 415 {
 416   if (NILP (obarray))
 417     obarray = Vobarray;
 418   obarray = check_obarray (obarray);
 419
 420   map_obarray (obarray, mapatoms_1, &function);
 421   return Qnil;
 422 }
 423
 424 \f
 425 /**********************************************************************/
 426 /*                              Apropos                               */
 427 /**********************************************************************/
 428
 429 struct appropos_mapper_closure
 430 {
 431   Lisp_Object regexp;
 432   Lisp_Object predicate;
 433   Lisp_Object accumulation;
 434 };
 435
 436 static int
 437 apropos_mapper (Lisp_Object symbol, void *arg)
 438 {
 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));
 443
 444   if (match >= 0 &&
 445       (NILP (closure->predicate) ||
 446        !NILP (call1 (closure->predicate, symbol))))
 447     closure->accumulation = Fcons (symbol, closure->accumulation);
 448
 449   return 0;
 450 }
 451
 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
 456  returns non-nil.
 457 Return list of symbols found.
 458 */
 459        (regexp, predicate))
 460 {
 461   struct appropos_mapper_closure closure;
 462
 463   CHECK_STRING (regexp);
 464
 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;
 471 }
 472
 473 \f
 474 /* Extract and set components of symbols */
 475
 476 static void set_up_buffer_local_cache (Lisp_Object sym,
 477                                        struct symbol_value_buffer_local *bfwd,
 478                                        struct buffer *buf,
 479                                        Lisp_Object new_alist_el,
 480                                        int set_it_p);
 481
 482 DEFUN ("boundp", Fboundp, 1, 1, 0, /*
 483 Return t if SYMBOL's value is not void.
 484 */
 485        (symbol))
 486 {
 487   CHECK_SYMBOL (symbol);
 488   return UNBOUNDP (find_symbol_value (symbol)) ? Qnil : Qt;
 489 }
 490
 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.
 494 */
 495        (symbol))
 496 {
 497   CHECK_SYMBOL (symbol);
 498   return UNBOUNDP (top_level_value (symbol)) ? Qnil : Qt;
 499 }
 500
 501 DEFUN ("fboundp", Ffboundp, 1, 1, 0, /*
 502 Return t if SYMBOL's function definition is not void.
 503 */
 504        (symbol))
 505 {
 506   CHECK_SYMBOL (symbol);
 507   return UNBOUNDP (XSYMBOL (symbol)->function) ? Qnil : Qt;
 508 }
 509
 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. */
 512
 513 static int
 514 symbol_is_constant (Lisp_Object sym, Lisp_Object val)
 515 {
 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) ||
 521       EQ (sym, Qt))
 522     return 1;
 523
 524   if (SYMBOL_VALUE_MAGIC_P (val))
 525     switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
 526       {
 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:
 533         return 1;
 534       default: break; /* Warning suppression */
 535       }
 536
 537   /* We don't return true for keywords here because they are handled
 538      specially by reject_constant_symbols().  */
 539   return 0;
 540 }
 541
 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.  */
 546
 547 void
 548 reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p,
 549                          Lisp_Object follow_past_lisp_magic)
 550 {
 551   Lisp_Object val =
 552     (function_p ? XSYMBOL (sym)->function
 553      : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
 554
 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",
 558                          sym);
 559
 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));
 565 }
 566
 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.) */
 572
 573 static void
 574 verify_ok_for_buffer_local (Lisp_Object sym,
 575                             Lisp_Object follow_past_lisp_magic)
 576 {
 577   Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic);
 578
 579   if (symbol_is_constant (sym, val))
 580     goto not_ok;
 581   if (SYMBOL_VALUE_MAGIC_P (val))
 582     switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
 583       {
 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:
 590           goto not_ok;
 591       default: break; /* Warning suppression */
 592       }
 593
 594   return;
 595
 596   not_ok:
 597   signal_error (Qerror,
 598                 list2 (build_string ("Symbol may not be buffer-local"), sym));
 599 }
 600
 601 DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /*
 602 Make SYMBOL's value be void.
 603 */
 604        (symbol))
 605 {
 606   Fset (symbol, Qunbound);
 607   return symbol;
 608 }
 609
 610 DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /*
 611 Make SYMBOL's function definition be void.
 612 */
 613        (symbol))
 614 {
 615   CHECK_SYMBOL (symbol);
 616   reject_constant_symbols (symbol, Qunbound, 1, Qt);
 617   XSYMBOL (symbol)->function = Qunbound;
 618   return symbol;
 619 }
 620
 621 DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /*
 622 Return SYMBOL's function definition.  Error if that is void.
 623 */
 624        (symbol))
 625 {
 626   CHECK_SYMBOL (symbol);
 627   if (UNBOUNDP (XSYMBOL (symbol)->function))
 628     signal_void_function_error (symbol);
 629   return XSYMBOL (symbol)->function;
 630 }
 631
 632 DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /*
 633 Return SYMBOL's property list.
 634 */
 635        (symbol))
 636 {
 637   CHECK_SYMBOL (symbol);
 638   return XSYMBOL (symbol)->plist;
 639 }
 640
 641 DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /*
 642 Return SYMBOL's name, a string.
 643 */
 644        (symbol))
 645 {
 646   Lisp_Object name;
 647
 648   CHECK_SYMBOL (symbol);
 649   XSETSTRING (name, XSYMBOL (symbol)->name);
 650   return name;
 651 }
 652
 653 DEFUN ("fset", Ffset, 2, 2, 0, /*
 654 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
 655 */
 656        (symbol, newdef))
 657 {
 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),
 663                              Vautoload_queue);
 664   XSYMBOL (symbol)->function = newdef;
 665   /* Handle automatic advice activation */
 666   if (CONSP (XSYMBOL (symbol)->plist) &&
 667       !NILP (Fget (symbol, Qad_advice_info, Qnil)))
 668     {
 669       call2 (Qad_activate, symbol, Qnil);
 670       newdef = XSYMBOL (symbol)->function;
 671     }
 672   return newdef;
 673 }
 674
 675 /* FSFmacs */
 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.
 679 */
 680        (symbol, newdef))
 681 {
 682   /* This function can GC */
 683   Ffset (symbol, newdef);
 684   LOADHIST_ATTACH (symbol);
 685   return newdef;
 686 }
 687
 688
 689 DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
 690 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
 691 */
 692        (symbol, newplist))
 693 {
 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();
 699 #endif
 700
 701   XSYMBOL (symbol)->plist = newplist;
 702   return newplist;
 703 }
 704
 705 \f
 706 /**********************************************************************/
 707 /*                           symbol-value                             */
 708 /**********************************************************************/
 709
 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.
 715
 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.
 720
 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
 728    symeval.h.
 729
 730    1. symbol-value-forward
 731
 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.
 739
 740    The subtypes are as follows:
 741
 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.)
 751
 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.
 757
 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
 762        DEFVAR_CONST_BOOL)
 763       Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
 764       SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
 765       be changed.
 766
 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.
 772
 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.
 793
 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.
 798
 799    SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
 800       (declare with DEFVAR_CONST_BUFFER_LOCAL)
 801       Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
 802       value cannot be set.
 803
 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.
 810
 811    SYMVAL_UNBOUND_MARKER:
 812       This is used for only one object, Qunbound.
 813
 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.
 824
 825    SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
 826       (declare with DEFVAR_CONST_CONSOLE_LOCAL)
 827       Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
 828       value cannot be set.
 829
 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.
 836
 837
 838    2. symbol-value-buffer-local
 839
 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.
 854
 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.)
 869
 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.
 881
 882
 883    3. symbol-value-varalias
 884
 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.  */
 893
 894 static Lisp_Object
 895 mark_symbol_value_buffer_local (Lisp_Object obj,
 896                                 void (*markobj) (Lisp_Object))
 897 {
 898   struct symbol_value_buffer_local *bfwd;
 899
 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);
 903 #endif
 904
 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;
 910 }
 911
 912 static Lisp_Object
 913 mark_symbol_value_lisp_magic (Lisp_Object obj,
 914                               void (*markobj) (Lisp_Object))
 915 {
 916   struct symbol_value_lisp_magic *bfwd;
 917   int i;
 918
 919   assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
 920
 921   bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
 922   for (i = 0; i < MAGIC_HANDLER_MAX; i++)
 923     {
 924       markobj (bfwd->handler[i]);
 925       markobj (bfwd->harg[i]);
 926     }
 927   return bfwd->shadowed;
 928 }
 929
 930 static Lisp_Object
 931 mark_symbol_value_varalias (Lisp_Object obj,
 932                             void (*markobj) (Lisp_Object))
 933 {
 934   struct symbol_value_varalias *bfwd;
 935
 936   assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
 937
 938   bfwd = XSYMBOL_VALUE_VARALIAS (obj);
 939   markobj (bfwd->shadowed);
 940   return bfwd->aliasee;
 941 }
 942
 943 /* Should never, ever be called. (except by an external debugger) */
 944 void
 945 print_symbol_value_magic (Lisp_Object obj,
 946                           Lisp_Object printcharfun, int escapeflag)
 947 {
 948   char buf[200];
 949   sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s type %d) 0x%lx>",
 950            XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
 951            XSYMBOL_VALUE_MAGIC_TYPE (obj),
 952            (long) XPNTR (obj));
 953   write_c_string (buf, printcharfun);
 954 }
 955
 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);
 961
 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);
 967
 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);
 973
 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);
 979
 980 \f
 981 /* Getting and setting values of symbols */
 982
 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.
 986
 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.
 991
 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.
 996  */
 997
 998 static Lisp_Object
 999 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
1000                       struct console *console)
1001 {
1002   CONST struct symbol_value_forward *fwd;
1003
1004   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1005     return valcontents;
1006
1007   fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1008   switch (fwd->magic.type)
1009     {
1010     case SYMVAL_FIXNUM_FORWARD:
1011     case SYMVAL_CONST_FIXNUM_FORWARD:
1012       return make_int (*((int *)symbol_value_forward_forward (fwd)));
1013
1014     case SYMVAL_BOOLEAN_FORWARD:
1015     case SYMVAL_CONST_BOOLEAN_FORWARD:
1016       return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
1017
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));
1022
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))));
1027
1028
1029     case SYMVAL_CURRENT_BUFFER_FORWARD:
1030     case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1031       assert (buffer);
1032       return (*((Lisp_Object *)((char *)buffer
1033                                 + ((char *)symbol_value_forward_forward (fwd)
1034                                    - (char *)&buffer_local_flags))));
1035
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))));
1040
1041     case SYMVAL_SELECTED_CONSOLE_FORWARD:
1042     case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1043       assert (console);
1044       return (*((Lisp_Object *)((char *)console
1045                                 + ((char *)symbol_value_forward_forward (fwd)
1046                                    - (char *)&console_local_flags))));
1047
1048     case SYMVAL_UNBOUND_MARKER:
1049       return valcontents;
1050
1051     default:
1052       abort ();
1053     }
1054   return Qnil;  /* suppress compiler warning */
1055 }
1056
1057 /* Set the value of default-buffer-local variable SYM to VALUE. */
1058
1059 static void
1060 set_default_buffer_slot_variable (Lisp_Object sym,
1061                                   Lisp_Object value)
1062 {
1063   /* Handle variables like case-fold-search that have special slots in
1064      the buffer. Make them work apparently like buffer_local variables.
1065      */
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);
1077
1078   *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
1079     = value;
1080
1081   if (mask > 0)         /* Not always per-buffer */
1082     {
1083       Lisp_Object elt;
1084
1085       /* Set value in each buffer which hasn't shadowed the default */
1086       LIST_LOOP_2 (elt, Vbuffer_alist)
1087         {
1088           struct buffer *b = XBUFFER (XCDR (elt));
1089           if (!(b->local_var_flags & mask))
1090             {
1091               if (magicfun)
1092                 magicfun (sym, &value, make_buffer (b), 0);
1093               *((Lisp_Object *) (offset + (char *) b)) = value;
1094             }
1095         }
1096     }
1097 }
1098
1099 /* Set the value of default-console-local variable SYM to VALUE. */
1100
1101 static void
1102 set_default_console_slot_variable (Lisp_Object sym,
1103                                    Lisp_Object value)
1104 {
1105   /* Handle variables like case-fold-search that have special slots in
1106      the console. Make them work apparently like console_local variables.
1107      */
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);
1119
1120   *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
1121     = value;
1122
1123   if (mask > 0)         /* Not always per-console */
1124     {
1125       Lisp_Object console;
1126
1127       /* Set value in each console which hasn't shadowed the default */
1128       LIST_LOOP_2 (console, Vconsole_list)
1129         {
1130           struct console *d = XCONSOLE (console);
1131           if (!(d->local_var_flags & mask))
1132             {
1133               if (magicfun)
1134                 magicfun (sym, &value, console, 0);
1135               *((Lisp_Object *) (offset + (char *) d)) = value;
1136             }
1137         }
1138     }
1139 }
1140
1141 /* Store NEWVAL into SYM.
1142
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.)
1146
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).
1150
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.
1158   */
1159
1160 static void
1161 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
1162                          Lisp_Object newval)
1163 {
1164   if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
1165     {
1166       Lisp_Object *store_pointer = value_slot_past_magic (sym);
1167
1168       if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
1169         store_pointer =
1170           &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
1171
1172       assert (UNBOUNDP (*store_pointer)
1173               || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1174       *store_pointer = newval;
1175     }
1176   else
1177     {
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);
1182
1183       switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue))
1184         {
1185         case SYMVAL_FIXNUM_FORWARD:
1186           CHECK_INT (newval);
1187           if (magicfun)
1188             magicfun (sym, &newval, Qnil, 0);
1189           *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
1190           return;
1191
1192         case SYMVAL_BOOLEAN_FORWARD:
1193           if (magicfun)
1194             magicfun (sym, &newval, Qnil, 0);
1195           *((int *) symbol_value_forward_forward (fwd))
1196             = ((NILP (newval)) ? 0 : 1);
1197           return;
1198
1199         case SYMVAL_OBJECT_FORWARD:
1200           if (magicfun)
1201             magicfun (sym, &newval, Qnil, 0);
1202           *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
1203           return;
1204
1205         case SYMVAL_DEFAULT_BUFFER_FORWARD:
1206           set_default_buffer_slot_variable (sym, newval);
1207           return;
1208
1209         case SYMVAL_CURRENT_BUFFER_FORWARD:
1210           if (magicfun)
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)))
1215             = newval;
1216           return;
1217
1218         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1219           set_default_console_slot_variable (sym, newval);
1220           return;
1221
1222         case SYMVAL_SELECTED_CONSOLE_FORWARD:
1223           if (magicfun)
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)))
1228             = newval;
1229           return;
1230
1231         default:
1232           abort ();
1233         }
1234     }
1235 }
1236
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).
1242    */
1243
1244 static Lisp_Object
1245 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
1246                             struct symbol_value_buffer_local *bfwd)
1247 {
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;
1252   else
1253     return assq_no_quit (symbol, buffer->local_var_alist);
1254 }
1255
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.]
1260
1261    Write out any cached value in buffer-local variable SYMBOL's
1262    buffer-local structure, which is passed in as BFWD.
1263 */
1264
1265 static void
1266 write_out_buffer_local_cache (Lisp_Object symbol,
1267                               struct symbol_value_buffer_local *bfwd)
1268 {
1269   if (!NILP (bfwd->current_buffer))
1270     {
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;
1277       else
1278         Fsetcdr (bfwd->current_alist_element, cval);
1279     }
1280 }
1281
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).
1286
1287    If the cache is already set up for BUF, this function does nothing
1288    at all.
1289
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
1293    current buffer.
1294
1295    (Otherwise, you can just retrieve the value without changing the
1296    cache, at the expense of slower retrieval.)
1297 */
1298
1299 static void
1300 set_up_buffer_local_cache (Lisp_Object sym,
1301                            struct symbol_value_buffer_local *bfwd,
1302                            struct buffer *buf,
1303                            Lisp_Object new_alist_el,
1304                            int set_it_p)
1305 {
1306   Lisp_Object new_val;
1307
1308   if (!NILP (bfwd->current_buffer)
1309       && buf == XBUFFER (bfwd->current_buffer))
1310     /* Cache is already set up. */
1311     return;
1312
1313   /* Flush out the old cache. */
1314   write_out_buffer_local_cache (sym, bfwd);
1315
1316   /* Retrieve the new alist element and new value. */
1317   if (NILP (new_alist_el)
1318       && set_it_p)
1319     new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1320
1321   if (NILP (new_alist_el))
1322     new_val = bfwd->default_value;
1323   else
1324     new_val = Fcdr (new_alist_el);
1325
1326   bfwd->current_alist_element = new_alist_el;
1327   XSETBUFFER (bfwd->current_buffer, buf);
1328
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.
1333
1334      We might also want to call a magic function.
1335
1336      So instead, we call this function. */
1337   store_symval_forwarding (sym, bfwd->current_value, new_val);
1338 }
1339
1340 \f
1341 void
1342 kill_buffer_local_variables (struct buffer *buf)
1343 {
1344   Lisp_Object prev = Qnil;
1345   Lisp_Object alist;
1346
1347   /* Any which are supposed to be permanent,
1348      make local again, with the same values they had.  */
1349
1350   for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
1351     {
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
1358          already called. */
1359       Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
1360
1361       assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
1362       bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
1363
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! */
1369         prev = alist;
1370       else
1371         {
1372           /* Really truly kill it. */
1373           if (!NILP (prev))
1374             XCDR (prev) = XCDR (alist);
1375           else
1376             buf->local_var_alist = XCDR (alist);
1377
1378           /* We just effectively changed the value for this variable
1379              in BUF. So: */
1380
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;
1385
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);
1393         }
1394     }
1395 }
1396 \f
1397 static Lisp_Object
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)
1401 {
1402   Lisp_Object valcontents;
1403
1404  retry:
1405   valcontents = XSYMBOL (sym)->value;
1406
1407  retry_2:
1408   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1409     return valcontents;
1410
1411   switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1412     {
1413     case SYMVAL_LISP_MAGIC:
1414       /* #### kludge */
1415       valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1416       /* semi-change-o */
1417       goto retry_2;
1418
1419     case SYMVAL_VARALIAS:
1420       sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1421       symcons = Qnil;
1422       /* presto change-o! */
1423       goto retry;
1424
1425     case SYMVAL_BUFFER_LOCAL:
1426     case SYMVAL_SOME_BUFFER_LOCAL:
1427       {
1428         struct symbol_value_buffer_local *bfwd
1429           = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1430
1431         if (swap_it_in)
1432           {
1433             set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1434             valcontents = bfwd->current_value;
1435           }
1436         else
1437           {
1438             if (!NILP (bfwd->current_buffer) &&
1439                 buf == XBUFFER (bfwd->current_buffer))
1440               valcontents = bfwd->current_value;
1441             else if (NILP (symcons))
1442               {
1443                 if (set_it_p)
1444                   valcontents = assq_no_quit (sym, buf->local_var_alist);
1445                 if (NILP (valcontents))
1446                   valcontents = bfwd->default_value;
1447                 else
1448                   valcontents = XCDR (valcontents);
1449               }
1450             else
1451               valcontents = XCDR (symcons);
1452           }
1453         break;
1454       }
1455
1456     default:
1457       break;
1458     }
1459   return do_symval_forwarding (valcontents, buf, con);
1460 }
1461
1462
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
1465    function. */
1466
1467 Lisp_Object
1468 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
1469 {
1470   struct buffer *buf;
1471
1472   CHECK_SYMBOL (sym);
1473
1474   if (NILP (buffer))
1475     buf = current_buffer;
1476   else
1477     {
1478       CHECK_BUFFER (buffer);
1479       buf = XBUFFER (buffer);
1480     }
1481
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);
1487 }
1488
1489 static Lisp_Object
1490 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1491 {
1492   CHECK_SYMBOL (sym);
1493
1494   if (NILP (console))
1495     console = Vselected_console;
1496   else
1497     CHECK_CONSOLE (console);
1498
1499   return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1500                               Qnil, 1);
1501 }
1502
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. */
1507
1508 Lisp_Object
1509 find_symbol_value (Lisp_Object sym)
1510 {
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;
1515
1516   CHECK_SYMBOL (sym);
1517
1518   valcontents = XSYMBOL (sym)->value;
1519   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1520     return valcontents;
1521
1522   if (CONSOLEP (Vselected_console))
1523     con = XCONSOLE (Vselected_console);
1524   else
1525     {
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);
1530       con = 0;
1531     }
1532
1533   return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
1534 }
1535
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.
1539    or
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
1544    is the symbol.
1545
1546    This function is called from set_buffer_internal which does both of these
1547    things. */
1548
1549 Lisp_Object
1550 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1551 {
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;
1556
1557   CHECK_SYMBOL (sym);
1558   if (CONSOLEP (Vselected_console))
1559     con = XCONSOLE (Vselected_console);
1560   else
1561     {
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);
1566       con = 0;
1567     }
1568
1569   return find_symbol_value_1 (sym, current_buffer, con, 1,
1570                               find_it_p ? symbol_cons : Qnil,
1571                               find_it_p);
1572 }
1573
1574 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1575 Return SYMBOL's value.  Error if that is void.
1576 */
1577        (symbol))
1578 {
1579   Lisp_Object val = find_symbol_value (symbol);
1580
1581   if (UNBOUNDP (val))
1582     return Fsignal (Qvoid_variable, list1 (symbol));
1583   else
1584     return val;
1585 }
1586
1587 DEFUN ("set", Fset, 2, 2, 0, /*
1588 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1589 */
1590        (symbol, newval))
1591 {
1592   REGISTER Lisp_Object valcontents;
1593   struct Lisp_Symbol *sym;
1594   /* remember, we're called by Fmakunbound() as well */
1595
1596   CHECK_SYMBOL (symbol);
1597
1598  retry:
1599   sym = XSYMBOL (symbol);
1600   valcontents = sym->value;
1601
1602   if (EQ (symbol, Qnil) ||
1603       EQ (symbol, Qt)   ||
1604       SYMBOL_IS_KEYWORD (symbol))
1605     reject_constant_symbols (symbol, newval, 0,
1606                              UNBOUNDP (newval) ? Qmakunbound : Qset);
1607
1608   if (!SYMBOL_VALUE_MAGIC_P (valcontents) || UNBOUNDP (valcontents))
1609     {
1610       sym->value = newval;
1611       return newval;
1612     }
1613
1614   reject_constant_symbols (symbol, newval, 0,
1615                            UNBOUNDP (newval) ? Qmakunbound : Qset);
1616
1617  retry_2:
1618
1619   switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1620     {
1621     case SYMVAL_LISP_MAGIC:
1622       {
1623         Lisp_Object retval;
1624
1625         if (UNBOUNDP (newval))
1626           retval = maybe_call_magic_handler (symbol, Qmakunbound, 0);
1627         else
1628           retval = maybe_call_magic_handler (symbol, Qset, 1, newval);
1629         if (!UNBOUNDP (retval))
1630           return newval;
1631         valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1632         /* semi-change-o */
1633         goto retry_2;
1634       }
1635
1636     case SYMVAL_VARALIAS:
1637       symbol = follow_varalias_pointers (symbol,
1638                                          UNBOUNDP (newval)
1639                                          ? Qmakunbound : Qset);
1640       /* presto change-o! */
1641       goto retry;
1642
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));
1651       break;
1652
1653       /* case SYMVAL_UNBOUND_MARKER: break; */
1654
1655     case SYMVAL_CURRENT_BUFFER_FORWARD:
1656       {
1657         CONST struct symbol_value_forward *fwd
1658           = XSYMBOL_VALUE_FORWARD (valcontents);
1659         int mask = XINT (*((Lisp_Object *)
1660                            symbol_value_forward_forward (fwd)));
1661         if (mask > 0)
1662           /* Setting this variable makes it buffer-local */
1663           current_buffer->local_var_flags |= mask;
1664         break;
1665       }
1666
1667     case SYMVAL_SELECTED_CONSOLE_FORWARD:
1668       {
1669         CONST struct symbol_value_forward *fwd
1670           = XSYMBOL_VALUE_FORWARD (valcontents);
1671         int mask = XINT (*((Lisp_Object *)
1672                            symbol_value_forward_forward (fwd)));
1673         if (mask > 0)
1674           /* Setting this variable makes it console-local */
1675           XCONSOLE (Vselected_console)->local_var_flags |= mask;
1676         break;
1677       }
1678
1679     case SYMVAL_BUFFER_LOCAL:
1680     case SYMVAL_SOME_BUFFER_LOCAL:
1681       {
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.
1690
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
1693            created.
1694
1695            Note that CURRENT-VALUE can be a forwarding pointer.
1696            Each time it is examined or set, forwarding must be
1697            done. */
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;
1704
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 */
1710                 ))
1711           {
1712             /* Cache is valid */
1713             valcontents = bfwd->current_value;
1714           }
1715         else
1716           {
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
1721             */
1722
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);
1727
1728             /* Find the new value for CURRENT-ALIST-ELEMENT.  */
1729             aelt = buffer_local_alist_element (current_buffer, symbol, bfwd);
1730             if (NILP (aelt))
1731               {
1732                 /* This buffer is still seeing the default value.  */
1733                 if (!some_buffer_local_p)
1734                   {
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.  */
1738                     aelt =
1739                       do_symval_forwarding (bfwd->current_value,
1740                                             current_buffer,
1741                                             XCONSOLE (Vselected_console));
1742                     aelt = Fcons (symbol, aelt);
1743                     current_buffer->local_var_alist
1744                       = Fcons (aelt, current_buffer->local_var_alist);
1745                   }
1746                 else
1747                   {
1748                     /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
1749                        we're currently seeing the default value. */
1750                     ;
1751                   }
1752               }
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;
1758           }
1759         break;
1760       }
1761     default:
1762       abort ();
1763     }
1764   store_symval_forwarding (symbol, valcontents, newval);
1765
1766   return newval;
1767 }
1768
1769 \f
1770 /* Access or set a buffer-local symbol's default value.  */
1771
1772 /* Return the default value of SYM, but don't check for voidness.
1773    Return Qunbound if it is void.  */
1774
1775 static Lisp_Object
1776 default_value (Lisp_Object sym)
1777 {
1778   Lisp_Object valcontents;
1779
1780   CHECK_SYMBOL (sym);
1781
1782  retry:
1783   valcontents = XSYMBOL (sym)->value;
1784
1785  retry_2:
1786   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1787     return valcontents;
1788
1789   switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1790     {
1791     case SYMVAL_LISP_MAGIC:
1792       /* #### kludge */
1793       valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1794       /* semi-change-o */
1795       goto retry_2;
1796
1797     case SYMVAL_VARALIAS:
1798       sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1799       /* presto change-o! */
1800       goto retry;
1801
1802     case SYMVAL_UNBOUND_MARKER:
1803       return valcontents;
1804
1805     case SYMVAL_CURRENT_BUFFER_FORWARD:
1806       {
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))));
1812       }
1813
1814     case SYMVAL_SELECTED_CONSOLE_FORWARD:
1815       {
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))));
1821       }
1822
1823     case SYMVAL_BUFFER_LOCAL:
1824     case SYMVAL_SOME_BUFFER_LOCAL:
1825       {
1826         struct symbol_value_buffer_local *bfwd =
1827           XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1828
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));
1837         else
1838           return bfwd->default_value;
1839       }
1840     default:
1841       /* For other variables, get the current value.    */
1842       return do_symval_forwarding (valcontents, current_buffer,
1843                                    XCONSOLE (Vselected_console));
1844     }
1845
1846   RETURN_NOT_REACHED (Qnil)     /* suppress compiler warning */
1847 }
1848
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
1852 for this variable.
1853 */
1854        (symbol))
1855 {
1856   return UNBOUNDP (default_value (symbol)) ? Qnil : Qt;
1857 }
1858
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.
1864 */
1865        (symbol))
1866 {
1867   Lisp_Object value = default_value (symbol);
1868
1869   return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (symbol)) : value;
1870 }
1871
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
1875 for this variable.
1876 */
1877        (symbol, value))
1878 {
1879   Lisp_Object valcontents;
1880
1881   CHECK_SYMBOL (symbol);
1882
1883  retry:
1884   valcontents = XSYMBOL (symbol)->value;
1885
1886  retry_2:
1887   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1888     return Fset (symbol, value);
1889
1890   switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1891     {
1892     case SYMVAL_LISP_MAGIC:
1893       RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (symbol, Qset_default, 1,
1894                                                        value));
1895       valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1896       /* semi-change-o */
1897       goto retry_2;
1898
1899     case SYMVAL_VARALIAS:
1900       symbol = follow_varalias_pointers (symbol, Qset_default);
1901       /* presto change-o! */
1902       goto retry;
1903
1904     case SYMVAL_CURRENT_BUFFER_FORWARD:
1905       set_default_buffer_slot_variable (symbol, value);
1906       return value;
1907
1908     case SYMVAL_SELECTED_CONSOLE_FORWARD:
1909       set_default_console_slot_variable (symbol, value);
1910       return value;
1911
1912     case SYMVAL_BUFFER_LOCAL:
1913     case SYMVAL_SOME_BUFFER_LOCAL:
1914       {
1915         /* Store new value into the DEFAULT-VALUE slot */
1916         struct symbol_value_buffer_local *bfwd
1917           = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1918
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);
1924         return value;
1925       }
1926
1927     default:
1928       return Fset (symbol, value);
1929     }
1930 }
1931
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.
1938
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.
1944 */
1945        (args))
1946 {
1947   /* This function can GC */
1948   Lisp_Object symbol, tail, val = Qnil;
1949   int nargs;
1950   struct gcpro gcpro1;
1951
1952   GET_LIST_LENGTH (args, nargs);
1953
1954   if (nargs & 1)                /* Odd number of arguments? */
1955     Fsignal (Qwrong_number_of_arguments,
1956              list2 (Qsetq_default, make_int (nargs)));
1957
1958   GCPRO1 (val);
1959
1960   PROPERTY_LIST_LOOP (tail, symbol, val, args)
1961     {
1962       val = Feval (val);
1963       Fset_default (symbol, val);
1964     }
1965
1966   UNGCPRO;
1967   return val;
1968 }
1969 \f
1970 /* Lisp functions for creating and removing buffer-local variables.  */
1971
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
1977 set its own value.
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'
1981 sets it.
1982 */
1983        (variable))
1984 {
1985   Lisp_Object valcontents;
1986
1987   CHECK_SYMBOL (variable);
1988
1989  retry:
1990   verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
1991
1992   valcontents = XSYMBOL (variable)->value;
1993
1994  retry_2:
1995   if (SYMBOL_VALUE_MAGIC_P (valcontents))
1996     {
1997       switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1998         {
1999         case SYMVAL_LISP_MAGIC:
2000           if (!UNBOUNDP (maybe_call_magic_handler
2001                          (variable, Qmake_variable_buffer_local, 0)))
2002             return variable;
2003           valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2004           /* semi-change-o */
2005           goto retry_2;
2006
2007         case SYMVAL_VARALIAS:
2008           variable = follow_varalias_pointers (variable,
2009                                                Qmake_variable_buffer_local);
2010           /* presto change-o! */
2011           goto retry;
2012
2013         case SYMVAL_FIXNUM_FORWARD:
2014         case SYMVAL_BOOLEAN_FORWARD:
2015         case SYMVAL_OBJECT_FORWARD:
2016         case SYMVAL_UNBOUND_MARKER:
2017           break;
2018
2019         case SYMVAL_CURRENT_BUFFER_FORWARD:
2020         case SYMVAL_BUFFER_LOCAL:
2021           /* Already per-each-buffer */
2022           return variable;
2023
2024         case SYMVAL_SOME_BUFFER_LOCAL:
2025           /* Transmogrify */
2026           XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
2027             SYMVAL_BUFFER_LOCAL;
2028           return variable;
2029
2030         default:
2031           abort ();
2032         }
2033     }
2034
2035   {
2036     struct symbol_value_buffer_local *bfwd
2037       = alloc_lcrecord_type (struct symbol_value_buffer_local,
2038                              lrecord_symbol_value_buffer_local);
2039     Lisp_Object foo;
2040     bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2041
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;
2054 #endif
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);
2063 #endif
2064     return variable;
2065   }
2066 }
2067
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'.
2075
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.
2079
2080 Do not use `make-local-variable' to make a hook variable buffer-local.
2081 Use `make-local-hook' instead.
2082 */
2083        (variable))
2084 {
2085   Lisp_Object valcontents;
2086   struct symbol_value_buffer_local *bfwd;
2087
2088   CHECK_SYMBOL (variable);
2089
2090  retry:
2091   verify_ok_for_buffer_local (variable, Qmake_local_variable);
2092
2093   valcontents = XSYMBOL (variable)->value;
2094
2095  retry_2:
2096   if (SYMBOL_VALUE_MAGIC_P (valcontents))
2097     {
2098       switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2099         {
2100         case SYMVAL_LISP_MAGIC:
2101           if (!UNBOUNDP (maybe_call_magic_handler
2102                          (variable, Qmake_local_variable, 0)))
2103             return variable;
2104           valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2105           /* semi-change-o */
2106           goto retry_2;
2107
2108         case SYMVAL_VARALIAS:
2109           variable = follow_varalias_pointers (variable, Qmake_local_variable);
2110           /* presto change-o! */
2111           goto retry;
2112
2113         case SYMVAL_FIXNUM_FORWARD:
2114         case SYMVAL_BOOLEAN_FORWARD:
2115         case SYMVAL_OBJECT_FORWARD:
2116         case SYMVAL_UNBOUND_MARKER:
2117           break;
2118
2119         case SYMVAL_BUFFER_LOCAL:
2120         case SYMVAL_CURRENT_BUFFER_FORWARD:
2121           {
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));
2125             return variable;
2126           }
2127
2128         case SYMVAL_SOME_BUFFER_LOCAL:
2129           {
2130             if (!NILP (buffer_local_alist_element (current_buffer,
2131                                                    variable,
2132                                                    (XSYMBOL_VALUE_BUFFER_LOCAL
2133                                                     (valcontents)))))
2134               goto already_local_to_current_buffer;
2135             else
2136               goto already_local_to_some_other_buffer;
2137           }
2138
2139         default:
2140           abort ();
2141         }
2142     }
2143
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;
2148
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
2154      variable. */
2155   bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
2156
2157 #if 0
2158   if (UNBOUNDP (bfwd->default_value))
2159     bfwd->default_value = Qnil; /* Yuck! */
2160 #endif
2161
2162   XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
2163   *value_slot_past_magic (variable) = valcontents;
2164
2165  already_local_to_some_other_buffer:
2166
2167   /* Make sure this buffer has its own value of variable */
2168   bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2169
2170   if (UNBOUNDP (bfwd->default_value))
2171     {
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);
2178       return variable;
2179     }
2180
2181   current_buffer->local_var_alist
2182     = Fcons (Fcons (variable, bfwd->default_value),
2183              current_buffer->local_var_alist);
2184
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;
2190
2191  already_local_to_current_buffer:
2192
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))
2199     {
2200       switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
2201         {
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);
2207           break;
2208
2209         case SYMVAL_UNBOUND_MARKER:
2210         case SYMVAL_CURRENT_BUFFER_FORWARD:
2211           break;
2212
2213         default:
2214           abort ();
2215         }
2216     }
2217
2218   return variable;
2219 }
2220
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.
2225 */
2226        (variable))
2227 {
2228   Lisp_Object valcontents;
2229
2230   CHECK_SYMBOL (variable);
2231
2232  retry:
2233   valcontents = XSYMBOL (variable)->value;
2234
2235  retry_2:
2236   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2237     return variable;
2238
2239   switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2240     {
2241     case SYMVAL_LISP_MAGIC:
2242       if (!UNBOUNDP (maybe_call_magic_handler
2243                      (variable, Qkill_local_variable, 0)))
2244         return variable;
2245       valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2246       /* semi-change-o */
2247       goto retry_2;
2248
2249     case SYMVAL_VARALIAS:
2250       variable = follow_varalias_pointers (variable, Qkill_local_variable);
2251       /* presto change-o! */
2252       goto retry;
2253
2254     case SYMVAL_CURRENT_BUFFER_FORWARD:
2255       {
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);
2260         int mask =
2261           XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2262
2263         if (mask > 0)
2264           {
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));
2270             if (magicfun)
2271               (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
2272             *(Lisp_Object *) (offset + (char *) current_buffer)
2273               = oldval;
2274             current_buffer->local_var_flags &= ~mask;
2275           }
2276         return variable;
2277       }
2278
2279     case SYMVAL_BUFFER_LOCAL:
2280     case SYMVAL_SOME_BUFFER_LOCAL:
2281       {
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);
2288
2289         if (!NILP (alist_element))
2290           current_buffer->local_var_alist = Fdelq (alist_element, alist);
2291
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;
2297
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);
2304       }
2305       return variable;
2306
2307     default:
2308       return variable;
2309     }
2310   RETURN_NOT_REACHED(Qnil)      /* suppress compiler warning */
2311 }
2312
2313
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.
2318 */
2319        (variable))
2320 {
2321   Lisp_Object valcontents;
2322
2323   CHECK_SYMBOL (variable);
2324
2325  retry:
2326   valcontents = XSYMBOL (variable)->value;
2327
2328  retry_2:
2329   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2330     return variable;
2331
2332   switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2333     {
2334     case SYMVAL_LISP_MAGIC:
2335       if (!UNBOUNDP (maybe_call_magic_handler
2336                      (variable, Qkill_console_local_variable, 0)))
2337         return variable;
2338       valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2339       /* semi-change-o */
2340       goto retry_2;
2341
2342     case SYMVAL_VARALIAS:
2343       variable = follow_varalias_pointers (variable,
2344                                            Qkill_console_local_variable);
2345       /* presto change-o! */
2346       goto retry;
2347
2348     case SYMVAL_SELECTED_CONSOLE_FORWARD:
2349       {
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);
2354         int mask =
2355           XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2356
2357         if (mask > 0)
2358           {
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));
2364             if (magicfun)
2365               magicfun (variable, &oldval, Vselected_console, 0);
2366             *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
2367               = oldval;
2368             XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
2369           }
2370         return variable;
2371       }
2372
2373     default:
2374       return variable;
2375     }
2376 }
2377
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
2382  */
2383 int
2384 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
2385 {
2386   Lisp_Object valcontents;
2387
2388  retry:
2389   valcontents = XSYMBOL (symbol)->value;
2390
2391  retry_2:
2392   if (SYMBOL_VALUE_MAGIC_P (valcontents))
2393     {
2394       switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2395         {
2396         case SYMVAL_LISP_MAGIC:
2397           /* #### kludge */
2398           valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2399           /* semi-change-o */
2400           goto retry_2;
2401
2402         case SYMVAL_VARALIAS:
2403           symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
2404           /* presto change-o! */
2405           goto retry;
2406
2407         case SYMVAL_CURRENT_BUFFER_FORWARD:
2408           {
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 */
2415               return 1;
2416             else
2417               /* Would be buffer-local after set */
2418               return -1;
2419           }
2420         case SYMVAL_BUFFER_LOCAL:
2421         case SYMVAL_SOME_BUFFER_LOCAL:
2422           {
2423             struct symbol_value_buffer_local *bfwd
2424               = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2425             if (buffer
2426                 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
2427               return 1;
2428             else
2429               /* Automatically becomes local when set */
2430               return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
2431           }
2432         default:
2433           return 0;
2434         }
2435     }
2436   return 0;
2437 }
2438
2439
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.
2442 */
2443        (symbol, buffer, unbound_value))
2444 {
2445   Lisp_Object value;
2446   CHECK_SYMBOL (symbol);
2447   CHECK_BUFFER (buffer);
2448   value = symbol_value_in_buffer (symbol, buffer);
2449   return UNBOUNDP (value) ? unbound_value : value;
2450 }
2451
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.
2454 */
2455        (symbol, console, unbound_value))
2456 {
2457   Lisp_Object value;
2458   CHECK_SYMBOL (symbol);
2459   CHECK_CONSOLE (console);
2460   value = symbol_value_in_console (symbol, console);
2461   return UNBOUNDP (value) ? unbound_value : value;
2462 }
2463
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
2467
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.
2483 */
2484        (symbol))
2485 {
2486   REGISTER Lisp_Object valcontents;
2487
2488   CHECK_SYMBOL (symbol);
2489
2490  retry:
2491   valcontents = XSYMBOL (symbol)->value;
2492
2493  retry_2:
2494   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2495     return Qnil;
2496
2497   switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2498     {
2499     case SYMVAL_LISP_MAGIC:
2500       valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2501       /* semi-change-o */
2502       goto retry_2;
2503
2504     case SYMVAL_VARALIAS:
2505       symbol = follow_varalias_pointers (symbol, Qt);
2506       /* presto change-o! */
2507       goto retry;
2508
2509     case SYMVAL_BUFFER_LOCAL:
2510     case SYMVAL_SOME_BUFFER_LOCAL:
2511       valcontents =
2512         XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value;
2513       /* semi-change-o */
2514       goto retry_2;
2515
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;
2530
2531     default:
2532       abort (); return Qnil;
2533     }
2534 }
2535
2536
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:
2543
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.)
2548
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.
2551 */
2552        (symbol, buffer, after_set))
2553 {
2554   int local_info;
2555
2556   CHECK_SYMBOL (symbol);
2557   if (!NILP (buffer))
2558     {
2559       buffer = get_buffer (buffer, 1);
2560       local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
2561     }
2562   else
2563     {
2564       local_info = symbol_value_buffer_local_info (symbol, 0);
2565     }
2566
2567   if (NILP (after_set))
2568     return local_info > 0 ? Qt : Qnil;
2569   else
2570     return local_info != 0 ? Qt : Qnil;
2571 }
2572 \f
2573
2574 /*
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.
2581
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.
2589
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:
2598
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
2602    that value
2603
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'
2610 handler.
2611
2612 Actions in unimplemented handler types will correctly
2613 ignore any handlers, and will not fuck anything up or
2614 go awry.
2615
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
2622
2623 Real documentation is as follows.
2624
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.)
2632
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.
2642
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
2654 function".
2655
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.)
2661
2662 The behaviors that can be specified in HANDLER-TYPE are
2663
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.
2668
2669 set-value               (SYM ARGS FUN HARG HANDLERS)
2670     This means that one of the functions `set' or `set-default'
2671     was called on SYM.
2672
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.
2676
2677 make-unbound            (SYM ARGS FUN HARG HANDLERS)
2678     This means that the function `makunbound' was called on SYM.
2679
2680 local-predicate         (SYM ARGS FUN HARG HANDLERS)
2681     This means that the function `local-variable-p' was called
2682     on SYM.
2683
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.
2688
2689 The meanings of the arguments are as follows:
2690
2691    SYM is the symbol on which the function was called, and is always
2692    the first argument to the function.
2693
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.
2701
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'.
2706
2707    HARG is the argument that was given in the call
2708    to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
2709
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'.
2713
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.)
2717 */
2718
2719 static enum lisp_magic_handler
2720 decode_magic_handler_type (Lisp_Object symbol)
2721 {
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;
2728
2729   signal_simple_error ("Unrecognized symbol value handler type", symbol);
2730   abort ();
2731   return MAGIC_HANDLER_MAX;
2732 }
2733
2734 static enum lisp_magic_handler
2735 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
2736 {
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;
2742
2743   if (EQ (funsym, Qset)
2744       || EQ (funsym, Qset_default))
2745     return MAGIC_HANDLER_SET_VALUE;
2746
2747   if (EQ (funsym, Qboundp)
2748       || EQ (funsym, Qglobally_boundp)
2749       || EQ (funsym, Qdefault_boundp))
2750     return MAGIC_HANDLER_BOUND_PREDICATE;
2751
2752   if (EQ (funsym, Qmakunbound))
2753     return MAGIC_HANDLER_MAKE_UNBOUND;
2754
2755   if (EQ (funsym, Qlocal_variable_p))
2756     return MAGIC_HANDLER_LOCAL_PREDICATE;
2757
2758   if (EQ (funsym, Qmake_variable_buffer_local)
2759       || EQ (funsym, Qmake_local_variable))
2760     return MAGIC_HANDLER_MAKE_LOCAL;
2761
2762   if (abort_if_not_found)
2763     abort ();
2764   signal_simple_error ("Unrecognized symbol-value function", funsym);
2765   return MAGIC_HANDLER_MAX;
2766 }
2767
2768 static int
2769 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
2770 {
2771   /* does not take into account variable aliasing. */
2772   Lisp_Object valcontents = XSYMBOL (sym)->value;
2773   enum lisp_magic_handler slot;
2774
2775   if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2776     return 0;
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 */
2782     return 0;
2783   return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
2784 }
2785
2786 static Lisp_Object
2787 fetch_value_maybe_past_magic (Lisp_Object sym,
2788                               Lisp_Object follow_past_lisp_magic)
2789 {
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;
2796   return value;
2797 }
2798
2799 static Lisp_Object *
2800 value_slot_past_magic (Lisp_Object sym)
2801 {
2802   Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
2803
2804   if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
2805     store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
2806   return store_pointer;
2807 }
2808
2809 static Lisp_Object
2810 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
2811 {
2812   va_list vargs;
2813   Lisp_Object args[20]; /* should be enough ... */
2814   int i;
2815   enum lisp_magic_handler htype;
2816   Lisp_Object legerdemain;
2817   struct symbol_value_lisp_magic *bfwd;
2818
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);
2823
2824   va_start (vargs, nargs);
2825   for (i = 0; i < nargs; i++)
2826     args[i] = va_arg (vargs, Lisp_Object);
2827   va_end (vargs);
2828
2829   htype = handler_type_from_function_symbol (funsym, 1);
2830   if (NILP (bfwd->handler[htype]))
2831     return Qunbound;
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);
2838 }
2839
2840 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
2841        3, 5, 0, /*
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.
2846 */
2847        (variable, handler_type, handler, harg, keep_existing))
2848 {
2849   Lisp_Object valcontents;
2850   struct symbol_value_lisp_magic *bfwd;
2851   enum lisp_magic_handler htype;
2852   int i;
2853
2854   /* #### WARNING, only some handler types are implemented.  See above.
2855      Actions of other types will ignore a handler if it's there.
2856
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))
2864     {
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++)
2869         {
2870           bfwd->handler[i] = Qnil;
2871           bfwd->harg[i] = Qnil;
2872         }
2873       bfwd->shadowed = valcontents;
2874       XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
2875     }
2876   else
2877     bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
2878   bfwd->handler[htype] = handler;
2879   bfwd->harg[htype] = harg;
2880
2881   for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2882     if (!NILP (bfwd->handler[i]))
2883       break;
2884
2885   if (i == MAGIC_HANDLER_MAX)
2886     /* there are no remaining handlers, so remove the structure. */
2887     XSYMBOL (variable)->value = bfwd->shadowed;
2888
2889   return Qnil;
2890 }
2891
2892 \f
2893 /* functions for working with variable aliases.  */
2894
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.
2898
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.
2904
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:
2909
2910    (defvaralias 'a 'b)
2911    add some magic behavior to a, but not a "get-value" handler
2912    (defvaralias 'b 'a)
2913
2914    then an attempt to retrieve a's or b's value would cause infinite
2915    looping in `symbol-value'.
2916
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.
2920  */
2921
2922 static Lisp_Object
2923 follow_varalias_pointers (Lisp_Object symbol,
2924                           Lisp_Object follow_past_lisp_magic)
2925 {
2926 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
2927   Lisp_Object tortoise, hare, val;
2928   int count;
2929
2930   /* quick out just in case */
2931   if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value))
2932     return symbol;
2933
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)),
2939          count++)
2940     {
2941       if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue;
2942
2943       if (count & 1)
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));
2949     }
2950
2951   return hare;
2952 }
2953
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.)
2966 */
2967        (variable, alias))
2968 {
2969   struct symbol_value_varalias *bfwd;
2970   Lisp_Object valcontents;
2971
2972   CHECK_SYMBOL (variable);
2973   reject_constant_symbols (variable, Qunbound, 0, Qt);
2974
2975   valcontents = XSYMBOL (variable)->value;
2976
2977   if (NILP (alias))
2978     {
2979       if (SYMBOL_VALUE_VARALIAS_P (valcontents))
2980         {
2981           XSYMBOL (variable)->value =
2982             symbol_value_varalias_shadowed
2983               (XSYMBOL_VALUE_VARALIAS (valcontents));
2984         }
2985       return Qnil;
2986     }
2987
2988   CHECK_SYMBOL (alias);
2989   if (SYMBOL_VALUE_VARALIAS_P (valcontents))
2990     {
2991       /* transmogrify */
2992       XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
2993       return Qnil;
2994     }
2995
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);
3000
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;
3006
3007   XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
3008   XSYMBOL (variable)->value = valcontents;
3009   return Qnil;
3010 }
3011
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'.
3017 */
3018        (variable, follow_past_lisp_magic))
3019 {
3020   Lisp_Object valcontents;
3021
3022   CHECK_SYMBOL (variable);
3023   if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3024     {
3025       CHECK_SYMBOL (follow_past_lisp_magic);
3026       handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3027     }
3028
3029   valcontents = fetch_value_maybe_past_magic (variable,
3030                                               follow_past_lisp_magic);
3031
3032   if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3033     return symbol_value_varalias_aliasee
3034       (XSYMBOL_VALUE_VARALIAS (valcontents));
3035   else
3036     return Qnil;
3037 }
3038
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.
3047 */
3048        (object, follow_past_lisp_magic))
3049 {
3050   if (!SYMBOLP (object))
3051     return object;
3052   if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3053     {
3054       CHECK_SYMBOL (follow_past_lisp_magic);
3055       handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3056     }
3057   return follow_varalias_pointers (object, follow_past_lisp_magic);
3058 }
3059
3060 \f
3061 /************************************************************************/
3062 /*                            initialization                            */
3063 /************************************************************************/
3064
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
3069
3070 #ifndef Qzero
3071 Lisp_Object Qzero;
3072 #endif
3073 #ifndef Qnull_pointer
3074 Lisp_Object Qnull_pointer;
3075 #endif
3076
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 };
3081
3082 Lisp_Object Vpure_uninterned_symbol_table;
3083
3084 void
3085 init_symbols_once_early (void)
3086 {
3087 #ifndef Qzero
3088   Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3089 #endif
3090
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);
3095 #endif
3096
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);
3101
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;
3108
3109   Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3110   initial_obarray = Vobarray;
3111   staticpro (&initial_obarray);
3112   /* Intern nil in the obarray */
3113   {
3114     int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
3115     XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3116     XSYMBOL (Qnil)->obarray = Qt;
3117   }
3118
3119   {
3120     /* Required to get around a GCC syntax error on certain
3121        architectures */
3122     struct symbol_value_magic *tem = &guts_of_unbound_marker;
3123
3124     XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3125   }
3126   if ((CONST void *) XPNTR (Qunbound) !=
3127       (CONST void *)&guts_of_unbound_marker)
3128     {
3129       /* This might happen on DATA_SEG_BITS machines. */
3130       /* abort (); */
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);
3136     }
3137
3138   XSYMBOL (Qnil)->function = Qunbound;
3139
3140   defsymbol (&Qt, "t");
3141   XSYMBOL (Qt)->value = Qt;     /* Veritas aetera */
3142   Vquit_flag = Qnil;
3143 }
3144
3145 void
3146 defsymbol (Lisp_Object *location, CONST char *name)
3147 {
3148   *location = Fintern (make_pure_pname ((CONST Bufbyte *) name,
3149                                         strlen (name), 1),
3150                        Qnil);
3151   staticpro (location);
3152 }
3153
3154 void
3155 defkeyword (Lisp_Object *location, CONST char *name)
3156 {
3157   defsymbol (location, name);
3158   Fset (*location, *location);
3159 }
3160
3161 #ifdef DEBUG_XEMACS
3162 /* Check that nobody spazzed writing a DEFUN. */
3163 static void
3164 check_sane_subr (Lisp_Subr *subr, Lisp_Object sym)
3165 {
3166   assert (subr->min_args >= 0);
3167   assert (subr->min_args <= SUBR_MAX_ARGS);
3168
3169   if (subr->max_args != MANY &&
3170       subr->max_args != UNEVALLED)
3171     {
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);
3175     }
3176
3177   assert (UNBOUNDP (XSYMBOL (sym)->function));
3178 }
3179 #else
3180 #define check_sane_subr(subr, sym) /* nothing */
3181 #endif
3182
3183 #ifdef HAVE_SHLIB
3184 /*
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.
3192  *
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.
3197  *
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
3203  * it if required.
3204  *
3205  * FIXME: Should newsubr be staticpro()'ed? I dont think so but I need
3206  * a guru to check.
3207  */
3208 #define check_module_subr()                                             \
3209 do {                                                                    \
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;                                  \
3215     subr = newsubr;                                                     \
3216   }                                                                     \
3217 } while (0)
3218 #else /* ! HAVE_SHLIB */
3219 #define check_module_subr()
3220 #endif
3221
3222 void
3223 defsubr (Lisp_Subr *subr)
3224 {
3225   Lisp_Object sym = intern (subr_name (subr));
3226   Lisp_Object fun;
3227
3228   check_sane_subr (subr, sym);
3229   check_module_subr ();
3230
3231   XSETSUBR (fun, subr);
3232   XSYMBOL (sym)->function = fun;
3233 }
3234
3235 /* Define a lisp macro using a Lisp_Subr. */
3236 void
3237 defsubr_macro (Lisp_Subr *subr)
3238 {
3239   Lisp_Object sym = intern (subr_name (subr));
3240   Lisp_Object fun;
3241
3242   check_sane_subr (subr, sym);
3243   check_module_subr();
3244
3245   XSETSUBR (fun, subr);
3246   XSYMBOL (sym)->function = Fcons (Qmacro, fun);
3247 }
3248
3249 void
3250 deferror (Lisp_Object *symbol, CONST char *name, CONST char *messuhhj,
3251           Lisp_Object inherits_from)
3252 {
3253   Lisp_Object conds;
3254   defsymbol (symbol, name);
3255
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));
3263 }
3264
3265 void
3266 syms_of_symbols (void)
3267 {
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");
3272
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");
3279
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");
3297
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");
3308
3309   DEFSUBR (Fintern);
3310   DEFSUBR (Fintern_soft);
3311   DEFSUBR (Funintern);
3312   DEFSUBR (Fmapatoms);
3313   DEFSUBR (Fapropos_internal);
3314
3315   DEFSUBR (Fsymbol_function);
3316   DEFSUBR (Fsymbol_plist);
3317   DEFSUBR (Fsymbol_name);
3318   DEFSUBR (Fmakunbound);
3319   DEFSUBR (Ffmakunbound);
3320   DEFSUBR (Fboundp);
3321   DEFSUBR (Fglobally_boundp);
3322   DEFSUBR (Ffboundp);
3323   DEFSUBR (Ffset);
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);
3331   DEFSUBR (Fset);
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);
3345 }
3346
3347 /* Create and initialize a Lisp variable whose value is forwarded to C data */
3348 void
3349 defvar_magic (CONST char *symbol_name, CONST struct symbol_value_forward *magic)
3350 {
3351   Lisp_Object sym, kludge;
3352
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))
3356     {
3357       /* This might happen on DATA_SEG_BITS machines. */
3358       /* abort (); */
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);
3362       magic = p;
3363     }
3364
3365 #if defined(HAVE_SHLIB)
3366   /*
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.
3370    */
3371   if (initialized)
3372     sym = Fintern (build_string (symbol_name), Qnil);
3373   else
3374 #endif
3375     sym = Fintern (make_pure_pname ((CONST Bufbyte *) symbol_name,
3376                                     strlen (symbol_name), 1), Qnil);
3377
3378   XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic);
3379 }
3380
3381 void
3382 vars_of_symbols (void)
3383 {
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'.
3389 */ );
3390   /* obarray has been initialized long before */
3391 }