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
  60 #include "elhash.h"             /* for HASHTABLE_NONWEAK and HASHTABLE_EQ */
  61
  62 Lisp_Object Qad_advice_info, Qad_activate;
  63
  64 Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound;
  65 Lisp_Object Qlocal_predicate, Qmake_local;
  66
  67 Lisp_Object Qboundp, Qfboundp, Qglobally_boundp, Qmakunbound;
  68 Lisp_Object Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value;
  69 Lisp_Object Qset_default, Qmake_variable_buffer_local, Qmake_local_variable;
  70 Lisp_Object Qkill_local_variable, Qkill_console_local_variable;
  71 Lisp_Object Qsymbol_value_in_buffer, Qsymbol_value_in_console;
  72 Lisp_Object Qlocal_variable_p;
  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
  84                                                  follow_past_lisp_magic);
  85 static Lisp_Object *value_slot_past_magic (Lisp_Object sym);
  86 static Lisp_Object follow_varalias_pointers (Lisp_Object object,
  87                                              Lisp_Object
  88                                              follow_past_lisp_magic);
  89
  90 \f
  91 #ifdef LRECORD_SYMBOL
  92
  93 static Lisp_Object
  94 mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object))
  95 {
  96   struct Lisp_Symbol *sym = XSYMBOL (obj);
  97   Lisp_Object pname;
  98
  99   ((markobj) (sym->value));
 100   ((markobj) (sym->function));
 101   /* No need to mark through ->obarray, because it only holds nil or t.  */
 102   /*((markobj) (sym->obarray));*/
 103   XSETSTRING (pname, sym->name);
 104   ((markobj) (pname));
 105   if (!symbol_next (sym))
 106     return sym->plist;
 107   else
 108   {
 109     ((markobj) (sym->plist));
 110     /* Mark the rest of the symbols in the obarray hash-chain */
 111     sym = symbol_next (sym);
 112     XSETSYMBOL (obj, sym);
 113     return obj;
 114   }
 115 }
 116
 117 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
 118                                      mark_symbol, print_symbol, 0, 0, 0,
 119                                      struct Lisp_Symbol);
 120 #endif /* LRECORD_SYMBOL */
 121
 122 \f
 123 /**********************************************************************/
 124 /*                              Intern                                */
 125 /**********************************************************************/
 126
 127 /* #### using a vector here is way bogus.  Use a hash table instead. */
 128
 129 Lisp_Object Vobarray;
 130
 131 static Lisp_Object initial_obarray;
 132
 133 /* oblookup stores the bucket number here, for the sake of Funintern.  */
 134
 135 static int oblookup_last_bucket_number;
 136
 137 static Lisp_Object
 138 check_obarray (Lisp_Object obarray)
 139 {
 140   while (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
 141     {
 142       /* If Vobarray is now invalid, force it to be valid.  */
 143       if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
 144
 145       obarray = wrong_type_argument (Qvectorp, obarray);
 146     }
 147   return obarray;
 148 }
 149
 150 Lisp_Object
 151 intern (CONST char *str)
 152 {
 153   Lisp_Object tem;
 154   Bytecount len = strlen (str);
 155   Lisp_Object obarray = Vobarray;
 156   if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
 157     obarray = check_obarray (obarray);
 158   tem = oblookup (obarray, (CONST Bufbyte *) str, len);
 159
 160   if (SYMBOLP (tem))
 161     return tem;
 162   return Fintern (((purify_flag)
 163                    ? make_pure_pname ((CONST Bufbyte *) str, len, 0)
 164                    : make_string ((CONST Bufbyte *) str, len)),
 165                   obarray);
 166 }
 167
 168 DEFUN ("intern", Fintern, 1, 2, 0, /*
 169 Return the canonical symbol whose name is STRING.
 170 If there is none, one is created by this function and returned.
 171 A second optional argument specifies the obarray to use;
 172 it defaults to the value of `obarray'.
 173 */
 174        (str, obarray))
 175 {
 176   Lisp_Object sym, *ptr;
 177   Bytecount len;
 178
 179   if (NILP (obarray)) obarray = Vobarray;
 180   obarray = check_obarray (obarray);
 181
 182   CHECK_STRING (str);
 183
 184   len = XSTRING_LENGTH (str);
 185   sym = oblookup (obarray, XSTRING_DATA (str), len);
 186   if (!INTP (sym))
 187     /* Found it */
 188     return sym;
 189
 190   ptr = &XVECTOR_DATA (obarray)[XINT (sym)];
 191
 192   if (purify_flag && ! purified (str))
 193     str = make_pure_pname (XSTRING_DATA (str), len, 0);
 194   sym = Fmake_symbol (str);
 195   /* FSFmacs places OBARRAY here, but it is pointless because we do
 196      not mark through this slot, so it is not usable later (because
 197      the obarray might have been collected).  Marking through the
 198      ->obarray slot is an even worse idea, because it would keep
 199      obarrays from being collected because of symbols pointed to them.
 200
 201      NOTE: We place Qt here only if OBARRAY is actually Vobarray.  It
 202      is safer to do it this way, to avoid hosing with symbols within
 203      pure objects.  */
 204   if (EQ (obarray, Vobarray))
 205     XSYMBOL (sym)->obarray = Qt;
 206
 207   if (SYMBOLP (*ptr))
 208     symbol_next (XSYMBOL (sym)) = XSYMBOL (*ptr);
 209   else
 210     symbol_next (XSYMBOL (sym)) = 0;
 211   *ptr = sym;
 212   return sym;
 213 }
 214
 215 DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /*
 216 Return the canonical symbol whose name is STRING, or nil if none exists.
 217 A second optional argument specifies the obarray to use;
 218 it defaults to the value of `obarray'.
 219 */
 220        (str, obarray))
 221 {
 222   Lisp_Object tem;
 223
 224   if (NILP (obarray)) obarray = Vobarray;
 225   obarray = check_obarray (obarray);
 226
 227   CHECK_STRING (str);
 228
 229   tem = oblookup (obarray, XSTRING_DATA (str), XSTRING_LENGTH (str));
 230   if (!INTP (tem))
 231     return tem;
 232   return 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 nil.
 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   /* Combining next two lines breaks VMS C 2.3.  */
 319   hash = hash_string (ptr, size);
 320   hash %= obsize;
 321   bucket = XVECTOR_DATA (obarray)[hash];
 322   oblookup_last_bucket_number = hash;
 323   if (ZEROP (bucket))
 324     ;
 325   else if (!SYMBOLP (bucket))
 326     error ("Bad data in guts of obarray"); /* Like CADR error message */
 327   else
 328     for (tail = XSYMBOL (bucket); ;)
 329       {
 330         if (string_length (tail->name) == size &&
 331             !memcmp (string_data (tail->name), ptr, size))
 332           {
 333             XSETSYMBOL (bucket, tail);
 334             return bucket;
 335           }
 336         tail = symbol_next (tail);
 337         if (!tail)
 338           break;
 339       }
 340   return make_int (hash);
 341 }
 342
 343 #if 0 /* Emacs 19.34 */
 344 int
 345 hash_string (CONST Bufbyte *ptr, Bytecount len)
 346 {
 347   CONST Bufbyte *p = ptr;
 348   CONST Bufbyte *end = p + len;
 349   Bufbyte c;
 350   int hash = 0;
 351
 352   while (p != end)
 353     {
 354       c = *p++;
 355       if (c >= 0140) c -= 40;
 356       hash = ((hash<<3) + (hash>>28) + c);
 357     }
 358   return hash & 07777777777;
 359 }
 360 #endif
 361
 362 /* derived from hashpjw, Dragon Book P436. */
 363 int
 364 hash_string (CONST Bufbyte *ptr, Bytecount len)
 365 {
 366   int hash = 0;
 367
 368   while (len-- > 0)
 369     {
 370       int g;
 371       hash = (hash << 4) + *ptr++;
 372       g = hash & 0xf0000000;
 373       if (g)
 374         hash = (hash ^ (g >> 24)) ^ g;
 375     }
 376   return hash & 07777777777;
 377 }
 378
 379 /* Map FN over OBARRAY.  The mapping is stopped when FN returns a
 380    non-zero value.  */
 381 void
 382 map_obarray (Lisp_Object obarray,
 383              int (*fn) (Lisp_Object, void *), void *arg)
 384 {
 385   REGISTER int i;
 386
 387   CHECK_VECTOR (obarray);
 388   for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--)
 389     {
 390       Lisp_Object tail = XVECTOR_DATA (obarray)[i];
 391       if (SYMBOLP (tail))
 392         while (1)
 393           {
 394             struct Lisp_Symbol *next;
 395             if ((*fn) (tail, arg))
 396               return;
 397             next = symbol_next (XSYMBOL (tail));
 398             if (!next)
 399               break;
 400             XSETSYMBOL (tail, next);
 401           }
 402     }
 403 }
 404
 405 static int
 406 mapatoms_1 (Lisp_Object sym, void *arg)
 407 {
 408   call1 (*(Lisp_Object *)arg, sym);
 409   return 0;
 410 }
 411
 412 DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /*
 413 Call FUNCTION on every symbol in OBARRAY.
 414 OBARRAY defaults to the value of `obarray'.
 415 */
 416        (function, obarray))
 417 {
 418   if (NILP (obarray))
 419     obarray = Vobarray;
 420   obarray = check_obarray (obarray);
 421
 422   map_obarray (obarray, mapatoms_1, &function);
 423   return Qnil;
 424 }
 425
 426 \f
 427 /**********************************************************************/
 428 /*                              Apropos                               */
 429 /**********************************************************************/
 430
 431 struct appropos_mapper_closure
 432 {
 433   Lisp_Object regexp;
 434   Lisp_Object predicate;
 435   Lisp_Object accumulation;
 436 };
 437
 438 static int
 439 apropos_mapper (Lisp_Object symbol, void *arg)
 440 {
 441   struct appropos_mapper_closure *closure =
 442     (struct appropos_mapper_closure *) arg;
 443   Bytecount match = fast_lisp_string_match (closure->regexp,
 444                                             Fsymbol_name (symbol));
 445
 446   if (match >= 0 &&
 447       (NILP (closure->predicate) ||
 448        !NILP (call1 (closure->predicate, symbol))))
 449     closure->accumulation = Fcons (symbol, closure->accumulation);
 450
 451   return 0;
 452 }
 453
 454 DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /*
 455 Show all symbols whose names contain match for REGEXP.
 456 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL)
 457  is done for each symbol and a symbol is mentioned only if that
 458  returns non-nil.
 459 Return list of symbols found.
 460 */
 461        (regexp, predicate))
 462 {
 463   struct appropos_mapper_closure closure;
 464
 465   CHECK_STRING (regexp);
 466
 467   closure.regexp = regexp;
 468   closure.predicate = predicate;
 469   closure.accumulation = Qnil;
 470   map_obarray (Vobarray, apropos_mapper, &closure);
 471   closure.accumulation = Fsort (closure.accumulation, Qstring_lessp);
 472   return closure.accumulation;
 473 }
 474
 475 \f
 476 /* Extract and set components of symbols */
 477
 478 static void set_up_buffer_local_cache (Lisp_Object sym,
 479                                        struct symbol_value_buffer_local *bfwd,
 480                                        struct buffer *buf,
 481                                        Lisp_Object new_alist_el,
 482                                        int set_it_p);
 483
 484 DEFUN ("boundp", Fboundp, 1, 1, 0, /*
 485 Return t if SYMBOL's value is not void.
 486 */
 487        (sym))
 488 {
 489   CHECK_SYMBOL (sym);
 490   return UNBOUNDP (find_symbol_value (sym)) ? Qnil : Qt;
 491 }
 492
 493 DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /*
 494 Return t if SYMBOL has a global (non-bound) value.
 495 This is for the byte-compiler; you really shouldn't be using this.
 496 */
 497        (sym))
 498 {
 499   CHECK_SYMBOL (sym);
 500   return UNBOUNDP (top_level_value (sym)) ? Qnil : Qt;
 501 }
 502
 503 DEFUN ("fboundp", Ffboundp, 1, 1, 0, /*
 504 Return t if SYMBOL's function definition is not void.
 505 */
 506        (sym))
 507 {
 508   CHECK_SYMBOL (sym);
 509   return UNBOUNDP (XSYMBOL (sym)->function) ? Qnil : Qt;
 510 }
 511
 512 /* Return non-zero if SYM's value or function (the current contents of
 513    which should be passed in as VAL) is constant, i.e. unsettable. */
 514
 515 static int
 516 symbol_is_constant (Lisp_Object sym, Lisp_Object val)
 517 {
 518   /* #### - I wonder if it would be better to just have a new magic value
 519      type and make nil, t, and all keywords have that same magic
 520      constant_symbol value.  This test is awfully specific about what is
 521      constant and what isn't.  --Stig */
 522   if (EQ (sym, Qnil) ||
 523       EQ (sym, Qt))
 524     return 1;
 525
 526   if (SYMBOL_VALUE_MAGIC_P (val))
 527     switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
 528       {
 529       case SYMVAL_CONST_OBJECT_FORWARD:
 530       case SYMVAL_CONST_SPECIFIER_FORWARD:
 531       case SYMVAL_CONST_FIXNUM_FORWARD:
 532       case SYMVAL_CONST_BOOLEAN_FORWARD:
 533       case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
 534       case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
 535         return 1;
 536       default: break; /* Warning suppression */
 537       }
 538
 539   /* We don't return true for keywords here because they are handled
 540        specially by reject_constant_symbols().  */
 541   return 0;
 542 }
 543
 544 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
 545    non-zero) to NEWVAL.  Make sure this is allowed.
 546    FOLLOW_PAST_LISP_MAGIC specifies whether we delve past
 547    symbol-value-lisp-magic objects.  */
 548
 549 static void
 550 reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p,
 551                          Lisp_Object follow_past_lisp_magic)
 552 {
 553   Lisp_Object val =
 554     (function_p ? XSYMBOL (sym)->function
 555      : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
 556
 557   if (SYMBOL_VALUE_MAGIC_P (val) &&
 558       XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
 559     signal_simple_error ("Use `set-specifier' to change a specifier's value",
 560                          sym);
 561
 562   if (symbol_is_constant (sym, val)
 563       || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)
 564           && !NILP (XSYMBOL (sym)->obarray)))
 565     signal_error (Qsetting_constant,
 566                   UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
 567 }
 568
 569 /* Verify that it's ok to make SYM buffer-local.  This rejects
 570    constants and default-buffer-local variables.  FOLLOW_PAST_LISP_MAGIC
 571    specifies whether we delve into symbol-value-lisp-magic objects.
 572    (Should be a symbol indicating what action is being taken; that way,
 573    we don't delve if there's a handler for that action, but do otherwise.) */
 574
 575 static void
 576 verify_ok_for_buffer_local (Lisp_Object sym,
 577                             Lisp_Object follow_past_lisp_magic)
 578 {
 579   Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic);
 580
 581   if (symbol_is_constant (sym, val))
 582     goto not_ok;
 583   if (SYMBOL_VALUE_MAGIC_P (val))
 584     switch (XSYMBOL_VALUE_MAGIC_TYPE (val))
 585       {
 586         case SYMVAL_DEFAULT_BUFFER_FORWARD:
 587         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
 588           /* #### It's theoretically possible for it to be reasonable
 589              to have both console-local and buffer-local variables,
 590              but I don't want to consider that right now. */
 591         case SYMVAL_SELECTED_CONSOLE_FORWARD:
 592           goto not_ok;
 593       default: break; /* Warning suppression */
 594       }
 595
 596   return;
 597
 598   not_ok:
 599   signal_error (Qerror,
 600                 list2 (build_string ("Symbol may not be buffer-local"), sym));
 601 }
 602
 603 DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /*
 604 Make SYMBOL's value be void.
 605 */
 606        (sym))
 607 {
 608   Fset (sym, Qunbound);
 609   return sym;
 610 }
 611
 612 DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /*
 613 Make SYMBOL's function definition be void.
 614 */
 615        (sym))
 616 {
 617   CHECK_SYMBOL (sym);
 618   reject_constant_symbols (sym, Qunbound, 1, Qt);
 619   XSYMBOL (sym)->function = Qunbound;
 620   return sym;
 621 }
 622
 623 DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /*
 624 Return SYMBOL's function definition.  Error if that is void.
 625 */
 626        (symbol))
 627 {
 628   CHECK_SYMBOL (symbol);
 629   if (UNBOUNDP (XSYMBOL (symbol)->function))
 630     return Fsignal (Qvoid_function, list1 (symbol));
 631   return XSYMBOL (symbol)->function;
 632 }
 633
 634 DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /*
 635 Return SYMBOL's property list.
 636 */
 637        (sym))
 638 {
 639   CHECK_SYMBOL (sym);
 640   return XSYMBOL (sym)->plist;
 641 }
 642
 643 DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /*
 644 Return SYMBOL's name, a string.
 645 */
 646        (sym))
 647 {
 648   Lisp_Object name;
 649
 650   CHECK_SYMBOL (sym);
 651   XSETSTRING (name, XSYMBOL (sym)->name);
 652   return name;
 653 }
 654
 655 DEFUN ("fset", Ffset, 2, 2, 0, /*
 656 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
 657 */
 658        (sym, newdef))
 659 {
 660   /* This function can GC */
 661   CHECK_SYMBOL (sym);
 662   reject_constant_symbols (sym, newdef, 1, Qt);
 663   if (!NILP (Vautoload_queue) && !UNBOUNDP (XSYMBOL (sym)->function))
 664     Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function),
 665                              Vautoload_queue);
 666   XSYMBOL (sym)->function = newdef;
 667   /* Handle automatic advice activation */
 668   if (CONSP (XSYMBOL (sym)->plist) && !NILP (Fget (sym, Qad_advice_info,
 669                                                    Qnil)))
 670     {
 671       call2 (Qad_activate, sym, Qnil);
 672       newdef = XSYMBOL (sym)->function;
 673     }
 674   return newdef;
 675 }
 676
 677 /* FSFmacs */
 678 DEFUN ("define-function", Fdefine_function, 2, 2, 0, /*
 679 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
 680 Associates the function with the current load file, if any.
 681 */
 682        (sym, newdef))
 683 {
 684   /* This function can GC */
 685   CHECK_SYMBOL (sym);
 686   Ffset (sym, newdef);
 687   LOADHIST_ATTACH (sym);
 688   return newdef;
 689 }
 690
 691
 692 DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
 693 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
 694 */
 695        (sym, newplist))
 696 {
 697   CHECK_SYMBOL (sym);
 698 #if 0 /* Inserted for debugging 6/28/1997 -slb */
 699   /* Somebody is setting a property list of integer 0, who? */
 700   /* Not this way apparently. */
 701   if (EQ(newplist, Qzero)) abort();
 702 #endif
 703
 704   XSYMBOL (sym)->plist = newplist;
 705   return newplist;
 706 }
 707
 708 \f
 709 /**********************************************************************/
 710 /*                           symbol-value                             */
 711 /**********************************************************************/
 712
 713 /* If the contents of the value cell of a symbol is one of the following
 714    three types of objects, then the symbol is "magic" in that setting
 715    and retrieving its value doesn't just set or retrieve the raw
 716    contents of the value cell.  None of these objects can escape to
 717    the user level, so there is no loss of generality.
 718
 719    If a symbol is "unbound", then the contents of its value cell is
 720    Qunbound.  Despite appearances, this is *not* a symbol, but is a
 721    symbol-value-forward object.  This is so that printing it results
 722    in "INTERNAL EMACS BUG", in case it leaks to Lisp, somehow.
 723
 724    Logically all of the following objects are "symbol-value-magic"
 725    objects, and there are some games played w.r.t. this (#### this
 726    should be cleaned up).  SYMBOL_VALUE_MAGIC_P is true for all of
 727    the object types.  XSYMBOL_VALUE_MAGIC_TYPE returns the type of
 728    symbol-value-magic object.  There are more than three types
 729    returned by this macro: in particular, symbol-value-forward
 730    has eight subtypes, and symbol-value-buffer-local has two.  See
 731    symeval.h.
 732
 733    1. symbol-value-forward
 734
 735    symbol-value-forward is used for variables whose actual contents
 736    are stored in a C variable of some sort, and for Qunbound.  The
 737    lcheader.next field (which is only used to chain together free
 738    lcrecords) holds a pointer to the actual C variable.  Included
 739    in this type are "buffer-local" variables that are actually
 740    stored in the buffer object itself; in this case, the "pointer"
 741    is an offset into the struct buffer structure.
 742
 743    The subtypes are as follows:
 744
 745    SYMVAL_OBJECT_FORWARD:
 746       (declare with DEFVAR_LISP)
 747       The value of this variable is stored in a C variable of type
 748       "Lisp_Object".  Setting this variable sets the C variable.
 749       Accessing this variable retrieves a value from the C variable.
 750       These variables can be buffer-local -- in this case, the
 751       raw symbol-value field gets converted into a
 752       symbol-value-buffer-local, whose "current_value" slot contains
 753       the symbol-value-forward. (See below.)
 754
 755    SYMVAL_FIXNUM_FORWARD:
 756    SYMVAL_BOOLEAN_FORWARD:
 757       (declare with DEFVAR_INT or DEFVAR_BOOL)
 758       Similar to SYMVAL_OBJECT_FORWARD except that the C variable
 759       is of type "int" and is an integer or boolean, respectively.
 760
 761    SYMVAL_CONST_OBJECT_FORWARD:
 762    SYMVAL_CONST_FIXNUM_FORWARD:
 763    SYMVAL_CONST_BOOLEAN_FORWARD:
 764       (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
 765        DEFVAR_CONST_BOOL)
 766       Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
 767       SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
 768       be changed.
 769
 770    SYMVAL_CONST_SPECIFIER_FORWARD:
 771       (declare with DEFVAR_SPECIFIER)
 772       Exactly like SYMVAL_CONST_OBJECT_FORWARD except that error message
 773       you get when attempting to set the value says to use
 774       `set-specifier' instead.
 775
 776    SYMVAL_CURRENT_BUFFER_FORWARD:
 777       (declare with DEFVAR_BUFFER_LOCAL)
 778       This is used for built-in buffer-local variables -- i.e.
 779       Lisp variables whose value is stored in the "struct buffer".
 780       Variables of this sort always forward into C "Lisp_Object"
 781       fields (although there's no reason in principle that other
 782       types for ints and booleans couldn't be added).  Note that
 783       some of these variables are automatically local in each
 784       buffer, while some are only local when they become set
 785       (similar to `make-variable-buffer-local').  In these latter
 786       cases, of course, the default value shows through in all
 787       buffers in which the variable doesn't have a local value.
 788       This is implemented by making sure the "struct buffer" field
 789       always contains the correct value (whether it's local or
 790       a default) and maintaining a mask in the "struct buffer"
 791       indicating which fields are local.  When `set-default' is
 792       called on a variable that's not always local to all buffers,
 793       it loops through each buffer and sets the corresponding
 794       field in each buffer without a local value for the field,
 795       according to the mask.
 796
 797       Calling `make-local-variable' on a variable of this sort
 798       only has the effect of maybe changing the current buffer's mask.
 799       Calling `make-variable-buffer-local' on a variable of this
 800       sort has no effect at all.
 801
 802    SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
 803       (declare with DEFVAR_CONST_BUFFER_LOCAL)
 804       Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
 805       value cannot be set.
 806
 807    SYMVAL_DEFAULT_BUFFER_FORWARD:
 808       (declare with DEFVAR_BUFFER_DEFAULTS)
 809       This is used for the Lisp variables that contain the
 810       default values of built-in buffer-local variables.  Setting
 811       or referencing one of these variables forwards into a slot
 812       in the special struct buffer Vbuffer_defaults.
 813
 814    SYMVAL_UNBOUND_MARKER:
 815       This is used for only one object, Qunbound.
 816
 817    SYMVAL_SELECTED_CONSOLE_FORWARD:
 818       (declare with DEFVAR_CONSOLE_LOCAL)
 819       This is used for built-in console-local variables -- i.e.
 820       Lisp variables whose value is stored in the "struct console".
 821       These work just like built-in buffer-local variables.
 822       However, calling `make-local-variable' or
 823       `make-variable-buffer-local' on one of these variables
 824       is currently disallowed because that would entail having
 825       both console-local and buffer-local variables, which is
 826       trickier to implement.
 827
 828    SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
 829       (declare with DEFVAR_CONST_CONSOLE_LOCAL)
 830       Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
 831       value cannot be set.
 832
 833    SYMVAL_DEFAULT_CONSOLE_FORWARD:
 834       (declare with DEFVAR_CONSOLE_DEFAULTS)
 835       This is used for the Lisp variables that contain the
 836       default values of built-in console-local variables.  Setting
 837       or referencing one of these variables forwards into a slot
 838       in the special struct console Vconsole_defaults.
 839
 840
 841    2. symbol-value-buffer-local
 842
 843    symbol-value-buffer-local is used for variables that have had
 844    `make-local-variable' or `make-variable-buffer-local' applied
 845    to them.  This object contains an alist mapping buffers to
 846    values.  In addition, the object contains a "current value",
 847    which is the value in some buffer.  Whenever you access the
 848    variable with `symbol-value' or set it with `set' or `setq',
 849    things are switched around so that the "current value"
 850    refers to the current buffer, if it wasn't already.  This
 851    way, repeated references to a variable in the same buffer
 852    are almost as efficient as if the variable weren't buffer
 853    local.  Note that the alist may not be up-to-date w.r.t.
 854    the buffer whose value is current, as the "current value"
 855    cache is normally only flushed into the alist when the
 856    buffer it refers to changes.
 857
 858    Note also that it is possible for `make-local-variable'
 859    or `make-variable-buffer-local' to be called on a variable
 860    that forwards into a C variable (i.e. a variable whose
 861    value cell is a symbol-value-forward).  In this case,
 862    the value cell becomes a symbol-value-buffer-local (as
 863    always), and the symbol-value-forward moves into
 864    the "current value" cell in this object.  Also, in
 865    this case the "current value" *always* refers to the
 866    current buffer, so that the values of the C variable
 867    always is the correct value for the current buffer.
 868    set_buffer_internal() automatically updates the current-value
 869    cells of all buffer-local variables that forward into C
 870    variables. (There is a list of all buffer-local variables
 871    that is maintained for this and other purposes.)
 872
 873    Note that only certain types of `symbol-value-forward' objects
 874    can find their way into the "current value" cell of a
 875    `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
 876    SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
 877    SYMVAL_UNBOUND_MARKER.  The SYMVAL_CONST_*_FORWARD cannot
 878    be buffer-local because they are unsettable;
 879    SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
 880    makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
 881    does not have much of an effect (it's already buffer-local); and
 882    SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
 883    that's not currently implemented.
 884
 885
 886    3. symbol-value-varalias
 887
 888    A symbol-value-varalias object is used for variables that
 889    are aliases for other variables.  This object contains
 890    the symbol that this variable is aliased to.
 891    symbol-value-varalias objects cannot occur anywhere within
 892    a symbol-value-buffer-local object, and most of the
 893    low-level functions below do not accept them; you need
 894    to call follow_varalias_pointers to get the actual
 895    symbol to operate on.  */
 896
 897 static Lisp_Object
 898 mark_symbol_value_buffer_local (Lisp_Object obj,
 899                                 void (*markobj) (Lisp_Object))
 900 {
 901   struct symbol_value_buffer_local *bfwd;
 902
 903   assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
 904           XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
 905
 906   bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
 907   ((markobj) (bfwd->default_value));
 908   ((markobj) (bfwd->current_value));
 909   ((markobj) (bfwd->current_buffer));
 910   return bfwd->current_alist_element;
 911 }
 912
 913 static Lisp_Object
 914 mark_symbol_value_lisp_magic (Lisp_Object obj,
 915                               void (*markobj) (Lisp_Object))
 916 {
 917   struct symbol_value_lisp_magic *bfwd;
 918   int i;
 919
 920   assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
 921
 922   bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
 923   for (i = 0; i < MAGIC_HANDLER_MAX; i++)
 924     {
 925       ((markobj) (bfwd->handler[i]));
 926       ((markobj) (bfwd->harg[i]));
 927     }
 928   return bfwd->shadowed;
 929 }
 930
 931 static Lisp_Object
 932 mark_symbol_value_varalias (Lisp_Object obj,
 933                             void (*markobj) (Lisp_Object))
 934 {
 935   struct symbol_value_varalias *bfwd;
 936
 937   assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
 938
 939   bfwd = XSYMBOL_VALUE_VARALIAS (obj);
 940   ((markobj) (bfwd->shadowed));
 941   return bfwd->aliasee;
 942 }
 943
 944 /* Should never, ever be called. (except by an external debugger) */
 945 void
 946 print_symbol_value_magic (Lisp_Object obj,
 947                           Lisp_Object printcharfun, int escapeflag)
 948 {
 949   char buf[200];
 950   sprintf (buf, "#<INTERNAL EMACS BUG (%s type %d) 0x%p>",
 951            XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
 952            XSYMBOL_VALUE_MAGIC_TYPE (obj),
 953            (void *) XPNTR (obj));
 954   write_c_string (buf, printcharfun);
 955 }
 956
 957 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
 958                                symbol_value_forward,
 959                                this_one_is_unmarkable,
 960                                print_symbol_value_magic, 0, 0, 0,
 961                                struct symbol_value_forward);
 962
 963 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
 964                                symbol_value_buffer_local,
 965                                mark_symbol_value_buffer_local,
 966                                print_symbol_value_magic, 0, 0, 0,
 967                                struct symbol_value_buffer_local);
 968
 969 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
 970                                symbol_value_lisp_magic,
 971                                mark_symbol_value_lisp_magic,
 972                                print_symbol_value_magic, 0, 0, 0,
 973                                struct symbol_value_lisp_magic);
 974
 975 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
 976                                symbol_value_varalias,
 977                                mark_symbol_value_varalias,
 978                                print_symbol_value_magic, 0, 0, 0,
 979                                struct symbol_value_varalias);
 980
 981 \f
 982 /* Getting and setting values of symbols */
 983
 984 /* Given the raw contents of a symbol value cell, return the Lisp value of
 985    the symbol.  However, VALCONTENTS cannot be a symbol-value-buffer-local,
 986    symbol-value-lisp-magic, or symbol-value-varalias.
 987
 988    BUFFER specifies a buffer, and is used for built-in buffer-local
 989    variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
 990    Note that such variables are never encapsulated in a
 991    symbol-value-buffer-local structure.
 992
 993    CONSOLE specifies a console, and is used for built-in console-local
 994    variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
 995    Note that such variables are (currently) never encapsulated in a
 996    symbol-value-buffer-local structure.
 997  */
 998
 999 static Lisp_Object
1000 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
1001                       struct console *console)
1002 {
1003   CONST struct symbol_value_forward *fwd;
1004
1005   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1006     return valcontents;
1007
1008   fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1009   switch (fwd->magic.type)
1010     {
1011     case SYMVAL_FIXNUM_FORWARD:
1012     case SYMVAL_CONST_FIXNUM_FORWARD:
1013       return make_int (*((int *)symbol_value_forward_forward (fwd)));
1014
1015     case SYMVAL_BOOLEAN_FORWARD:
1016     case SYMVAL_CONST_BOOLEAN_FORWARD:
1017       return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil;
1018
1019     case SYMVAL_OBJECT_FORWARD:
1020     case SYMVAL_CONST_OBJECT_FORWARD:
1021     case SYMVAL_CONST_SPECIFIER_FORWARD:
1022       return *((Lisp_Object *)symbol_value_forward_forward (fwd));
1023
1024     case SYMVAL_DEFAULT_BUFFER_FORWARD:
1025       return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1026                                 + ((char *)symbol_value_forward_forward (fwd)
1027                                    - (char *)&buffer_local_flags))));
1028
1029
1030     case SYMVAL_CURRENT_BUFFER_FORWARD:
1031     case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1032       assert (buffer);
1033       return (*((Lisp_Object *)((char *)buffer
1034                                 + ((char *)symbol_value_forward_forward (fwd)
1035                                    - (char *)&buffer_local_flags))));
1036
1037     case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1038       return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1039                                 + ((char *)symbol_value_forward_forward (fwd)
1040                                    - (char *)&console_local_flags))));
1041
1042     case SYMVAL_SELECTED_CONSOLE_FORWARD:
1043     case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1044       assert (console);
1045       return (*((Lisp_Object *)((char *)console
1046                                 + ((char *)symbol_value_forward_forward (fwd)
1047                                    - (char *)&console_local_flags))));
1048
1049     case SYMVAL_UNBOUND_MARKER:
1050       return valcontents;
1051
1052     default:
1053       abort ();
1054     }
1055   return Qnil;  /* suppress compiler warning */
1056 }
1057
1058 /* Set the value of default-buffer-local variable SYM to VALUE. */
1059
1060 static void
1061 set_default_buffer_slot_variable (Lisp_Object sym,
1062                                   Lisp_Object value)
1063 {
1064   /* Handle variables like case-fold-search that have special slots in
1065      the buffer. Make them work apparently like buffer_local variables.
1066      */
1067   /* At this point, the value cell may not contain a symbol-value-varalias
1068      or symbol-value-buffer-local, and if there's a handler, we should
1069      have already called it. */
1070   Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1071   CONST struct symbol_value_forward *fwd
1072     = XSYMBOL_VALUE_FORWARD (valcontents);
1073   int offset = ((char *) symbol_value_forward_forward (fwd)
1074                 - (char *) &buffer_local_flags);
1075   int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1076   int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1077                    int flags) = symbol_value_forward_magicfun (fwd);
1078
1079   *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults)))
1080     = value;
1081
1082   if (mask > 0)         /* Not always per-buffer */
1083     {
1084       Lisp_Object tail;
1085
1086       /* Set value in each buffer which hasn't shadowed the default */
1087       LIST_LOOP (tail, Vbuffer_alist)
1088         {
1089           struct buffer *b = XBUFFER (XCDR (XCAR (tail)));
1090           if (!(b->local_var_flags & mask))
1091             {
1092               if (magicfun)
1093                 (magicfun) (sym, &value, make_buffer (b), 0);
1094               *((Lisp_Object *) (offset + (char *) b)) = value;
1095             }
1096         }
1097     }
1098 }
1099
1100 /* Set the value of default-console-local variable SYM to VALUE. */
1101
1102 static void
1103 set_default_console_slot_variable (Lisp_Object sym,
1104                                    Lisp_Object value)
1105 {
1106   /* Handle variables like case-fold-search that have special slots in
1107      the console. Make them work apparently like console_local variables.
1108      */
1109   /* At this point, the value cell may not contain a symbol-value-varalias
1110      or symbol-value-buffer-local, and if there's a handler, we should
1111      have already called it. */
1112   Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1113   CONST struct symbol_value_forward *fwd
1114     = XSYMBOL_VALUE_FORWARD (valcontents);
1115   int offset = ((char *) symbol_value_forward_forward (fwd)
1116                 - (char *) &console_local_flags);
1117   int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1118   int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1119                    int flags) = symbol_value_forward_magicfun (fwd);
1120
1121   *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults)))
1122     = value;
1123
1124   if (mask > 0)         /* Not always per-console */
1125     {
1126       Lisp_Object tail;
1127
1128       /* Set value in each console which hasn't shadowed the default */
1129       LIST_LOOP (tail, Vconsole_list)
1130         {
1131           Lisp_Object dev = XCAR (tail);
1132           struct console *d = XCONSOLE (dev);
1133           if (!(d->local_var_flags & mask))
1134             {
1135               if (magicfun)
1136                 (magicfun) (sym, &value, dev, 0);
1137               *((Lisp_Object *) (offset + (char *) d)) = value;
1138             }
1139         }
1140     }
1141 }
1142
1143 /* Store NEWVAL into SYM.
1144
1145    SYM's value slot may *not* be types (5) or (6) above,
1146    i.e. no symbol-value-varalias objects. (You should have
1147    forwarded past all of these.)
1148
1149    SYM should not be an unsettable symbol or a symbol with
1150    a magic `set-value' handler (unless you want to explicitly
1151    ignore this handler).
1152
1153    OVALUE is the current value of SYM, but forwarded past any
1154    symbol-value-buffer-local and symbol-value-lisp-magic objects.
1155    (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1156    the contents of its current-value cell.) NEWVAL may only be
1157    a simple value or Qunbound.  If SYM is a symbol-value-buffer-local,
1158    this function will only modify its current-value cell, which should
1159    already be set up to point to the current buffer.
1160   */
1161
1162 static void
1163 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
1164                          Lisp_Object newval)
1165 {
1166   if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue))
1167     {
1168       Lisp_Object *store_pointer = value_slot_past_magic (sym);
1169
1170       if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer))
1171         store_pointer =
1172           &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value;
1173
1174       assert (UNBOUNDP (*store_pointer)
1175               || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1176       *store_pointer = newval;
1177     }
1178
1179   else
1180     {
1181       CONST struct symbol_value_forward *fwd
1182         = XSYMBOL_VALUE_FORWARD (ovalue);
1183       int type = XSYMBOL_VALUE_MAGIC_TYPE (ovalue);
1184       int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
1185                        Lisp_Object in_object, int flags) =
1186                          symbol_value_forward_magicfun (fwd);
1187
1188       switch (type)
1189         {
1190         case SYMVAL_FIXNUM_FORWARD:
1191           {
1192             CHECK_INT (newval);
1193             if (magicfun)
1194               (magicfun) (sym, &newval, Qnil, 0);
1195             *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
1196             return;
1197           }
1198
1199         case SYMVAL_BOOLEAN_FORWARD:
1200           {
1201             if (magicfun)
1202               (magicfun) (sym, &newval, Qnil, 0);
1203             *((int *) symbol_value_forward_forward (fwd))
1204               = ((NILP (newval)) ? 0 : 1);
1205             return;
1206           }
1207
1208         case SYMVAL_OBJECT_FORWARD:
1209           {
1210             if (magicfun)
1211               (magicfun) (sym, &newval, Qnil, 0);
1212             *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval;
1213             return;
1214           }
1215
1216         case SYMVAL_DEFAULT_BUFFER_FORWARD:
1217           {
1218             set_default_buffer_slot_variable (sym, newval);
1219             return;
1220           }
1221
1222         case SYMVAL_CURRENT_BUFFER_FORWARD:
1223           {
1224             if (magicfun)
1225               (magicfun) (sym, &newval, make_buffer (current_buffer), 0);
1226             *((Lisp_Object *) ((char *) current_buffer
1227                                + ((char *) symbol_value_forward_forward (fwd)
1228                                   - (char *) &buffer_local_flags)))
1229               = newval;
1230             return;
1231           }
1232
1233         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1234           {
1235             set_default_console_slot_variable (sym, newval);
1236             return;
1237           }
1238
1239         case SYMVAL_SELECTED_CONSOLE_FORWARD:
1240           {
1241             if (magicfun)
1242               (magicfun) (sym, &newval, Vselected_console, 0);
1243             *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console)
1244                                + ((char *) symbol_value_forward_forward (fwd)
1245                                   - (char *) &console_local_flags)))
1246               = newval;
1247             return;
1248           }
1249
1250         default:
1251           abort ();
1252         }
1253     }
1254 }
1255
1256 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1257    BFWD, locate and return a pointer to the element in BUFFER's
1258    local_var_alist for SYMBOL.  The return value will be Qnil if
1259    BUFFER does not have its own value for SYMBOL (i.e. the default
1260    value is seen in that buffer).
1261    */
1262
1263 static Lisp_Object
1264 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol,
1265                             struct symbol_value_buffer_local *bfwd)
1266 {
1267   if (!NILP (bfwd->current_buffer) &&
1268       XBUFFER (bfwd->current_buffer) == buffer)
1269     /* This is just an optimization of the below. */
1270     return bfwd->current_alist_element;
1271   else
1272     return assq_no_quit (symbol, buffer->local_var_alist);
1273 }
1274
1275 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1276    symbol-value-buffer-local of a per-buffer variable -- i.e. the
1277    slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1278    slot -- may be out of date.]
1279
1280    Write out any cached value in buffer-local variable SYMBOL's
1281    buffer-local structure, which is passed in as BFWD.
1282 */
1283
1284 static void
1285 write_out_buffer_local_cache (Lisp_Object symbol,
1286                               struct symbol_value_buffer_local *bfwd)
1287 {
1288   if (!NILP (bfwd->current_buffer))
1289     {
1290       /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1291          uses it, and that type cannot be inside a symbol-value-buffer-local */
1292       Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0);
1293       if (NILP (bfwd->current_alist_element))
1294         /* current_value may be updated more recently than default_value */
1295         bfwd->default_value = cval;
1296       else
1297         Fsetcdr (bfwd->current_alist_element, cval);
1298     }
1299 }
1300
1301 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1302    Set up BFWD's cache for validity in buffer BUF.  This assumes that
1303    the cache is currently in a consistent state (this can include
1304    not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1305
1306    If the cache is already set up for BUF, this function does nothing
1307    at all.
1308
1309    Otherwise, if SYM forwards out to a C variable, this also forwards
1310    SYM's value in BUF out to the variable.  Therefore, you generally
1311    only want to call this when BUF is, or is about to become, the
1312    current buffer.
1313
1314    (Otherwise, you can just retrieve the value without changing the
1315    cache, at the expense of slower retrieval.)
1316 */
1317
1318 static void
1319 set_up_buffer_local_cache (Lisp_Object sym,
1320                            struct symbol_value_buffer_local *bfwd,
1321                            struct buffer *buf,
1322                            Lisp_Object new_alist_el,
1323                            int set_it_p)
1324 {
1325   Lisp_Object new_val;
1326
1327   if (!NILP (bfwd->current_buffer)
1328       && buf == XBUFFER (bfwd->current_buffer))
1329     /* Cache is already set up. */
1330     return;
1331
1332   /* Flush out the old cache. */
1333   write_out_buffer_local_cache (sym, bfwd);
1334
1335   /* Retrieve the new alist element and new value. */
1336   if (NILP (new_alist_el)
1337       && set_it_p)
1338   new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1339
1340   if (NILP (new_alist_el))
1341     new_val = bfwd->default_value;
1342   else
1343     new_val = Fcdr (new_alist_el);
1344
1345   bfwd->current_alist_element = new_alist_el;
1346   XSETBUFFER (bfwd->current_buffer, buf);
1347
1348   /* Now store the value into the current-value slot.
1349      We don't simply write it there, because the current-value
1350      slot might be a forwarding pointer, in which case we need
1351      to instead write the value into the C variable.
1352
1353      We might also want to call a magic function.
1354
1355      So instead, we call this function. */
1356   store_symval_forwarding (sym, bfwd->current_value, new_val);
1357 }
1358
1359 \f
1360 void
1361 kill_buffer_local_variables (struct buffer *buf)
1362 {
1363   Lisp_Object prev = Qnil;
1364   Lisp_Object alist;
1365
1366   /* Any which are supposed to be permanent,
1367      make local again, with the same values they had.  */
1368
1369   for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist))
1370     {
1371       Lisp_Object sym = XCAR (XCAR (alist));
1372       struct symbol_value_buffer_local *bfwd;
1373       /* Variables with a symbol-value-varalias should not be here
1374          (we should have forwarded past them) and there must be a
1375          symbol-value-buffer-local.  If there's a symbol-value-lisp-magic,
1376          just forward past it; if the variable has a handler, it was
1377          already called. */
1378       Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt);
1379
1380       assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value));
1381       bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value);
1382
1383       if (!NILP (Fget (sym, Qpermanent_local, Qnil)))
1384         /* prev points to the last alist element that is still
1385            staying around, so *only* update it now.  This didn't
1386            used to be the case; this bug has been around since
1387            mly's rewrite two years ago! */
1388         prev = alist;
1389       else
1390         {
1391           /* Really truly kill it. */
1392           if (!NILP (prev))
1393             XCDR (prev) = XCDR (alist);
1394           else
1395             buf->local_var_alist = XCDR (alist);
1396
1397           /* We just effectively changed the value for this variable
1398              in BUF. So: */
1399
1400           /* (1) If the cache is caching BUF, invalidate the cache. */
1401           if (!NILP (bfwd->current_buffer) &&
1402               buf == XBUFFER (bfwd->current_buffer))
1403             bfwd->current_buffer = Qnil;
1404
1405           /* (2) If we changed the value in current_buffer and this
1406              variable forwards to a C variable, we need to change the
1407              value of the C variable.  set_up_buffer_local_cache()
1408              will do this.  It doesn't hurt to do it whenever
1409              BUF == current_buffer, so just go ahead and do that. */
1410           if (buf == current_buffer)
1411             set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
1412         }
1413     }
1414 }
1415 \f
1416 static Lisp_Object
1417 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1418                      struct console *con, int swap_it_in,
1419                      Lisp_Object symcons, int set_it_p)
1420 {
1421   Lisp_Object valcontents;
1422
1423  retry:
1424   valcontents = XSYMBOL (sym)->value;
1425
1426  retry_2:
1427   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1428     return valcontents;
1429
1430   switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1431     {
1432     case SYMVAL_LISP_MAGIC:
1433       /* #### kludge */
1434       valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1435       /* semi-change-o */
1436       goto retry_2;
1437
1438     case SYMVAL_VARALIAS:
1439       sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1440       symcons = Qnil;
1441       /* presto change-o! */
1442       goto retry;
1443
1444     case SYMVAL_BUFFER_LOCAL:
1445     case SYMVAL_SOME_BUFFER_LOCAL:
1446       {
1447         struct symbol_value_buffer_local *bfwd
1448           = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1449
1450         if (swap_it_in)
1451           {
1452             set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1453             valcontents = bfwd->current_value;
1454           }
1455         else
1456           {
1457             if (!NILP (bfwd->current_buffer) &&
1458                 buf == XBUFFER (bfwd->current_buffer))
1459               valcontents = bfwd->current_value;
1460             else if (NILP (symcons))
1461               {
1462                 if (set_it_p)
1463                 valcontents = assq_no_quit (sym, buf->local_var_alist);
1464                 if (NILP (valcontents))
1465                   valcontents = bfwd->default_value;
1466                 else
1467                   valcontents = XCDR (valcontents);
1468               }
1469             else
1470               valcontents = XCDR (symcons);
1471           }
1472         break;
1473       }
1474
1475     default:
1476       break;
1477     }
1478   return do_symval_forwarding (valcontents, buf, con);
1479 }
1480
1481
1482 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1483    bound.  Note that it must not be possible to QUIT within this
1484    function. */
1485
1486 Lisp_Object
1487 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer)
1488 {
1489   struct buffer *buf;
1490
1491   CHECK_SYMBOL (sym);
1492
1493   if (!NILP (buffer))
1494     {
1495       CHECK_BUFFER (buffer);
1496       buf = XBUFFER (buffer);
1497     }
1498   else
1499     buf = current_buffer;
1500
1501   return find_symbol_value_1 (sym, buf,
1502                               /* If it bombs out at startup due to a
1503                                  Lisp error, this may be nil. */
1504                               CONSOLEP (Vselected_console)
1505                               ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
1506 }
1507
1508 static Lisp_Object
1509 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1510 {
1511   CHECK_SYMBOL (sym);
1512
1513   if (!NILP (console))
1514     CHECK_CONSOLE (console);
1515   else
1516     console = Vselected_console;
1517
1518   return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1519                               Qnil, 1);
1520 }
1521
1522 /* Return the current value of SYM.  The difference between this function
1523    and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1524    this updates the CURRENT_VALUE slot of buffer-local variables to
1525    point to the current buffer, while symbol_value_in_buffer doesn't. */
1526
1527 Lisp_Object
1528 find_symbol_value (Lisp_Object sym)
1529 {
1530   /* WARNING: This function can be called when current_buffer is 0
1531      and Vselected_console is Qnil, early in initialization. */
1532   struct console *dev;
1533   Lisp_Object valcontents;
1534
1535   CHECK_SYMBOL (sym);
1536
1537   valcontents = XSYMBOL (sym)->value;
1538   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1539     return valcontents;
1540
1541   if (CONSOLEP (Vselected_console))
1542     dev = XCONSOLE (Vselected_console);
1543   else
1544     {
1545       /* This can also get called while we're preparing to shutdown.
1546          #### What should really happen in that case?  Should we
1547          actually fix things so we can't get here in that case? */
1548       assert (!initialized || preparing_for_armageddon);
1549       dev = 0;
1550     }
1551
1552   return find_symbol_value_1 (sym, current_buffer, dev, 1, Qnil, 1);
1553 }
1554
1555 /* This is an optimized function for quick lookup of buffer local symbols
1556    by avoiding O(n) search.  This will work when either:
1557      a) We have already found the symbol e.g. by traversing local_var_alist.
1558    or
1559      b) We know that the symbol will not be found in the current buffer's
1560         list of local variables.
1561    In the former case, find_it_p is 1 and symbol_cons is the element from
1562    local_var_alist.  In the latter case, find_it_p is 0 and symbol_cons
1563    is the symbol.
1564
1565    This function is called from set_buffer_internal which does both of these
1566    things. */
1567
1568 Lisp_Object
1569 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1570 {
1571   /* WARNING: This function can be called when current_buffer is 0
1572      and Vselected_console is Qnil, early in initialization. */
1573   struct console *dev;
1574   Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1575
1576   CHECK_SYMBOL (sym);
1577   if (CONSOLEP (Vselected_console))
1578     dev = XCONSOLE (Vselected_console);
1579   else
1580     {
1581       /* This can also get called while we're preparing to shutdown.
1582          #### What should really happen in that case?  Should we
1583          actually fix things so we can't get here in that case? */
1584       assert (!initialized || preparing_for_armageddon);
1585       dev = 0;
1586     }
1587
1588   return find_symbol_value_1 (sym, current_buffer, dev, 1,
1589                               find_it_p ? symbol_cons : Qnil,
1590                               find_it_p);
1591 }
1592
1593 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1594 Return SYMBOL's value.  Error if that is void.
1595 */
1596        (sym))
1597 {
1598   Lisp_Object val = find_symbol_value (sym);
1599
1600   if (UNBOUNDP (val))
1601     return Fsignal (Qvoid_variable, list1 (sym));
1602   else
1603     return val;
1604 }
1605
1606 DEFUN ("set", Fset, 2, 2, 0, /*
1607 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1608 */
1609        (sym, newval))
1610 {
1611   REGISTER Lisp_Object valcontents;
1612   /* remember, we're called by Fmakunbound() as well */
1613
1614   CHECK_SYMBOL (sym);
1615
1616  retry:
1617   valcontents = XSYMBOL (sym)->value;
1618   if (NILP (sym) || EQ (sym, Qt) || SYMBOL_VALUE_MAGIC_P (valcontents)
1619       || SYMBOL_IS_KEYWORD (sym))
1620     reject_constant_symbols (sym, newval, 0,
1621                              UNBOUNDP (newval) ? Qmakunbound : Qset);
1622   else
1623     {
1624       XSYMBOL (sym)->value = newval;
1625       return newval;
1626     }
1627
1628  retry_2:
1629
1630   if (SYMBOL_VALUE_MAGIC_P (valcontents))
1631     {
1632       switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1633         {
1634         case SYMVAL_LISP_MAGIC:
1635           {
1636             Lisp_Object retval;
1637
1638             if (UNBOUNDP (newval))
1639               retval = maybe_call_magic_handler (sym, Qmakunbound, 0);
1640             else
1641               retval = maybe_call_magic_handler (sym, Qset, 1, newval);
1642             if (!UNBOUNDP (retval))
1643               return newval;
1644             valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1645             /* semi-change-o */
1646             goto retry_2;
1647           }
1648
1649         case SYMVAL_VARALIAS:
1650           sym = follow_varalias_pointers (sym,
1651                                           UNBOUNDP (newval)
1652                                           ? Qmakunbound : Qset);
1653           /* presto change-o! */
1654           goto retry;
1655
1656         case SYMVAL_FIXNUM_FORWARD:
1657         case SYMVAL_BOOLEAN_FORWARD:
1658         case SYMVAL_OBJECT_FORWARD:
1659         case SYMVAL_DEFAULT_BUFFER_FORWARD:
1660         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1661           if (UNBOUNDP (newval))
1662             signal_error (Qerror,
1663                           list2 (build_string ("Cannot makunbound"), sym));
1664           break;
1665
1666         case SYMVAL_UNBOUND_MARKER:
1667           break;
1668
1669         case SYMVAL_CURRENT_BUFFER_FORWARD:
1670           {
1671             CONST struct symbol_value_forward *fwd
1672               = XSYMBOL_VALUE_FORWARD (valcontents);
1673             int mask = XINT (*((Lisp_Object *)
1674                                symbol_value_forward_forward (fwd)));
1675             if (mask > 0)
1676               /* Setting this variable makes it buffer-local */
1677               current_buffer->local_var_flags |= mask;
1678             break;
1679           }
1680
1681         case SYMVAL_SELECTED_CONSOLE_FORWARD:
1682           {
1683             CONST struct symbol_value_forward *fwd
1684               = XSYMBOL_VALUE_FORWARD (valcontents);
1685             int mask = XINT (*((Lisp_Object *)
1686                                symbol_value_forward_forward (fwd)));
1687             if (mask > 0)
1688               /* Setting this variable makes it console-local */
1689               XCONSOLE (Vselected_console)->local_var_flags |= mask;
1690             break;
1691           }
1692
1693         case SYMVAL_BUFFER_LOCAL:
1694         case SYMVAL_SOME_BUFFER_LOCAL:
1695           {
1696             /* If we want to examine or set the value and
1697                CURRENT-BUFFER is current, we just examine or set
1698                CURRENT-VALUE. If CURRENT-BUFFER is not current, we
1699                store the current CURRENT-VALUE value into
1700                CURRENT-ALIST- ELEMENT, then find the appropriate alist
1701                element for the buffer now current and set up
1702                CURRENT-ALIST-ELEMENT.  Then we set CURRENT-VALUE out
1703                of that element, and store into CURRENT-BUFFER.
1704
1705                If we are setting the variable and the current buffer does
1706                not have an alist entry for this variable, an alist entry is
1707                created.
1708
1709                Note that CURRENT-VALUE can be a forwarding pointer.
1710                Each time it is examined or set, forwarding must be
1711                done. */
1712             struct symbol_value_buffer_local *bfwd
1713               = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1714             int some_buffer_local_p =
1715               (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
1716             /* What value are we caching right now?  */
1717             Lisp_Object aelt = bfwd->current_alist_element;
1718
1719             if (!NILP (bfwd->current_buffer) &&
1720                 current_buffer == XBUFFER (bfwd->current_buffer)
1721                 && ((some_buffer_local_p)
1722                     ? 1            /* doesn't automatically become local */
1723                     : !NILP (aelt) /* already local */
1724                     ))
1725               {
1726                 /* Cache is valid */
1727                 valcontents = bfwd->current_value;
1728               }
1729             else
1730               {
1731                 /* If the current buffer is not the buffer whose binding is
1732                    currently cached, or if it's a SYMVAL_BUFFER_LOCAL and
1733                    we're looking at the default value, the cache is invalid; we
1734                    need to write it out, and find the new CURRENT-ALIST-ELEMENT
1735                    */
1736
1737                 /* Write out the cached value for the old buffer; copy it
1738                    back to its alist element.  This works if the current
1739                    buffer only sees the default value, too.  */
1740                 write_out_buffer_local_cache (sym, bfwd);
1741
1742                 /* Find the new value for CURRENT-ALIST-ELEMENT.  */
1743                 aelt = buffer_local_alist_element (current_buffer, sym, bfwd);
1744                 if (NILP (aelt))
1745                   {
1746                     /* This buffer is still seeing the default value.  */
1747                     if (!some_buffer_local_p)
1748                       {
1749                         /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a
1750                            new assoc for a local value and set
1751                            CURRENT-ALIST-ELEMENT to point to that.  */
1752                         aelt =
1753                           do_symval_forwarding (bfwd->current_value,
1754                                                 current_buffer,
1755                                                 XCONSOLE (Vselected_console));
1756                         aelt = Fcons (sym, aelt);
1757                         current_buffer->local_var_alist
1758                           = Fcons (aelt, current_buffer->local_var_alist);
1759                       }
1760                     else
1761                       {
1762                         /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL,
1763                            we're currently seeing the default value. */
1764                         ;
1765                       }
1766                   }
1767                 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT.  */
1768                 bfwd->current_alist_element = aelt;
1769                 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate.  */
1770                 XSETBUFFER (bfwd->current_buffer, current_buffer);
1771                 valcontents = bfwd->current_value;
1772               }
1773             break;
1774           }
1775         default:
1776           abort ();
1777         }
1778     }
1779   store_symval_forwarding (sym, valcontents, newval);
1780
1781   return newval;
1782 }
1783
1784 \f
1785 /* Access or set a buffer-local symbol's default value.  */
1786
1787 /* Return the default value of SYM, but don't check for voidness.
1788    Return Qunbound if it is void.  */
1789
1790 static Lisp_Object
1791 default_value (Lisp_Object sym)
1792 {
1793   Lisp_Object valcontents;
1794
1795   CHECK_SYMBOL (sym);
1796
1797  retry:
1798   valcontents = XSYMBOL (sym)->value;
1799
1800  retry_2:
1801   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1802     return valcontents;
1803
1804   switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1805     {
1806     case SYMVAL_LISP_MAGIC:
1807       /* #### kludge */
1808       valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1809       /* semi-change-o */
1810       goto retry_2;
1811
1812     case SYMVAL_VARALIAS:
1813       sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1814       /* presto change-o! */
1815       goto retry;
1816
1817     case SYMVAL_UNBOUND_MARKER:
1818       return valcontents;
1819
1820     case SYMVAL_CURRENT_BUFFER_FORWARD:
1821       {
1822         CONST struct symbol_value_forward *fwd
1823           = XSYMBOL_VALUE_FORWARD (valcontents);
1824         return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1825                                   + ((char *)symbol_value_forward_forward (fwd)
1826                                      - (char *)&buffer_local_flags))));
1827       }
1828
1829     case SYMVAL_SELECTED_CONSOLE_FORWARD:
1830       {
1831         CONST struct symbol_value_forward *fwd
1832           = XSYMBOL_VALUE_FORWARD (valcontents);
1833         return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1834                                   + ((char *)symbol_value_forward_forward (fwd)
1835                                      - (char *)&console_local_flags))));
1836       }
1837
1838     case SYMVAL_BUFFER_LOCAL:
1839     case SYMVAL_SOME_BUFFER_LOCAL:
1840       {
1841         struct symbol_value_buffer_local *bfwd =
1842           XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1843
1844         /* Handle user-created local variables.  */
1845         /* If var is set up for a buffer that lacks a local value for it,
1846            the current value is nominally the default value.
1847            But the current value slot may be more up to date, since
1848            ordinary setq stores just that slot.  So use that.  */
1849         if (NILP (bfwd->current_alist_element))
1850           return do_symval_forwarding (bfwd->current_value, current_buffer,
1851                                        XCONSOLE (Vselected_console));
1852         else
1853           return bfwd->default_value;
1854       }
1855     default:
1856       /* For other variables, get the current value.    */
1857       return do_symval_forwarding (valcontents, current_buffer,
1858                                    XCONSOLE (Vselected_console));
1859     }
1860
1861   RETURN_NOT_REACHED(Qnil)      /* suppress compiler warning */
1862 }
1863
1864 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /*
1865 Return t if SYMBOL has a non-void default value.
1866 This is the value that is seen in buffers that do not have their own values
1867 for this variable.
1868 */
1869        (sym))
1870 {
1871   return UNBOUNDP (default_value (sym)) ? Qnil : Qt;
1872 }
1873
1874 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /*
1875 Return SYMBOL's default value.
1876 This is the value that is seen in buffers that do not have their own values
1877 for this variable.  The default value is meaningful for variables with
1878 local bindings in certain buffers.
1879 */
1880        (sym))
1881 {
1882   Lisp_Object value = default_value (sym);
1883
1884   return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (sym)) : value;
1885 }
1886
1887 DEFUN ("set-default", Fset_default, 2, 2, 0, /*
1888 Set SYMBOL's default value to VAL.  SYMBOL and VAL are evaluated.
1889 The default value is seen in buffers that do not have their own values
1890 for this variable.
1891 */
1892        (sym, value))
1893 {
1894   Lisp_Object valcontents;
1895
1896   CHECK_SYMBOL (sym);
1897
1898  retry:
1899   valcontents = XSYMBOL (sym)->value;
1900
1901  retry_2:
1902   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1903     return Fset (sym, value);
1904
1905   switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1906     {
1907     case SYMVAL_LISP_MAGIC:
1908       RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (sym, Qset_default, 1,
1909                                                        value));
1910       valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1911       /* semi-change-o */
1912       goto retry_2;
1913
1914     case SYMVAL_VARALIAS:
1915       sym = follow_varalias_pointers (sym, Qset_default);
1916       /* presto change-o! */
1917       goto retry;
1918
1919     case SYMVAL_CURRENT_BUFFER_FORWARD:
1920       set_default_buffer_slot_variable (sym, value);
1921       return value;
1922
1923     case SYMVAL_SELECTED_CONSOLE_FORWARD:
1924       set_default_console_slot_variable (sym, value);
1925       return value;
1926
1927     case SYMVAL_BUFFER_LOCAL:
1928     case SYMVAL_SOME_BUFFER_LOCAL:
1929       {
1930         /* Store new value into the DEFAULT-VALUE slot */
1931         struct symbol_value_buffer_local *bfwd
1932           = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1933
1934         bfwd->default_value = value;
1935         /* If current-buffer doesn't shadow default_value,
1936          *  we must set the CURRENT-VALUE slot too */
1937         if (NILP (bfwd->current_alist_element))
1938           store_symval_forwarding (sym, bfwd->current_value, value);
1939         return value;
1940       }
1941
1942     default:
1943       return Fset (sym, value);
1944     }
1945   RETURN_NOT_REACHED(Qnil)      /* suppress compiler warning */
1946 }
1947
1948 DEFUN ("setq-default", Fsetq_default, 2, UNEVALLED, 0, /*
1949 Set the default value of variable SYM to VALUE.
1950 SYM, the variable name, is literal (not evaluated);
1951 VALUE is an expression and it is evaluated.
1952 The default value of a variable is seen in buffers
1953 that do not have their own values for the variable.
1954
1955 More generally, you can use multiple variables and values, as in
1956   (setq-default SYM VALUE SYM VALUE...)
1957 This sets each SYM's default value to the corresponding VALUE.
1958 The VALUE for the Nth SYM can refer to the new default values
1959 of previous SYMs.
1960 */
1961        (args))
1962 {
1963   /* This function can GC */
1964   Lisp_Object args_left;
1965   Lisp_Object val, sym;
1966   struct gcpro gcpro1;
1967
1968   if (NILP (args))
1969     return Qnil;
1970
1971   args_left = args;
1972   GCPRO1 (args);
1973
1974   do
1975     {
1976       val = Feval (Fcar (Fcdr (args_left)));
1977       sym = Fcar (args_left);
1978       Fset_default (sym, val);
1979       args_left = Fcdr (Fcdr (args_left));
1980     }
1981   while (!NILP (args_left));
1982
1983   UNGCPRO;
1984   return val;
1985 }
1986 \f
1987 /* Lisp functions for creating and removing buffer-local variables.  */
1988
1989 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1,
1990        "vMake Variable Buffer Local: ", /*
1991 Make VARIABLE have a separate value for each buffer.
1992 At any time, the value for the current buffer is in effect.
1993 There is also a default value which is seen in any buffer which has not yet
1994 set its own value.
1995 Using `set' or `setq' to set the variable causes it to have a separate value
1996 for the current buffer if it was previously using the default value.
1997 The function `default-value' gets the default value and `set-default'
1998 sets it.
1999 */
2000        (variable))
2001 {
2002   Lisp_Object valcontents;
2003
2004   CHECK_SYMBOL (variable);
2005
2006  retry:
2007   verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local);
2008
2009   valcontents = XSYMBOL (variable)->value;
2010
2011  retry_2:
2012   if (SYMBOL_VALUE_MAGIC_P (valcontents))
2013     {
2014       switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2015         {
2016         case SYMVAL_LISP_MAGIC:
2017           if (!UNBOUNDP (maybe_call_magic_handler
2018                          (variable, Qmake_variable_buffer_local, 0)))
2019             return variable;
2020           valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2021           /* semi-change-o */
2022           goto retry_2;
2023
2024         case SYMVAL_VARALIAS:
2025           variable = follow_varalias_pointers (variable,
2026                                                Qmake_variable_buffer_local);
2027           /* presto change-o! */
2028           goto retry;
2029
2030         case SYMVAL_FIXNUM_FORWARD:
2031         case SYMVAL_BOOLEAN_FORWARD:
2032         case SYMVAL_OBJECT_FORWARD:
2033         case SYMVAL_UNBOUND_MARKER:
2034           break;
2035
2036         case SYMVAL_CURRENT_BUFFER_FORWARD:
2037         case SYMVAL_BUFFER_LOCAL:
2038           /* Already per-each-buffer */
2039           return variable;
2040
2041         case SYMVAL_SOME_BUFFER_LOCAL:
2042           /* Transmogrify */
2043           XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type =
2044             SYMVAL_BUFFER_LOCAL;
2045           return variable;
2046
2047         default:
2048           abort ();
2049         }
2050     }
2051
2052   {
2053     struct symbol_value_buffer_local *bfwd
2054       = alloc_lcrecord_type (struct symbol_value_buffer_local,
2055                              lrecord_symbol_value_buffer_local);
2056     Lisp_Object foo;
2057     bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2058
2059     bfwd->default_value = find_symbol_value (variable);
2060     bfwd->current_value = valcontents;
2061     bfwd->current_alist_element = Qnil;
2062     bfwd->current_buffer = Fcurrent_buffer ();
2063     XSETSYMBOL_VALUE_MAGIC (foo, bfwd);
2064     *value_slot_past_magic (variable) = foo;
2065 #if 1                           /* #### Yuck!   FSFmacs bug-compatibility*/
2066     /* This sets the default-value of any make-variable-buffer-local to nil.
2067        That just sucks.  User can just use setq-default to effect that,
2068        but there's no way to do makunbound-default to undo this lossage. */
2069     if (UNBOUNDP (valcontents))
2070       bfwd->default_value = Qnil;
2071 #endif
2072 #if 0                           /* #### Yuck! */
2073     /* This sets the value to nil in this buffer.
2074        User could use (setq variable nil) to do this.
2075        It isn't as egregious to do this automatically
2076        as it is to do so to the default-value, but it's
2077        still really dubious. */
2078     if (UNBOUNDP (valcontents))
2079       Fset (variable, Qnil);
2080 #endif
2081     return variable;
2082   }
2083 }
2084
2085 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1,
2086        "vMake Local Variable: ", /*
2087 Make VARIABLE have a separate value in the current buffer.
2088 Other buffers will continue to share a common default value.
2089 \(The buffer-local value of VARIABLE starts out as the same value
2090 VARIABLE previously had.  If VARIABLE was void, it remains void.)
2091 See also `make-variable-buffer-local'.
2092
2093 If the variable is already arranged to become local when set,
2094 this function causes a local value to exist for this buffer,
2095 just as setting the variable would do.
2096
2097 Do not use `make-local-variable' to make a hook variable buffer-local.
2098 Use `make-local-hook' instead.
2099 */
2100        (variable))
2101 {
2102   Lisp_Object valcontents;
2103   struct symbol_value_buffer_local *bfwd;
2104
2105   CHECK_SYMBOL (variable);
2106
2107  retry:
2108   verify_ok_for_buffer_local (variable, Qmake_local_variable);
2109
2110   valcontents = XSYMBOL (variable)->value;
2111
2112  retry_2:
2113   if (SYMBOL_VALUE_MAGIC_P (valcontents))
2114     {
2115       switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2116         {
2117         case SYMVAL_LISP_MAGIC:
2118           if (!UNBOUNDP (maybe_call_magic_handler
2119                          (variable, Qmake_local_variable, 0)))
2120             return variable;
2121           valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2122           /* semi-change-o */
2123           goto retry_2;
2124
2125         case SYMVAL_VARALIAS:
2126           variable = follow_varalias_pointers (variable, Qmake_local_variable);
2127           /* presto change-o! */
2128           goto retry;
2129
2130         case SYMVAL_FIXNUM_FORWARD:
2131         case SYMVAL_BOOLEAN_FORWARD:
2132         case SYMVAL_OBJECT_FORWARD:
2133         case SYMVAL_UNBOUND_MARKER:
2134           break;
2135
2136         case SYMVAL_BUFFER_LOCAL:
2137         case SYMVAL_CURRENT_BUFFER_FORWARD:
2138           {
2139             /* Make sure the symbol has a local value in this particular
2140                buffer, by setting it to the same value it already has.  */
2141             Fset (variable, find_symbol_value (variable));
2142             return variable;
2143           }
2144
2145         case SYMVAL_SOME_BUFFER_LOCAL:
2146           {
2147             if (!NILP (buffer_local_alist_element (current_buffer,
2148                                                    variable,
2149                                                    (XSYMBOL_VALUE_BUFFER_LOCAL
2150                                                     (valcontents)))))
2151               goto already_local_to_current_buffer;
2152             else
2153               goto already_local_to_some_other_buffer;
2154           }
2155
2156         default:
2157           abort ();
2158         }
2159     }
2160
2161   /* Make sure variable is set up to hold per-buffer values */
2162   bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
2163                               lrecord_symbol_value_buffer_local);
2164   bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2165
2166   bfwd->current_buffer = Qnil;
2167   bfwd->current_alist_element = Qnil;
2168   bfwd->current_value = valcontents;
2169   /* passing 0 is OK because this should never be a
2170      SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2171      variable. */
2172   bfwd->default_value = do_symval_forwarding (valcontents, 0, 0);
2173
2174 #if 0
2175   if (UNBOUNDP (bfwd->default_value))
2176     bfwd->default_value = Qnil; /* Yuck! */
2177 #endif
2178
2179   XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
2180   *value_slot_past_magic (variable) = valcontents;
2181
2182  already_local_to_some_other_buffer:
2183
2184   /* Make sure this buffer has its own value of variable */
2185   bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2186
2187   if (UNBOUNDP (bfwd->default_value))
2188     {
2189       /* If default value is unbound, set local value to nil. */
2190       XSETBUFFER (bfwd->current_buffer, current_buffer);
2191       bfwd->current_alist_element = Fcons (variable, Qnil);
2192       current_buffer->local_var_alist =
2193         Fcons (bfwd->current_alist_element, current_buffer->local_var_alist);
2194       store_symval_forwarding (variable, bfwd->current_value, Qnil);
2195       return variable;
2196     }
2197
2198   current_buffer->local_var_alist
2199     = Fcons (Fcons (variable, bfwd->default_value),
2200              current_buffer->local_var_alist);
2201
2202   /* Make sure symbol does not think it is set up for this buffer;
2203      force it to look once again for this buffer's value */
2204   if (!NILP (bfwd->current_buffer) &&
2205       current_buffer == XBUFFER (bfwd->current_buffer))
2206     bfwd->current_buffer = Qnil;
2207
2208  already_local_to_current_buffer:
2209
2210   /* If the symbol forwards into a C variable, then swap in the
2211      variable for this buffer immediately.  If C code modifies the
2212      variable before we swap in, then that new value will clobber the
2213      default value the next time we swap.  */
2214   bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2215   if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value))
2216     {
2217       switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value))
2218         {
2219         case SYMVAL_FIXNUM_FORWARD:
2220         case SYMVAL_BOOLEAN_FORWARD:
2221         case SYMVAL_OBJECT_FORWARD:
2222         case SYMVAL_DEFAULT_BUFFER_FORWARD:
2223           set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2224           break;
2225
2226         case SYMVAL_UNBOUND_MARKER:
2227         case SYMVAL_CURRENT_BUFFER_FORWARD:
2228           break;
2229
2230         default:
2231           abort ();
2232         }
2233     }
2234
2235   return variable;
2236 }
2237
2238 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1,
2239        "vKill Local Variable: ", /*
2240 Make VARIABLE no longer have a separate value in the current buffer.
2241 From now on the default value will apply in this buffer.
2242 */
2243        (variable))
2244 {
2245   Lisp_Object valcontents;
2246
2247   CHECK_SYMBOL (variable);
2248
2249  retry:
2250   valcontents = XSYMBOL (variable)->value;
2251
2252  retry_2:
2253   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2254     return variable;
2255
2256   switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2257     {
2258     case SYMVAL_LISP_MAGIC:
2259       if (!UNBOUNDP (maybe_call_magic_handler
2260                      (variable, Qkill_local_variable, 0)))
2261         return variable;
2262       valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2263       /* semi-change-o */
2264       goto retry_2;
2265
2266     case SYMVAL_VARALIAS:
2267       variable = follow_varalias_pointers (variable, Qkill_local_variable);
2268       /* presto change-o! */
2269       goto retry;
2270
2271     case SYMVAL_CURRENT_BUFFER_FORWARD:
2272       {
2273         CONST struct symbol_value_forward *fwd
2274           = XSYMBOL_VALUE_FORWARD (valcontents);
2275         int offset = ((char *) symbol_value_forward_forward (fwd)
2276                                - (char *) &buffer_local_flags);
2277         int mask =
2278           XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2279
2280         if (mask > 0)
2281           {
2282             int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2283                              Lisp_Object in_object, int flags) =
2284                                symbol_value_forward_magicfun (fwd);
2285             Lisp_Object oldval = * (Lisp_Object *)
2286               (offset + (char *) XBUFFER (Vbuffer_defaults));
2287             if (magicfun)
2288               (magicfun) (variable, &oldval, make_buffer (current_buffer), 0);
2289             *(Lisp_Object *) (offset + (char *) current_buffer)
2290               = oldval;
2291             current_buffer->local_var_flags &= ~mask;
2292           }
2293         return variable;
2294       }
2295
2296     case SYMVAL_BUFFER_LOCAL:
2297     case SYMVAL_SOME_BUFFER_LOCAL:
2298       {
2299         /* Get rid of this buffer's alist element, if any */
2300         struct symbol_value_buffer_local *bfwd
2301           = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2302         Lisp_Object alist = current_buffer->local_var_alist;
2303         Lisp_Object alist_element
2304           = buffer_local_alist_element (current_buffer, variable, bfwd);
2305
2306         if (!NILP (alist_element))
2307           current_buffer->local_var_alist = Fdelq (alist_element, alist);
2308
2309         /* Make sure symbol does not think it is set up for this buffer;
2310            force it to look once again for this buffer's value */
2311         if (!NILP (bfwd->current_buffer) &&
2312             current_buffer == XBUFFER (bfwd->current_buffer))
2313           bfwd->current_buffer = Qnil;
2314
2315         /* We just changed the value in the current_buffer.  If this
2316            variable forwards to a C variable, we need to change the
2317            value of the C variable.  set_up_buffer_local_cache()
2318            will do this.  It doesn't hurt to do it always,
2319            so just go ahead and do that. */
2320         set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2321       }
2322       return variable;
2323
2324     default:
2325       return variable;
2326     }
2327   RETURN_NOT_REACHED(Qnil)      /* suppress compiler warning */
2328 }
2329
2330
2331 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2332        "vKill Console Local Variable: ", /*
2333 Make VARIABLE no longer have a separate value in the selected console.
2334 From now on the default value will apply in this console.
2335 */
2336        (variable))
2337 {
2338   Lisp_Object valcontents;
2339
2340   CHECK_SYMBOL (variable);
2341
2342  retry:
2343   valcontents = XSYMBOL (variable)->value;
2344
2345  retry_2:
2346   if (!SYMBOL_VALUE_MAGIC_P (valcontents))
2347     return variable;
2348
2349   switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2350     {
2351     case SYMVAL_LISP_MAGIC:
2352       if (!UNBOUNDP (maybe_call_magic_handler
2353                      (variable, Qkill_console_local_variable, 0)))
2354         return variable;
2355       valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2356       /* semi-change-o */
2357       goto retry_2;
2358
2359     case SYMVAL_VARALIAS:
2360       variable = follow_varalias_pointers (variable,
2361                                            Qkill_console_local_variable);
2362       /* presto change-o! */
2363       goto retry;
2364
2365     case SYMVAL_SELECTED_CONSOLE_FORWARD:
2366       {
2367         CONST struct symbol_value_forward *fwd
2368           = XSYMBOL_VALUE_FORWARD (valcontents);
2369         int offset = ((char *) symbol_value_forward_forward (fwd)
2370                                - (char *) &console_local_flags);
2371         int mask =
2372           XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2373
2374         if (mask > 0)
2375           {
2376             int (*magicfun) (Lisp_Object sym, Lisp_Object *val,
2377                              Lisp_Object in_object, int flags) =
2378                                symbol_value_forward_magicfun (fwd);
2379             Lisp_Object oldval = * (Lisp_Object *)
2380               (offset + (char *) XCONSOLE (Vconsole_defaults));
2381             if (magicfun)
2382               (magicfun) (variable, &oldval, Vselected_console, 0);
2383             *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console))
2384               = oldval;
2385             XCONSOLE (Vselected_console)->local_var_flags &= ~mask;
2386           }
2387         return variable;
2388       }
2389
2390     default:
2391       return variable;
2392     }
2393   RETURN_NOT_REACHED(Qnil)      /* suppress compiler warning */
2394 }
2395
2396 /* Used by specbind to determine what effects it might have.  Returns:
2397  *   0 if symbol isn't buffer-local, and wouldn't be after it is set
2398  *  <0 if symbol isn't presently buffer-local, but set would make it so
2399  *  >0 if symbol is presently buffer-local
2400  */
2401 int
2402 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer)
2403 {
2404   Lisp_Object valcontents;
2405
2406  retry:
2407   valcontents = XSYMBOL (symbol)->value;
2408
2409  retry_2:
2410   if (SYMBOL_VALUE_MAGIC_P (valcontents))
2411     {
2412       switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2413         {
2414         case SYMVAL_LISP_MAGIC:
2415           /* #### kludge */
2416           valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2417           /* semi-change-o */
2418           goto retry_2;
2419
2420         case SYMVAL_VARALIAS:
2421           symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */);
2422           /* presto change-o! */
2423           goto retry;
2424
2425         case SYMVAL_CURRENT_BUFFER_FORWARD:
2426           {
2427             CONST struct symbol_value_forward *fwd
2428               = XSYMBOL_VALUE_FORWARD (valcontents);
2429             int mask = XINT (*((Lisp_Object *)
2430                                symbol_value_forward_forward (fwd)));
2431             if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
2432               /* Already buffer-local */
2433               return 1;
2434             else
2435               /* Would be buffer-local after set */
2436               return -1;
2437           }
2438         case SYMVAL_BUFFER_LOCAL:
2439         case SYMVAL_SOME_BUFFER_LOCAL:
2440           {
2441             struct symbol_value_buffer_local *bfwd
2442               = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
2443             if (buffer
2444                 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd)))
2445               return 1;
2446             else
2447               /* Automatically becomes local when set */
2448               return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0;
2449           }
2450         default:
2451           return 0;
2452         }
2453     }
2454   return 0;
2455 }
2456
2457
2458 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /*
2459 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2460 */
2461        (symbol, buffer, unbound_value))
2462 {
2463   Lisp_Object value;
2464   CHECK_SYMBOL (symbol);
2465   CHECK_BUFFER (buffer);
2466   value = symbol_value_in_buffer (symbol, buffer);
2467   if (UNBOUNDP (value))
2468     return unbound_value;
2469   else
2470     return value;
2471 }
2472
2473 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /*
2474 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2475 */
2476        (symbol, console, unbound_value))
2477 {
2478   Lisp_Object value;
2479   CHECK_SYMBOL (symbol);
2480   CHECK_CONSOLE (console);
2481   value = symbol_value_in_console (symbol, console);
2482   if (UNBOUNDP (value))
2483     return unbound_value;
2484   else
2485     return value;
2486 }
2487
2488 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /*
2489 If SYM is a built-in variable, return info about this; else return nil.
2490 The returned info will be a symbol, one of
2491
2492 `object'                A simple built-in variable.
2493 `const-object'          Same, but cannot be set.
2494 `integer'               A built-in integer variable.
2495 `const-integer'         Same, but cannot be set.
2496 `boolean'               A built-in boolean variable.
2497 `const-boolean'         Same, but cannot be set.
2498 `const-specifier'       Always contains a specifier; e.g. `has-modeline-p'.
2499 `current-buffer'        A built-in buffer-local variable.
2500 `const-current-buffer'  Same, but cannot be set.
2501 `default-buffer'        Forwards to the default value of a built-in
2502                         buffer-local variable.
2503 `selected-console'      A built-in console-local variable.
2504 `const-selected-console' Same, but cannot be set.
2505 `default-console'       Forwards to the default value of a built-in
2506                         console-local variable.
2507 */
2508        (sym))
2509 {
2510   REGISTER Lisp_Object valcontents;
2511
2512   CHECK_SYMBOL (sym);
2513
2514  retry:
2515   valcontents = XSYMBOL (sym)->value;
2516  retry_2:
2517
2518   if (SYMBOL_VALUE_MAGIC_P (valcontents))
2519     {
2520       switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
2521         {
2522         case SYMVAL_LISP_MAGIC:
2523           valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
2524           /* semi-change-o */
2525           goto retry_2;
2526
2527         case SYMVAL_VARALIAS:
2528           sym = follow_varalias_pointers (sym, Qt);
2529           /* presto change-o! */
2530           goto retry;
2531
2532         case SYMVAL_BUFFER_LOCAL:
2533         case SYMVAL_SOME_BUFFER_LOCAL:
2534           valcontents =
2535             XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value;
2536           /* semi-change-o */
2537           goto retry_2;
2538
2539         case SYMVAL_FIXNUM_FORWARD:
2540           return Qinteger;
2541
2542         case SYMVAL_CONST_FIXNUM_FORWARD:
2543           return Qconst_integer;
2544
2545         case SYMVAL_BOOLEAN_FORWARD:
2546           return Qboolean;
2547
2548         case SYMVAL_CONST_BOOLEAN_FORWARD:
2549           return Qconst_boolean;
2550
2551         case SYMVAL_OBJECT_FORWARD:
2552           return Qobject;
2553
2554         case SYMVAL_CONST_OBJECT_FORWARD:
2555           return Qconst_object;
2556
2557         case SYMVAL_CONST_SPECIFIER_FORWARD:
2558           return Qconst_specifier;
2559
2560         case SYMVAL_DEFAULT_BUFFER_FORWARD:
2561           return Qdefault_buffer;
2562
2563         case SYMVAL_CURRENT_BUFFER_FORWARD:
2564           return Qcurrent_buffer;
2565
2566         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2567           return Qconst_current_buffer;
2568
2569         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2570           return Qdefault_console;
2571
2572         case SYMVAL_SELECTED_CONSOLE_FORWARD:
2573           return Qselected_console;
2574
2575         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2576           return Qconst_selected_console;
2577
2578         case SYMVAL_UNBOUND_MARKER:
2579           return Qnil;
2580
2581         default:
2582           abort ();
2583         }
2584     }
2585
2586   return Qnil;
2587 }
2588
2589
2590 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /*
2591 Return t if SYMBOL's value is local to BUFFER.
2592 If optional third arg AFTER-SET is true, return t if SYMBOL would be
2593 buffer-local after it is set, regardless of whether it is so presently.
2594 A nil value for BUFFER is *not* the same as (current-buffer), but means
2595 "no buffer".  Specifically:
2596
2597 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
2598    the variable is one of the special built-in variables that is always
2599    buffer-local. (This includes `buffer-file-name', `buffer-read-only',
2600    `buffer-undo-list', and others.)
2601
2602 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
2603    the variable has had `make-variable-buffer-local' applied to it.
2604 */
2605        (symbol, buffer, after_set))
2606 {
2607   int local_info;
2608
2609   CHECK_SYMBOL (symbol);
2610   if (!NILP (buffer))
2611     {
2612       buffer = get_buffer (buffer, 1);
2613       local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer));
2614     }
2615   else
2616     {
2617       local_info = symbol_value_buffer_local_info (symbol, 0);
2618     }
2619
2620   if (NILP (after_set))
2621     return local_info > 0 ? Qt : Qnil;
2622   else
2623     return local_info != 0 ? Qt : Qnil;
2624 }
2625 \f
2626
2627 /*
2628 I've gone ahead and partially implemented this because it's
2629 super-useful for dealing with the compatibility problems in supporting
2630 the old pointer-shape variables, and preventing people from `setq'ing
2631 the new variables.  Any other way of handling this problem is way
2632 ugly, likely to be slow, and generally not something I want to waste
2633 my time worrying about.
2634
2635 The interface and/or function name is sure to change before this
2636 gets into its final form.  I currently like the way everything is
2637 set up and it has all the features I want it to have, except for
2638 one: I really want to be able to have multiple nested handlers,
2639 to implement an `advice'-like capabiility.  This would allow,
2640 for example, a clean way of implementing `debug-if-set' or
2641 `debug-if-referenced' and such.
2642
2643 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
2644 ************************************************************
2645 **Only** the `set-value', `make-unbound', and `make-local'
2646 handler types are currently implemented.  Implementing the
2647 get-value and bound-predicate handlers is somewhat tricky
2648 because there are lots of subfunctions (e.g. find_symbol_value()).
2649 find_symbol_value(), in fact, is called from outside of
2650 this module.  You'd have to have it do this:
2651
2652 -- check for a `bound-predicate' handler, call that if so;
2653    if it returns nil, return Qunbound
2654 -- check for a `get-value' handler and call it and return
2655    that value
2656
2657 It gets even trickier when you have to deal with
2658 sub-subfunctions like find_symbol_value_1(), and esp.
2659 when you have to properly handle variable aliases, which
2660 can lead to lots of tricky situations.  So I've just
2661 punted on this, since the interface isn't officially
2662 exported and we can get by with just a `set-value'
2663 handler.
2664
2665 Actions in unimplemented handler types will correctly
2666 ignore any handlers, and will not fuck anything up or
2667 go awry.
2668
2669 WARNING WARNING: If you do go and implement another
2670 type of handler, make *sure* to change
2671 would_be_magic_handled() so it knows about this,
2672 or dire things could result.
2673 ************************************************************
2674 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
2675
2676 Real documentation is as follows.
2677
2678 Set a magic handler for VARIABLE.
2679 This allows you to specify arbitrary behavior that results from
2680 accessing or setting a variable.  For example, retrieving the
2681 variable's value might actually retrieve the first element off of
2682 a list stored in another variable, and setting the variable's value
2683 might add an element to the front of that list. (This is how the
2684 obsolete variable `unread-command-event' is implemented.)
2685
2686 In general it is NOT good programming practice to use magic variables
2687 in a new package that you are designing.  If you feel the need to
2688 do this, it's almost certainly a sign that you should be using a
2689 function instead of a variable.  This facility is provided to allow
2690 a package to support obsolete variables and provide compatibility
2691 with similar packages with different variable names and semantics.
2692 By using magic handlers, you can cleanly provide obsoleteness and
2693 compatibility support and separate this support from the core
2694 routines in a package.
2695
2696 VARIABLE should be a symbol naming the variable for which the
2697 magic behavior is provided.  HANDLER-TYPE is a symbol specifying
2698 which behavior is being controlled, and HANDLER is the function
2699 that will be called to control this behavior.  HARG is a
2700 value that will be passed to HANDLER but is otherwise
2701 uninterpreted.  KEEP-EXISTING specifies what to do with existing
2702 handlers of the same type; nil means "erase them all", t means
2703 "keep them but insert at the beginning", the list (t) means
2704 "keep them but insert at the end", a function means "keep
2705 them but insert before the specified function", a list containing
2706 a function means "keep them but insert after the specified
2707 function".
2708
2709 You can specify magic behavior for any type of variable at all,
2710 and for any handler types that are unspecified, the standard
2711 behavior applies.  This allows you, for example, to use
2712 `defvaralias' in conjunction with this function. (For that
2713 matter, `defvaralias' could be implemented using this function.)
2714
2715 The behaviors that can be specified in HANDLER-TYPE are
2716
2717 get-value               (SYM ARGS FUN HARG HANDLERS)
2718     This means that one of the functions `symbol-value',
2719     `default-value', `symbol-value-in-buffer', or
2720     `symbol-value-in-console' was called on SYM.
2721
2722 set-value               (SYM ARGS FUN HARG HANDLERS)
2723     This means that one of the functions `set' or `set-default'
2724     was called on SYM.
2725
2726 bound-predicate         (SYM ARGS FUN HARG HANDLERS)
2727     This means that one of the functions `boundp', `globally-boundp',
2728     or `default-boundp' was called on SYM.
2729
2730 make-unbound            (SYM ARGS FUN HARG HANDLERS)
2731     This means that the function `makunbound' was called on SYM.
2732
2733 local-predicate         (SYM ARGS FUN HARG HANDLERS)
2734     This means that the function `local-variable-p' was called
2735     on SYM.
2736
2737 make-local              (SYM ARGS FUN HARG HANDLERS)
2738     This means that one of the functions `make-local-variable',
2739     `make-variable-buffer-local', `kill-local-variable',
2740     or `kill-console-local-variable' was called on SYM.
2741
2742 The meanings of the arguments are as follows:
2743
2744    SYM is the symbol on which the function was called, and is always
2745    the first argument to the function.
2746
2747    ARGS are the remaining arguments in the original call (i.e. all
2748    but the first).  In the case of `set-value' in particular,
2749    the first element of ARGS is the value to which the variable
2750    is being set.  In some cases, ARGS is sanitized from what was
2751    actually given.  For example, whenever `nil' is passed to an
2752    argument and it means `current-buffer', the current buffer is
2753    substituted instead.
2754
2755    FUN is a symbol indicating which function is being called.
2756    For many of the functions, you can determine the corresponding
2757    function of a different class using
2758    `symbol-function-corresponding-function'.
2759
2760    HARG is the argument that was given in the call
2761    to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
2762
2763    HANDLERS is a structure containing the remaining handlers
2764    for the variable; to call one of them, use
2765    `chain-to-symbol-value-handler'.
2766
2767 NOTE: You may *not* modify the list in ARGS, and if you want to
2768 keep it around after the handler function exits, you must make
2769 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
2770 */
2771
2772 static enum lisp_magic_handler
2773 decode_magic_handler_type (Lisp_Object symbol)
2774 {
2775   if (EQ (symbol, Qget_value))       return MAGIC_HANDLER_GET_VALUE;
2776   if (EQ (symbol, Qset_value))       return MAGIC_HANDLER_SET_VALUE;
2777   if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE;
2778   if (EQ (symbol, Qmake_unbound))    return MAGIC_HANDLER_MAKE_UNBOUND;
2779   if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE;
2780   if (EQ (symbol, Qmake_local))      return MAGIC_HANDLER_MAKE_LOCAL;
2781
2782   signal_simple_error ("Unrecognized symbol value handler type", symbol);
2783   abort ();
2784   return MAGIC_HANDLER_MAX;
2785 }
2786
2787 static enum lisp_magic_handler
2788 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found)
2789 {
2790   if (EQ (funsym, Qsymbol_value)
2791       || EQ (funsym, Qdefault_value)
2792       || EQ (funsym, Qsymbol_value_in_buffer)
2793       || EQ (funsym, Qsymbol_value_in_console))
2794     return MAGIC_HANDLER_GET_VALUE;
2795
2796   if (EQ (funsym, Qset)
2797       || EQ (funsym, Qset_default))
2798     return MAGIC_HANDLER_SET_VALUE;
2799
2800   if (EQ (funsym, Qboundp)
2801       || EQ (funsym, Qglobally_boundp)
2802       || EQ (funsym, Qdefault_boundp))
2803     return MAGIC_HANDLER_BOUND_PREDICATE;
2804
2805   if (EQ (funsym, Qmakunbound))
2806     return MAGIC_HANDLER_MAKE_UNBOUND;
2807
2808   if (EQ (funsym, Qlocal_variable_p))
2809     return MAGIC_HANDLER_LOCAL_PREDICATE;
2810
2811   if (EQ (funsym, Qmake_variable_buffer_local)
2812       || EQ (funsym, Qmake_local_variable))
2813     return MAGIC_HANDLER_MAKE_LOCAL;
2814
2815   if (abort_if_not_found)
2816     abort ();
2817   signal_simple_error ("Unrecognized symbol-value function", funsym);
2818   return MAGIC_HANDLER_MAX;
2819 }
2820
2821 static int
2822 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym)
2823 {
2824   /* does not take into account variable aliasing. */
2825   Lisp_Object valcontents = XSYMBOL (sym)->value;
2826   enum lisp_magic_handler slot;
2827
2828   if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2829     return 0;
2830   slot = handler_type_from_function_symbol (funsym, 1);
2831   if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND
2832       && slot != MAGIC_HANDLER_MAKE_LOCAL)
2833     /* #### temporary kludge because we haven't implemented
2834        lisp-magic variables completely */
2835     return 0;
2836   return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]);
2837 }
2838
2839 static Lisp_Object
2840 fetch_value_maybe_past_magic (Lisp_Object sym,
2841                               Lisp_Object follow_past_lisp_magic)
2842 {
2843   Lisp_Object value = XSYMBOL (sym)->value;
2844   if (SYMBOL_VALUE_LISP_MAGIC_P (value)
2845       && (EQ (follow_past_lisp_magic, Qt)
2846           || (!NILP (follow_past_lisp_magic)
2847               && !would_be_magic_handled (sym, follow_past_lisp_magic))))
2848     value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed;
2849   return value;
2850 }
2851
2852 static Lisp_Object *
2853 value_slot_past_magic (Lisp_Object sym)
2854 {
2855   Lisp_Object *store_pointer = &XSYMBOL (sym)->value;
2856
2857   if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer))
2858     store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed;
2859   return store_pointer;
2860 }
2861
2862 static Lisp_Object
2863 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
2864 {
2865   va_list vargs;
2866   Lisp_Object args[20]; /* should be enough ... */
2867   int i;
2868   enum lisp_magic_handler htype;
2869   Lisp_Object legerdemain;
2870   struct symbol_value_lisp_magic *bfwd;
2871
2872   assert (nargs >= 0 && nargs < 20);
2873   legerdemain = XSYMBOL (sym)->value;
2874   assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2875   bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2876
2877   va_start (vargs, nargs);
2878   for (i = 0; i < nargs; i++)
2879     args[i] = va_arg (vargs, Lisp_Object);
2880   va_end (vargs);
2881
2882   htype = handler_type_from_function_symbol (funsym, 1);
2883   if (NILP (bfwd->handler[htype]))
2884     return Qunbound;
2885   /* #### should be reusing the arglist, not always consing anew.
2886      Repeated handler invocations should not cause repeated consing.
2887      Doesn't matter for now, because this is just a quick implementation
2888      for obsolescence support. */
2889   return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym,
2890                 bfwd->harg[htype], Qnil);
2891 }
2892
2893 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler,
2894        3, 5, 0, /*
2895 Don't you dare use this.
2896 If you do, suffer the wrath of Ben, who is likely to rename
2897 this function (or change the semantics of its arguments) without
2898 pity, thereby invalidating your code.
2899 */
2900        (variable, handler_type, handler, harg, keep_existing))
2901 {
2902   Lisp_Object valcontents;
2903   struct symbol_value_lisp_magic *bfwd;
2904   enum lisp_magic_handler htype;
2905   int i;
2906
2907   /* #### WARNING, only some handler types are implemented.  See above.
2908      Actions of other types will ignore a handler if it's there.
2909
2910      #### Also, `chain-to-symbol-value-handler' and
2911      `symbol-function-corresponding-function' are not implemented. */
2912   CHECK_SYMBOL (variable);
2913   CHECK_SYMBOL (handler_type);
2914   htype = decode_magic_handler_type (handler_type);
2915   valcontents = XSYMBOL (variable)->value;
2916   if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
2917     {
2918       bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
2919                                   lrecord_symbol_value_lisp_magic);
2920       bfwd->magic.type = SYMVAL_LISP_MAGIC;
2921       for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2922         {
2923           bfwd->handler[i] = Qnil;
2924           bfwd->harg[i] = Qnil;
2925         }
2926       bfwd->shadowed = valcontents;
2927       XSETSYMBOL_VALUE_MAGIC (XSYMBOL (variable)->value, bfwd);
2928     }
2929   else
2930     bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents);
2931   bfwd->handler[htype] = handler;
2932   bfwd->harg[htype] = harg;
2933
2934   for (i = 0; i < MAGIC_HANDLER_MAX; i++)
2935     if (!NILP (bfwd->handler[i]))
2936       break;
2937
2938   if (i == MAGIC_HANDLER_MAX)
2939     /* there are no remaining handlers, so remove the structure. */
2940     XSYMBOL (variable)->value = bfwd->shadowed;
2941
2942   return Qnil;
2943 }
2944
2945 \f
2946 /* functions for working with variable aliases.  */
2947
2948 /* Follow the chain of variable aliases for OBJECT.  Return the
2949    resulting symbol, whose value cell is guaranteed not to be a
2950    symbol-value-varalias.
2951
2952    Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
2953    If FUNSYM is t, always follow in such a case.  If FUNSYM is nil,
2954    never follow; stop right there.  Otherwise FUNSYM should be a
2955    recognized symbol-value function symbol; this means, follow
2956    unless there is a special handler for the named function.
2957
2958    OK, there is at least one reason why it's necessary for
2959    FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
2960    can always be sure to catch cyclic variable aliasing.  If we never
2961    follow past Lisp magic, then if the following is done:
2962
2963    (defvaralias 'a 'b)
2964    add some magic behavior to a, but not a "get-value" handler
2965    (defvaralias 'b 'a)
2966
2967    then an attempt to retrieve a's or b's value would cause infinite
2968    looping in `symbol-value'.
2969
2970    We (of course) can't always follow past Lisp magic, because then
2971    we make any variable that is lisp-magic -> varalias behave as if
2972    the lisp-magic is not present at all.
2973  */
2974
2975 static Lisp_Object
2976 follow_varalias_pointers (Lisp_Object object,
2977                           Lisp_Object follow_past_lisp_magic)
2978 {
2979   Lisp_Object tortoise = object;
2980   Lisp_Object hare = object;
2981
2982   /* quick out just in case */
2983   if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (object)->value))
2984     return object;
2985
2986   /* based off of indirect_function() */
2987   for (;;)
2988     {
2989       Lisp_Object value;
2990
2991       value = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic);
2992       if (!SYMBOL_VALUE_VARALIAS_P (value))
2993         break;
2994       hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (value));
2995       value = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic);
2996       if (!SYMBOL_VALUE_VARALIAS_P (value))
2997         break;
2998       hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (value));
2999
3000       value = fetch_value_maybe_past_magic (tortoise, follow_past_lisp_magic);
3001       tortoise = symbol_value_varalias_aliasee
3002         (XSYMBOL_VALUE_VARALIAS (value));
3003
3004       if (EQ (hare, tortoise))
3005         return Fsignal (Qcyclic_variable_indirection, list1 (object));
3006     }
3007
3008   return hare;
3009 }
3010
3011 DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
3012 Define a variable as an alias for another variable.
3013 Thenceforth, any operations performed on VARIABLE will actually be
3014 performed on ALIAS.  Both VARIABLE and ALIAS should be symbols.
3015 If ALIAS is nil, remove any aliases for VARIABLE.
3016 ALIAS can itself be aliased, and the chain of variable aliases
3017 will be followed appropriately.
3018 If VARIABLE already has a value, this value will be shadowed
3019 until the alias is removed, at which point it will be restored.
3020 Currently VARIABLE cannot be a built-in variable, a variable that
3021 has a buffer-local value in any buffer, or the symbols nil or t.
3022 \(ALIAS, however, can be any type of variable.)
3023 */
3024        (variable, alias))
3025 {
3026   struct symbol_value_varalias *bfwd;
3027   Lisp_Object valcontents;
3028
3029   CHECK_SYMBOL (variable);
3030   reject_constant_symbols (variable, Qunbound, 0, Qt);
3031
3032   valcontents = XSYMBOL (variable)->value;
3033
3034   if (NILP (alias))
3035     {
3036       if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3037         {
3038           XSYMBOL (variable)->value =
3039             symbol_value_varalias_shadowed
3040               (XSYMBOL_VALUE_VARALIAS (valcontents));
3041         }
3042       return Qnil;
3043     }
3044
3045   CHECK_SYMBOL (alias);
3046   if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3047     {
3048       /* transmogrify */
3049       XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
3050       return Qnil;
3051     }
3052
3053   if (SYMBOL_VALUE_MAGIC_P (valcontents)
3054       && !UNBOUNDP (valcontents))
3055     signal_simple_error ("Variable is magic and cannot be aliased", variable);
3056   reject_constant_symbols (variable, Qunbound, 0, Qt);
3057
3058   bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
3059                               lrecord_symbol_value_varalias);
3060   bfwd->magic.type = SYMVAL_VARALIAS;
3061   bfwd->aliasee = alias;
3062   bfwd->shadowed = valcontents;
3063
3064   XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
3065   XSYMBOL (variable)->value = valcontents;
3066   return Qnil;
3067 }
3068
3069 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
3070 If VARIABLE is aliased to another variable, return that variable.
3071 VARIABLE should be a symbol.  If VARIABLE is not aliased, return nil.
3072 Variable aliases are created with `defvaralias'.  See also
3073 `indirect-variable'.
3074 */
3075        (variable, follow_past_lisp_magic))
3076 {
3077   Lisp_Object valcontents;
3078
3079   CHECK_SYMBOL (variable);
3080   if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3081     {
3082       CHECK_SYMBOL (follow_past_lisp_magic);
3083       handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3084     }
3085
3086   valcontents = fetch_value_maybe_past_magic (variable,
3087                                               follow_past_lisp_magic);
3088
3089   if (SYMBOL_VALUE_VARALIAS_P (valcontents))
3090     return symbol_value_varalias_aliasee
3091       (XSYMBOL_VALUE_VARALIAS (valcontents));
3092   else
3093     return Qnil;
3094 }
3095
3096 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /*
3097 Return the variable at the end of OBJECT's variable-alias chain.
3098 If OBJECT is a symbol, follow all variable aliases and return
3099 the final (non-aliased) symbol.  Variable aliases are created with
3100 the function `defvaralias'.
3101 If OBJECT is not a symbol, just return it.
3102 Signal a cyclic-variable-indirection error if there is a loop in the
3103 variable chain of symbols.
3104 */
3105        (object, follow_past_lisp_magic))
3106 {
3107   if (!SYMBOLP (object))
3108     return object;
3109   if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt))
3110     {
3111       CHECK_SYMBOL (follow_past_lisp_magic);
3112       handler_type_from_function_symbol (follow_past_lisp_magic, 0);
3113     }
3114   return follow_varalias_pointers (object, follow_past_lisp_magic);
3115 }
3116
3117 \f
3118 /************************************************************************/
3119 /*                            initialization                            */
3120 /************************************************************************/
3121
3122 /* A dumped XEmacs image has a lot more than 1511 symbols.  Last
3123    estimate was that there were actually around 6300.  So let's try
3124    making this bigger and see if we get better hashing behavior. */
3125 #define OBARRAY_SIZE 16411
3126
3127 #ifndef Qzero
3128 Lisp_Object Qzero;
3129 #endif
3130 #ifndef Qnull_pointer
3131 Lisp_Object Qnull_pointer;
3132 #endif
3133
3134 /* some losing systems can't have static vars at function scope... */
3135 static struct symbol_value_magic guts_of_unbound_marker =
3136   { { symbol_value_forward_lheader_initializer, 0, 69},
3137     SYMVAL_UNBOUND_MARKER };
3138
3139 Lisp_Object Vpure_uninterned_symbol_table;
3140
3141 void
3142 init_symbols_once_early (void)
3143 {
3144 #ifndef Qzero
3145   Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3146 #endif
3147
3148 #ifndef Qnull_pointer
3149   /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3150      so the following is a actually a no-op.  */
3151   XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
3152 #endif
3153
3154   /* see comment in Fpurecopy() */
3155   Vpure_uninterned_symbol_table =
3156     make_lisp_hashtable (50, HASHTABLE_NONWEAK, HASHTABLE_EQ);
3157   staticpro (&Vpure_uninterned_symbol_table);
3158
3159   Qnil = Fmake_symbol (make_pure_pname ((CONST Bufbyte *) "nil", 3, 1));
3160   /* Bootstrapping problem: Qnil isn't set when make_pure_pname is
3161      called the first time. */
3162   XSYMBOL (Qnil)->name->plist = Qnil;
3163   XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
3164   XSYMBOL (Qnil)->plist = Qnil;
3165
3166   Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3167   initial_obarray = Vobarray;
3168   staticpro (&initial_obarray);
3169   /* Intern nil in the obarray */
3170   {
3171     int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
3172     XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3173     XSYMBOL (Qnil)->obarray = Qt;
3174   }
3175
3176   {
3177     /* Required to get around a GCC syntax error on certain
3178        architectures */
3179     struct symbol_value_magic *tem = &guts_of_unbound_marker;
3180
3181     XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3182   }
3183   if ((CONST void *) XPNTR (Qunbound) !=
3184       (CONST void *)&guts_of_unbound_marker)
3185     {
3186       /* This might happen on DATA_SEG_BITS machines. */
3187       /* abort (); */
3188       /* Can't represent a pointer to constant C data using a Lisp_Object.
3189          So heap-allocate it. */
3190       struct symbol_value_magic *urk = xnew (struct symbol_value_magic);
3191       memcpy (urk, &guts_of_unbound_marker, sizeof (*urk));
3192       XSETSYMBOL_VALUE_MAGIC (Qunbound, urk);
3193     }
3194
3195   XSYMBOL (Qnil)->function = Qunbound;
3196
3197   defsymbol (&Qt, "t");
3198   XSYMBOL (Qt)->value = Qt;     /* Veritas aetera */
3199   Vquit_flag = Qnil;
3200 }
3201
3202 void
3203 defsymbol (Lisp_Object *location, CONST char *name)
3204 {
3205   *location = Fintern (make_pure_pname ((CONST Bufbyte *) name,
3206                                         strlen (name), 1),
3207                        Qnil);
3208   staticpro (location);
3209 }
3210
3211 void
3212 defkeyword (Lisp_Object *location, CONST char *name)
3213 {
3214   defsymbol (location, name);
3215   Fset (*location, *location);
3216 }
3217
3218 void
3219 defsubr (struct Lisp_Subr *subr)
3220 {
3221   Lisp_Object sym = intern (subr_name (subr));
3222
3223 #ifdef DEBUG_XEMACS
3224   /* Check that nobody spazzed writing a DEFUN. */
3225   assert (subr->min_args >= 0);
3226   assert (subr->min_args <= SUBR_MAX_ARGS);
3227
3228   if (subr->max_args != MANY && subr->max_args != UNEVALLED)
3229     {
3230       /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3231       assert (subr->max_args <= SUBR_MAX_ARGS);
3232       assert (subr->min_args <= subr->max_args);
3233     }
3234
3235   assert (UNBOUNDP (XSYMBOL (sym)->function));
3236 #endif /* DEBUG_XEMACS */
3237
3238   XSETSUBR (XSYMBOL (sym)->function, subr);
3239 }
3240
3241 void
3242 deferror (Lisp_Object *symbol, CONST char *name, CONST char *messuhhj,
3243           Lisp_Object inherits_from)
3244 {
3245   Lisp_Object conds;
3246   defsymbol (symbol, name);
3247
3248   assert (SYMBOLP (inherits_from));
3249   conds = Fget (inherits_from, Qerror_conditions, Qnil);
3250   pure_put (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3251   /* NOT build_translated_string ().  This function is called at load time
3252      and the string needs to get translated at run time.  (This happens
3253      in the function (display-error) in cmdloop.el.) */
3254   pure_put (*symbol, Qerror_message, build_string (messuhhj));
3255 }
3256
3257 void
3258 syms_of_symbols (void)
3259 {
3260   defsymbol (&Qvariable_documentation, "variable-documentation");
3261   defsymbol (&Qvariable_domain, "variable-domain");     /* I18N3 */
3262   defsymbol (&Qad_advice_info, "ad-advice-info");
3263   defsymbol (&Qad_activate, "ad-activate");
3264
3265   defsymbol (&Qget_value, "get-value");
3266   defsymbol (&Qset_value, "set-value");
3267   defsymbol (&Qbound_predicate, "bound-predicate");
3268   defsymbol (&Qmake_unbound, "make-unbound");
3269   defsymbol (&Qlocal_predicate, "local-predicate");
3270   defsymbol (&Qmake_local, "make-local");
3271
3272   defsymbol (&Qboundp, "boundp");
3273   defsymbol (&Qfboundp, "fboundp");
3274   defsymbol (&Qglobally_boundp, "globally-boundp");
3275   defsymbol (&Qmakunbound, "makunbound");
3276   defsymbol (&Qsymbol_value, "symbol-value");
3277   defsymbol (&Qset, "set");
3278   defsymbol (&Qdefault_boundp, "default-boundp");
3279   defsymbol (&Qdefault_value, "default-value");
3280   defsymbol (&Qset_default, "set-default");
3281   defsymbol (&Qmake_variable_buffer_local, "make-variable-buffer-local");
3282   defsymbol (&Qmake_local_variable, "make-local-variable");
3283   defsymbol (&Qkill_local_variable, "kill-local-variable");
3284   defsymbol (&Qkill_console_local_variable, "kill-console-local-variable");
3285   defsymbol (&Qsymbol_value_in_buffer, "symbol-value-in-buffer");
3286   defsymbol (&Qsymbol_value_in_console, "symbol-value-in-console");
3287   defsymbol (&Qlocal_variable_p, "local-variable-p");
3288
3289   defsymbol (&Qconst_integer, "const-integer");
3290   defsymbol (&Qconst_boolean, "const-boolean");
3291   defsymbol (&Qconst_object, "const-object");
3292   defsymbol (&Qconst_specifier, "const-specifier");
3293   defsymbol (&Qdefault_buffer, "default-buffer");
3294   defsymbol (&Qcurrent_buffer, "current-buffer");
3295   defsymbol (&Qconst_current_buffer, "const-current-buffer");
3296   defsymbol (&Qdefault_console, "default-console");
3297   defsymbol (&Qselected_console, "selected-console");
3298   defsymbol (&Qconst_selected_console, "const-selected-console");
3299
3300   DEFSUBR (Fintern);
3301   DEFSUBR (Fintern_soft);
3302   DEFSUBR (Funintern);
3303   DEFSUBR (Fmapatoms);
3304   DEFSUBR (Fapropos_internal);
3305
3306   DEFSUBR (Fsymbol_function);
3307   DEFSUBR (Fsymbol_plist);
3308   DEFSUBR (Fsymbol_name);
3309   DEFSUBR (Fmakunbound);
3310   DEFSUBR (Ffmakunbound);
3311   DEFSUBR (Fboundp);
3312   DEFSUBR (Fglobally_boundp);
3313   DEFSUBR (Ffboundp);
3314   DEFSUBR (Ffset);
3315   DEFSUBR (Fdefine_function);
3316   DEFSUBR (Fsetplist);
3317   DEFSUBR (Fsymbol_value_in_buffer);
3318   DEFSUBR (Fsymbol_value_in_console);
3319   DEFSUBR (Fbuilt_in_variable_type);
3320   DEFSUBR (Fsymbol_value);
3321   DEFSUBR (Fset);
3322   DEFSUBR (Fdefault_boundp);
3323   DEFSUBR (Fdefault_value);
3324   DEFSUBR (Fset_default);
3325   DEFSUBR (Fsetq_default);
3326   DEFSUBR (Fmake_variable_buffer_local);
3327   DEFSUBR (Fmake_local_variable);
3328   DEFSUBR (Fkill_local_variable);
3329   DEFSUBR (Fkill_console_local_variable);
3330   DEFSUBR (Flocal_variable_p);
3331   DEFSUBR (Fdefvaralias);
3332   DEFSUBR (Fvariable_alias);
3333   DEFSUBR (Findirect_variable);
3334   DEFSUBR (Fdontusethis_set_symbol_value_handler);
3335 }
3336
3337 /* Create and initialize a variable whose value is forwarded to C data */
3338 void
3339 defvar_mumble (CONST char *namestring, CONST void *magic, size_t sizeof_magic)
3340 {
3341   Lisp_Object kludge;
3342   Lisp_Object sym = Fintern (make_pure_pname ((CONST Bufbyte *) namestring,
3343                                               strlen (namestring),
3344                                               1),
3345                              Qnil);
3346
3347   /* Check that magic points somewhere we can represent as a Lisp pointer */
3348   XSETOBJ (kludge, Lisp_Type_Record, magic);
3349   if (magic != (CONST void *) XPNTR (kludge))
3350     {
3351       /* This might happen on DATA_SEG_BITS machines. */
3352       /* abort (); */
3353       /* Copy it to somewhere which is representable. */
3354       void *f = xmalloc (sizeof_magic);
3355       memcpy (f, magic, sizeof_magic);
3356       XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, f);
3357     }
3358   else
3359     XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic);
3360 }
3361
3362 void
3363 vars_of_symbols (void)
3364 {
3365   DEFVAR_LISP ("obarray", &Vobarray /*
3366 Symbol table for use by `intern' and `read'.
3367 It is a vector whose length ought to be prime for best results.
3368 The vector's contents don't make sense if examined from Lisp programs;
3369 to find all the symbols in an obarray, use `mapatoms'.
3370 */ );
3371   /* obarray has been initialized long before */
3372 }