annotate src/symbols.c @ 826:6728e641994e

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