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