Mercurial > hg > xemacs-beta
annotate src/symbols.c @ 5353:38e24b8be4ea
Improve the lexical scoping in #'block, #'return-from.
lisp/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
Shadow `block', `return-from' here, we implement them differently
when byte-compiling.
* bytecomp.el (byte-compile-active-blocks): New.
* bytecomp.el (byte-compile-block-1): New.
* bytecomp.el (byte-compile-return-from-1): New.
* bytecomp.el (return-from-1): New.
* bytecomp.el (block-1): New.
These are two aliases that exist to have their own associated
byte-compile functions, which functions implement `block' and
`return-from'.
* cl-extra.el (cl-macroexpand-all):
Fix a bug here when macros in the environment have been compiled.
* cl-macs.el (block):
* cl-macs.el (return):
* cl-macs.el (return-from):
Be more careful about lexical scope in these macros.
* cl.el:
* cl.el ('cl-block-wrapper): Removed.
* cl.el ('cl-block-throw): Removed.
These aren't needed in code generated by this XEmacs. They
shouldn't be needed in code generated by XEmacs 21.4, but if it
turns out the packages do need them, we can put them back.
2011-01-30 Mike Sperber <mike@xemacs.org>
* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
`font-lock-mode' is unset, which can happen in the middle of
`revert-buffer'.
2011-01-23 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete):
* cl-macs.el (delq):
* cl-macs.el (remove):
* cl-macs.el (remq):
Don't use the compiler macro if these functions were given the
wrong number of arguments, as happens in lisp-tests.el.
* cl-seq.el (remove, remq): Removed.
I added these to subr.el, and forgot to remove them from here.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-setq, byte-compile-set):
Remove kludge allowing keywords' values to be set, all the code
that does that is gone.
* cl-compat.el (elt-satisfies-test-p):
* faces.el (set-face-parent):
* faces.el (face-doc-string):
* gtk-font-menu.el:
* gtk-font-menu.el (gtk-reset-device-font-menus):
* msw-font-menu.el:
* msw-font-menu.el (mswindows-reset-device-font-menus):
* package-get.el (package-get-installedp):
* select.el (select-convert-from-image-data):
* sound.el:
* sound.el (load-sound-file):
* x-font-menu.el (x-reset-device-font-menus-core):
Don't quote keywords, they're self-quoting, and the
win from backward-compatibility is sufficiently small now that the
style problem overrides it.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (block, return-from): Require that NAME be a symbol
in these macros, as always documented in the #'block docstring and
as required by Common Lisp.
* descr-text.el (unidata-initialize-unihan-database):
Correct the use of non-symbols in #'block and #'return-from in
this function.
2011-01-15 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
2011-01-11 Aidan Kehoe <kehoea@parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
2011-01-10 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se !
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box):
* list-mode.el (display-completion-list):
These functions used to use cl-parsing-keywords; change them to
use defun* instead, fixing the build. (Not sure what led to me
not including this change in d1b17a33450b!)
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (define-star-compiler-macros):
Make sure the form has ITEM and LIST specified before attempting
to change to calls with explicit tests; necessary for some tests
in lisp-tests.el to compile correctly.
(stable-union, stable-intersection): Add compiler macros for these
functions, in the same way we do for most of the other functions
in cl-seq.el.
2011-01-01 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (dolist, dotimes, do-symbols, macrolet)
(symbol-macrolet):
Define these macros with defmacro* instead of parsing the argument
list by hand, for the sake of style and readability; use backquote
where appropriate, instead of calling #'list and and friends, for
the same reason.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* x-misc.el (device-x-display):
Provide this function, documented in the Lispref for years, but
not existing previously. Thank you Julian Bradfield, thank you
Jeff Mincy.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
For these functions' compiler macros, the optimisation is safe
even if the first and the last arguments have side effects, since
they're only used the once.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
stupidity with local variable names in these functions, when they
weren't prefixed with cl-; go into some more detail in the doc
strings.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
free of side-effects.
(side-effect-and-error-free-fns):
Drop dot, dot-marker from the list.
2010-11-17 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
2010-10-25 Aidan Kehoe <kehoea@parhasard.net>
Add compiler macros and compilation sanity-checking for various
functions that take keywords.
* byte-optimize.el (side-effect-free-fns): #'symbol-value is
side-effect free and not error free.
* bytecomp.el (byte-compile-normal-call): Check keyword argument
lists for sanity; store information about the positions where
keyword arguments start using the new byte-compile-keyword-start
property.
* cl-macs.el (cl-const-expr-val): Take a new optional argument,
cl-not-constant, defaulting to nil, in this function; return it if
the expression is not constant.
(cl-non-fixnum-number-p): Make this into a separate function, we
want to pass it to #'every.
(eql): Use it.
(define-star-compiler-macros): Use the same code to generate the
member*, assoc* and rassoc* compiler macros; special-case some
code in #'add-to-list in subr.el.
(remove, remq): Add compiler macros for these two functions, in
preparation for #'remove being in C.
(define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to
(remove ... :if-not) at compile time, which will be a real win
once the latter is in C.
(define-substitute-if-compiler-macros)
(define-subst-if-compiler-macros): Similarly for these functions.
(delete-duplicates): Change this compiler macro to use
#'plists-equal; if we don't have information about the type of
SEQUENCE at compile time, don't bother attempting to inline the
call, the function will be in C soon enough.
(equalp): Remove an old commented-out compiler macro for this, if
we want to see it it's in version control.
(subst-char-in-string): Transform this to a call to nsubstitute or
nsubstitute, if that is appropriate.
* cl.el (ldiff): Don't call setf here, this makes for a load-time
dependency problem in cl-macs.el
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* term/vt100.el:
Refer to XEmacs, not GNU Emacs, in permissions.
* term/bg-mouse.el:
* term/sup-mouse.el:
Put copyright notice in canonical "Copyright DATE AUTHOR" form.
Refer to XEmacs, not GNU Emacs, in permissions.
* site-load.el:
Add permission boilerplate.
* mule/canna-leim.el:
* alist.el:
Refer to XEmacs, not APEL/this program, in permissions.
* mule/canna-leim.el:
Remove my copyright, I've assigned it to the FSF.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* gtk.el:
* gtk-widget-accessors.el:
* gtk-package.el:
* gtk-marshal.el:
* gtk-compose.el:
* gnome.el:
Add copyright notice based on internal evidence.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* easymenu.el: Add reference to COPYING to permission notice.
* gutter.el:
* gutter-items.el:
* menubar-items.el:
Fix typo "Xmacs" in permissions notice.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* auto-save.el:
* font.el:
* fontconfig.el:
* mule/kinsoku.el:
Add "part of XEmacs" text to permission notice.
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns):
* cl-macs.el (remf, getf):
* cl-extra.el (tailp, cl-set-getf, cl-do-remf):
* cl.el (ldiff, endp):
Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
add circularity checking for the first two.
#'cl-set-getf and #'cl-do-remf were Lisp implementations of
#'plist-put and #'plist-remprop; change the names to aliases,
changes the macros that use them to using #'plist-put and
#'plist-remprop directly.
2010-10-12 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):
Create both these abbrev tables using the usual
#'define-abbrev-table calls, rather than attempting to
special-case them.
* cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is
being loaded interpreted. Previously other, later files would
redundantly call (load "cl-macs") when interpreted, it's more
reasonable to do it here, once.
* cmdloop.el (read-quoted-char-radix): Use defcustom here, we
don't have any dump-order dependencies that would prevent that.
* custom.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling, rely on cl-extra.el in the
former case and the appropriate entry in bytecomp-load-hook in the
latter. Get rid of custom-declare-variable-list, we have no
dump-time dependencies that would require it.
* faces.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling.
* packages.el: Remove some inaccurate comments.
* post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not
here, now the order of preloaded-file-list has been changed to
make it available.
* subr.el (custom-declare-variable-list): Remove. No need for it.
Also remove a stub define-abbrev-table from this file, given the
current order of preloaded-file-list there's no need for it.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* test-harness.el (Check-Message):
Add an omitted comma here, thank you the buildbot.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
(hash-table-key-value-alist, hash-table-key-value-plist):
Remove some useless #'nreverse calls in these files; our hash
tables have no order, it's not helpful to pretend they do.
* behavior.el (read-behavior):
Do the same in this file, in some code evidently copied from
hash-table.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* info.el (Info-insert-dir):
* format.el (format-deannotate-region):
* files.el (cd, save-buffers-kill-emacs):
Use #'some, #'every and related functions for applying boolean
operations to lists, instead of rolling our own ones that cons and
don't short-circuit.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
* cl-macs.el (the):
Rephrase the docstring, make its implementation when compiling
files a little nicer.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* descr-text.el (unidata-initialize-unicodedata-database)
(unidata-initialize-unihan-database, describe-char-unicode-data)
(describe-char-unicode-data):
Wrap calls to the database functions with (with-fboundp ...),
avoiding byte compile warnings on builds without support for the
database functions.
(describe-char): (reduce #'max ...), not (apply #'max ...), no
need to cons needlessly.
(describe-char): Remove a redundant lambda wrapping
#'extent-properties.
(describe-char-unicode-data): Call #'nsubst when replacing "" with
nil in the result of #'split-string, instead of consing inside
mapcar.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* x-faces.el (x-available-font-sizes):
* specifier.el (let-specifier):
* package-ui.el (pui-add-required-packages):
* msw-faces.el (mswindows-available-font-sizes):
* modeline.el (modeline-minor-mode-menu):
* minibuf.el (minibuf-directory-files):
Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
When these functions are handed more than two arguments, and those
arguments have no side effects, transform to a series of two
argument calls, avoiding funcall in the byte-compiled code.
* mule/mule-cmds.el (finish-set-language-environment):
Take advantage of this change in a function called 256 times at
startup.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-function-form, byte-compile-quote)
(byte-compile-quote-form):
Warn at compile time, and error at runtime, if a (quote ...) or a
(function ...) form attempts to quote more than one object.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
(mapcar ...)) to (mapcan ...); warn about use of the first idiom.
* update-elc.el (do-autoload-commands):
* packages.el (packages-find-package-library-path):
* frame.el (frame-list):
* extents.el (extent-descendants):
* etags.el (buffer-tag-table-files):
* dumped-lisp.el (preloaded-file-list):
* device.el (device-list):
* bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
* bytecomp-runtime.el (eval-when-compile, eval-and-compile):
In passing, mention that these macros also evaluate the body when
interpreted.
tests/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test lexical scope for `block', `return-from'; add a
Known-Bug-Expect-Failure for a contorted example that fails when
byte-compiled.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 07 Feb 2011 12:01:24 +0000 |
| parents | b5561bfd5061 |
| children | 0af042a0c116 |
| rev | line source |
|---|---|
| 428 | 1 /* "intern" and friends -- moved here from lread.c and data.c |
| 2 Copyright (C) 1985-1989, 1992-1994 Free Software Foundation, Inc. | |
|
4940
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
3 Copyright (C) 1995, 2000, 2001, 2002, 2010 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: FSF 19.30. */ | |
| 23 | |
| 24 /* This file has been Mule-ized. */ | |
| 25 | |
| 26 /* NOTE: | |
| 27 | |
| 28 The value cell of a symbol can contain a simple value or one of | |
| 29 various symbol-value-magic objects. Some of these objects can | |
| 30 chain into other kinds of objects. Here is a table of possibilities: | |
| 31 | |
| 32 1a) simple value | |
| 33 1b) Qunbound | |
| 34 1c) symbol-value-forward, excluding Qunbound | |
| 35 2) symbol-value-buffer-local -> 1a or 1b or 1c | |
| 36 3) symbol-value-lisp-magic -> 1a or 1b or 1c | |
| 37 4) symbol-value-lisp-magic -> symbol-value-buffer-local -> 1a or 1b or 1c | |
| 38 5) symbol-value-varalias | |
| 39 6) symbol-value-lisp-magic -> symbol-value-varalias | |
| 40 | |
| 41 The "chain" of a symbol-value-buffer-local is its current_value slot. | |
| 42 | |
| 43 The "chain" of a symbol-value-lisp-magic is its shadowed slot, which | |
| 44 applies for handler types without associated handlers. | |
| 45 | |
| 46 All other fields in all the structures (including the "shadowed" slot | |
| 47 in a symbol-value-varalias) can *only* contain a simple value or Qunbound. | |
| 48 | |
| 49 */ | |
| 50 | |
| 51 /* #### Ugh, though, this file does awful things with symbol-value-magic | |
| 52 objects. This ought to be cleaned up. */ | |
| 53 | |
| 54 #include <config.h> | |
| 55 #include "lisp.h" | |
| 56 | |
|
4921
17362f371cc2
add more byte-code assertions and better failure output
Ben Wing <ben@xemacs.org>
parents:
4905
diff
changeset
|
57 #include "bytecode.h" /* for COMPILED_FUNCTION_ANNOTATION_HACK, |
|
17362f371cc2
add more byte-code assertions and better failure output
Ben Wing <ben@xemacs.org>
parents:
4905
diff
changeset
|
58 defined in bytecode.h and used here. */ |
| 428 | 59 #include "buffer.h" /* for Vbuffer_defaults */ |
| 872 | 60 #include "console-impl.h" |
| 428 | 61 #include "elhash.h" |
| 62 | |
| 63 Lisp_Object Qad_advice_info, Qad_activate; | |
| 64 | |
| 65 Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound; | |
| 66 Lisp_Object Qlocal_predicate, Qmake_local; | |
| 67 | |
| 68 Lisp_Object Qboundp, Qglobally_boundp, Qmakunbound; | |
| 69 Lisp_Object Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value; | |
| 70 Lisp_Object Qset_default, Qsetq_default; | |
| 71 Lisp_Object Qmake_variable_buffer_local, Qmake_local_variable; | |
| 72 Lisp_Object Qkill_local_variable, Qkill_console_local_variable; | |
| 73 Lisp_Object Qsymbol_value_in_buffer, Qsymbol_value_in_console; | |
| 74 Lisp_Object Qlocal_variable_p; | |
| 75 | |
| 76 Lisp_Object Qconst_integer, Qconst_boolean, Qconst_object; | |
| 77 Lisp_Object Qconst_specifier; | |
| 78 Lisp_Object Qdefault_buffer, Qcurrent_buffer, Qconst_current_buffer; | |
| 79 Lisp_Object Qdefault_console, Qselected_console, Qconst_selected_console; | |
| 80 | |
| 81 static Lisp_Object maybe_call_magic_handler (Lisp_Object sym, | |
| 82 Lisp_Object funsym, | |
| 83 int nargs, ...); | |
| 84 static Lisp_Object fetch_value_maybe_past_magic (Lisp_Object sym, | |
| 85 Lisp_Object follow_past_lisp_magic); | |
| 86 static Lisp_Object *value_slot_past_magic (Lisp_Object sym); | |
| 87 static Lisp_Object follow_varalias_pointers (Lisp_Object symbol, | |
| 88 Lisp_Object follow_past_lisp_magic); | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
89 static Lisp_Object map_varalias_chain (Lisp_Object symbol, |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
90 Lisp_Object follow_past_lisp_magic, |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
91 Lisp_Object (*fn) (Lisp_Object arg)); |
| 428 | 92 |
| 93 | |
| 94 static Lisp_Object | |
| 95 mark_symbol (Lisp_Object obj) | |
| 96 { | |
| 440 | 97 Lisp_Symbol *sym = XSYMBOL (obj); |
| 428 | 98 |
| 99 mark_object (sym->value); | |
| 100 mark_object (sym->function); | |
| 793 | 101 mark_object (sym->name); |
| 428 | 102 if (!symbol_next (sym)) |
| 103 return sym->plist; | |
| 104 else | |
| 105 { | |
| 106 mark_object (sym->plist); | |
| 107 /* Mark the rest of the symbols in the obarray hash-chain */ | |
| 108 sym = symbol_next (sym); | |
| 793 | 109 return wrap_symbol (sym); |
| 428 | 110 } |
| 111 } | |
| 112 | |
| 1204 | 113 static const struct memory_description symbol_description[] = { |
| 440 | 114 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, next) }, |
| 115 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, name) }, | |
| 116 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, value) }, | |
| 117 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, function) }, | |
| 118 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, plist) }, | |
| 428 | 119 { XD_END } |
| 120 }; | |
| 121 | |
| 442 | 122 /* Symbol plists are directly accessible, so we need to protect against |
| 123 invalid property list structure */ | |
| 124 | |
| 125 static Lisp_Object | |
| 126 symbol_getprop (Lisp_Object symbol, Lisp_Object property) | |
| 127 { | |
| 128 return external_plist_get (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME); | |
| 129 } | |
| 130 | |
| 131 static int | |
| 132 symbol_putprop (Lisp_Object symbol, Lisp_Object property, Lisp_Object value) | |
| 133 { | |
| 134 external_plist_put (&XSYMBOL (symbol)->plist, property, value, 0, ERROR_ME); | |
| 135 return 1; | |
| 136 } | |
| 137 | |
| 138 static int | |
| 139 symbol_remprop (Lisp_Object symbol, Lisp_Object property) | |
| 140 { | |
| 141 return external_remprop (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME); | |
| 142 } | |
| 143 | |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
144 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("symbol", symbol, |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
145 mark_symbol, print_symbol, |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
146 0, 0, 0, symbol_description, |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
147 Lisp_Symbol); |
| 428 | 148 |
| 149 /**********************************************************************/ | |
| 150 /* Intern */ | |
| 151 /**********************************************************************/ | |
| 152 | |
| 153 /* #### using a vector here is way bogus. Use a hash table instead. */ | |
| 154 | |
| 155 Lisp_Object Vobarray; | |
| 156 | |
| 157 static Lisp_Object initial_obarray; | |
| 158 | |
| 159 /* oblookup stores the bucket number here, for the sake of Funintern. */ | |
| 160 | |
| 161 static int oblookup_last_bucket_number; | |
| 162 | |
| 163 static Lisp_Object | |
| 164 check_obarray (Lisp_Object obarray) | |
| 165 { | |
| 166 while (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0) | |
| 167 { | |
| 168 /* If Vobarray is now invalid, force it to be valid. */ | |
| 169 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray; | |
| 170 | |
| 171 obarray = wrong_type_argument (Qvectorp, obarray); | |
| 172 } | |
| 173 return obarray; | |
| 174 } | |
| 175 | |
| 176 Lisp_Object | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
177 intern_istring (const Ibyte *str) |
| 428 | 178 { |
| 771 | 179 Bytecount len = qxestrlen (str); |
| 428 | 180 Lisp_Object obarray = Vobarray; |
| 181 | |
| 182 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0) | |
| 183 obarray = check_obarray (obarray); | |
| 184 | |
| 185 { | |
| 771 | 186 Lisp_Object tem = oblookup (obarray, str, len); |
| 428 | 187 if (SYMBOLP (tem)) |
| 188 return tem; | |
| 189 } | |
| 190 | |
| 771 | 191 return Fintern (make_string (str, len), obarray); |
| 192 } | |
| 193 | |
| 194 Lisp_Object | |
| 867 | 195 intern (const CIbyte *str) |
| 771 | 196 { |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
197 return intern_istring ((Ibyte *) str); |
| 428 | 198 } |
| 199 | |
| 814 | 200 Lisp_Object |
|
5277
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
201 intern_massaging_name (const CIbyte *str) |
| 814 | 202 { |
| 203 Bytecount len = strlen (str); | |
| 867 | 204 CIbyte *tmp = alloca_extbytes (len + 1); |
| 814 | 205 Bytecount i; |
| 206 strcpy (tmp, str); | |
| 207 for (i = 0; i < len; i++) | |
|
5277
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
208 { |
|
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
209 if (tmp[i] == '_') |
|
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
210 { |
|
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
211 tmp[i] = '-'; |
|
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
212 } |
|
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
213 else if (tmp[i] == 'X') |
|
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
214 { |
|
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
215 tmp[i] = '*'; |
|
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
216 } |
|
d804e621add0
Simplify the API of PARSE_KEYWORDS for callers.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
217 } |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
218 return intern_istring ((Ibyte *) tmp); |
| 814 | 219 } |
| 220 | |
| 428 | 221 DEFUN ("intern", Fintern, 1, 2, 0, /* |
| 222 Return the canonical symbol whose name is STRING. | |
| 223 If there is none, one is created by this function and returned. | |
| 444 | 224 Optional second argument OBARRAY specifies the obarray to use; |
| 225 it defaults to the value of the variable `obarray'. | |
| 428 | 226 */ |
| 227 (string, obarray)) | |
| 228 { | |
| 229 Lisp_Object object, *ptr; | |
| 793 | 230 Lisp_Object symbol; |
| 428 | 231 Bytecount len; |
| 232 | |
| 233 if (NILP (obarray)) obarray = Vobarray; | |
| 234 obarray = check_obarray (obarray); | |
| 235 | |
| 236 CHECK_STRING (string); | |
| 237 | |
| 238 len = XSTRING_LENGTH (string); | |
| 239 object = oblookup (obarray, XSTRING_DATA (string), len); | |
| 240 if (!INTP (object)) | |
| 241 /* Found it */ | |
| 242 return object; | |
| 243 | |
| 244 ptr = &XVECTOR_DATA (obarray)[XINT (object)]; | |
| 245 | |
| 246 object = Fmake_symbol (string); | |
| 793 | 247 symbol = object; |
| 428 | 248 |
| 249 if (SYMBOLP (*ptr)) | |
| 793 | 250 XSYMBOL_NEXT (symbol) = XSYMBOL (*ptr); |
| 428 | 251 else |
| 793 | 252 XSYMBOL_NEXT (symbol) = 0; |
| 428 | 253 *ptr = object; |
| 254 | |
| 826 | 255 if (string_byte (XSYMBOL_NAME (symbol), 0) == ':' && EQ (obarray, Vobarray)) |
| 428 | 256 { |
| 257 /* The LISP way is to put keywords in their own package, but we | |
| 258 don't have packages, so we do something simpler. Someday, | |
| 259 maybe we'll have packages and then this will be reworked. | |
| 260 --Stig. */ | |
| 793 | 261 XSYMBOL_VALUE (symbol) = object; |
| 428 | 262 } |
| 263 | |
| 264 return object; | |
| 265 } | |
| 266 | |
|
4355
a2af1ff1761f
Provide a DEFAULT argument in #'intern-soft.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4337
diff
changeset
|
267 DEFUN ("intern-soft", Fintern_soft, 1, 3, 0, /* |
| 428 | 268 Return the canonical symbol named NAME, or nil if none exists. |
| 269 NAME may be a string or a symbol. If it is a symbol, that exact | |
| 270 symbol is searched for. | |
| 444 | 271 Optional second argument OBARRAY specifies the obarray to use; |
| 272 it defaults to the value of the variable `obarray'. | |
|
4355
a2af1ff1761f
Provide a DEFAULT argument in #'intern-soft.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4337
diff
changeset
|
273 Optional third argument DEFAULT says what Lisp object to return if there is |
|
a2af1ff1761f
Provide a DEFAULT argument in #'intern-soft.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4337
diff
changeset
|
274 no canonical symbol named NAME, and defaults to nil. |
| 428 | 275 */ |
|
4355
a2af1ff1761f
Provide a DEFAULT argument in #'intern-soft.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4337
diff
changeset
|
276 (name, obarray, default_)) |
| 428 | 277 { |
| 278 Lisp_Object tem; | |
| 793 | 279 Lisp_Object string; |
| 428 | 280 |
| 281 if (NILP (obarray)) obarray = Vobarray; | |
| 282 obarray = check_obarray (obarray); | |
| 283 | |
| 284 if (!SYMBOLP (name)) | |
| 285 { | |
| 286 CHECK_STRING (name); | |
| 793 | 287 string = name; |
| 428 | 288 } |
| 289 else | |
| 290 string = symbol_name (XSYMBOL (name)); | |
| 291 | |
| 793 | 292 tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string)); |
| 428 | 293 if (INTP (tem) || (SYMBOLP (name) && !EQ (name, tem))) |
|
4355
a2af1ff1761f
Provide a DEFAULT argument in #'intern-soft.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4337
diff
changeset
|
294 return default_; |
| 428 | 295 else |
| 296 return tem; | |
| 297 } | |
| 298 | |
| 299 DEFUN ("unintern", Funintern, 1, 2, 0, /* | |
| 300 Delete the symbol named NAME, if any, from OBARRAY. | |
| 301 The value is t if a symbol was found and deleted, nil otherwise. | |
| 302 NAME may be a string or a symbol. If it is a symbol, that symbol | |
| 303 is deleted, if it belongs to OBARRAY--no other symbol is deleted. | |
| 444 | 304 OBARRAY defaults to the value of the variable `obarray'. |
| 428 | 305 */ |
| 306 (name, obarray)) | |
| 307 { | |
| 308 Lisp_Object tem; | |
| 793 | 309 Lisp_Object string; |
| 428 | 310 int hash; |
| 311 | |
| 312 if (NILP (obarray)) obarray = Vobarray; | |
| 313 obarray = check_obarray (obarray); | |
| 314 | |
| 315 if (SYMBOLP (name)) | |
| 316 string = symbol_name (XSYMBOL (name)); | |
| 317 else | |
| 318 { | |
| 319 CHECK_STRING (name); | |
| 793 | 320 string = name; |
| 428 | 321 } |
| 322 | |
| 793 | 323 tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string)); |
| 428 | 324 if (INTP (tem)) |
| 325 return Qnil; | |
| 326 /* If arg was a symbol, don't delete anything but that symbol itself. */ | |
| 327 if (SYMBOLP (name) && !EQ (name, tem)) | |
| 328 return Qnil; | |
| 329 | |
| 330 hash = oblookup_last_bucket_number; | |
| 331 | |
| 332 if (EQ (XVECTOR_DATA (obarray)[hash], tem)) | |
| 333 { | |
| 334 if (XSYMBOL (tem)->next) | |
| 793 | 335 XVECTOR_DATA (obarray)[hash] = wrap_symbol (XSYMBOL (tem)->next); |
| 428 | 336 else |
| 337 XVECTOR_DATA (obarray)[hash] = Qzero; | |
| 338 } | |
| 339 else | |
| 340 { | |
| 341 Lisp_Object tail, following; | |
| 342 | |
| 343 for (tail = XVECTOR_DATA (obarray)[hash]; | |
| 344 XSYMBOL (tail)->next; | |
| 345 tail = following) | |
| 346 { | |
| 793 | 347 following = wrap_symbol (XSYMBOL (tail)->next); |
| 428 | 348 if (EQ (following, tem)) |
| 349 { | |
| 350 XSYMBOL (tail)->next = XSYMBOL (following)->next; | |
| 351 break; | |
| 352 } | |
| 353 } | |
| 354 } | |
| 355 return Qt; | |
| 356 } | |
| 357 | |
| 358 /* Return the symbol in OBARRAY whose names matches the string | |
| 359 of SIZE characters at PTR. If there is no such symbol in OBARRAY, | |
| 360 return the index into OBARRAY that the string hashes to. | |
| 361 | |
| 362 Also store the bucket number in oblookup_last_bucket_number. */ | |
| 363 | |
| 364 Lisp_Object | |
| 867 | 365 oblookup (Lisp_Object obarray, const Ibyte *ptr, Bytecount size) |
| 428 | 366 { |
| 490 | 367 unsigned int hash, obsize; |
| 440 | 368 Lisp_Symbol *tail; |
| 428 | 369 Lisp_Object bucket; |
| 370 | |
| 371 if (!VECTORP (obarray) || | |
| 372 (obsize = XVECTOR_LENGTH (obarray)) == 0) | |
| 373 { | |
| 374 obarray = check_obarray (obarray); | |
| 375 obsize = XVECTOR_LENGTH (obarray); | |
| 376 } | |
| 377 hash = hash_string (ptr, size) % obsize; | |
| 378 oblookup_last_bucket_number = hash; | |
| 379 bucket = XVECTOR_DATA (obarray)[hash]; | |
| 380 if (ZEROP (bucket)) | |
| 381 ; | |
| 382 else if (!SYMBOLP (bucket)) | |
| 563 | 383 signal_error (Qinvalid_state, "Bad data in guts of obarray", Qunbound); /* Like CADR error message */ |
| 428 | 384 else |
| 385 for (tail = XSYMBOL (bucket); ;) | |
| 386 { | |
| 793 | 387 if (XSTRING_LENGTH (tail->name) == size && |
| 388 !memcmp (XSTRING_DATA (tail->name), ptr, size)) | |
| 428 | 389 { |
| 793 | 390 return wrap_symbol (tail); |
| 428 | 391 } |
| 392 tail = symbol_next (tail); | |
| 393 if (!tail) | |
| 394 break; | |
| 395 } | |
| 396 return make_int (hash); | |
| 397 } | |
| 398 | |
| 490 | 399 /* An excellent string hashing function. |
| 400 Adapted from glib's g_str_hash(). | |
| 401 Investigation by Karl Nelson <kenelson@ece.ucdavis.edu>. | |
| 402 Do a web search for "g_str_hash X31_HASH" if you want to know more. */ | |
| 403 unsigned int | |
| 867 | 404 hash_string (const Ibyte *ptr, Bytecount len) |
| 428 | 405 { |
| 490 | 406 unsigned int hash; |
| 407 | |
| 408 for (hash = 0; len; len--, ptr++) | |
| 409 /* (31 * hash) will probably be optimized to ((hash << 5) - hash). */ | |
| 410 hash = 31 * hash + *ptr; | |
| 411 | |
| 412 return hash; | |
| 428 | 413 } |
| 414 | |
| 415 /* Map FN over OBARRAY. The mapping is stopped when FN returns a | |
| 416 non-zero value. */ | |
| 417 void | |
| 418 map_obarray (Lisp_Object obarray, | |
| 419 int (*fn) (Lisp_Object, void *), void *arg) | |
| 420 { | |
| 421 REGISTER int i; | |
| 422 | |
| 423 CHECK_VECTOR (obarray); | |
| 424 for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--) | |
| 425 { | |
| 426 Lisp_Object tail = XVECTOR_DATA (obarray)[i]; | |
| 427 if (SYMBOLP (tail)) | |
| 428 while (1) | |
| 429 { | |
| 440 | 430 Lisp_Symbol *next; |
| 428 | 431 if ((*fn) (tail, arg)) |
| 432 return; | |
| 433 next = symbol_next (XSYMBOL (tail)); | |
| 434 if (!next) | |
| 435 break; | |
| 793 | 436 tail = wrap_symbol (next); |
| 428 | 437 } |
| 438 } | |
| 439 } | |
| 440 | |
| 441 static int | |
| 442 mapatoms_1 (Lisp_Object sym, void *arg) | |
| 443 { | |
| 444 call1 (*(Lisp_Object *)arg, sym); | |
| 445 return 0; | |
| 446 } | |
| 447 | |
| 448 DEFUN ("mapatoms", Fmapatoms, 1, 2, 0, /* | |
| 449 Call FUNCTION on every symbol in OBARRAY. | |
| 450 OBARRAY defaults to the value of `obarray'. | |
| 451 */ | |
| 452 (function, obarray)) | |
| 453 { | |
| 442 | 454 struct gcpro gcpro1; |
| 455 | |
| 428 | 456 if (NILP (obarray)) |
| 457 obarray = Vobarray; | |
| 458 obarray = check_obarray (obarray); | |
| 459 | |
| 442 | 460 GCPRO1 (obarray); |
| 428 | 461 map_obarray (obarray, mapatoms_1, &function); |
| 442 | 462 UNGCPRO; |
| 428 | 463 return Qnil; |
| 464 } | |
| 465 | |
| 466 | |
| 467 /**********************************************************************/ | |
| 468 /* Apropos */ | |
| 469 /**********************************************************************/ | |
| 470 | |
| 471 struct appropos_mapper_closure | |
| 472 { | |
| 473 Lisp_Object regexp; | |
| 474 Lisp_Object predicate; | |
| 475 Lisp_Object accumulation; | |
| 476 }; | |
| 477 | |
| 478 static int | |
| 479 apropos_mapper (Lisp_Object symbol, void *arg) | |
| 480 { | |
| 481 struct appropos_mapper_closure *closure = | |
| 482 (struct appropos_mapper_closure *) arg; | |
| 483 Bytecount match = fast_lisp_string_match (closure->regexp, | |
| 484 Fsymbol_name (symbol)); | |
| 485 | |
| 486 if (match >= 0 && | |
| 487 (NILP (closure->predicate) || | |
| 488 !NILP (call1 (closure->predicate, symbol)))) | |
| 489 closure->accumulation = Fcons (symbol, closure->accumulation); | |
| 490 | |
| 491 return 0; | |
| 492 } | |
| 493 | |
| 494 DEFUN ("apropos-internal", Fapropos_internal, 1, 2, 0, /* | |
| 444 | 495 Return a list of all symbols whose names contain match for REGEXP. |
| 496 If optional 2nd arg PREDICATE is non-nil, only symbols for which | |
| 497 \(funcall PREDICATE SYMBOL) returns non-nil are returned. | |
| 428 | 498 */ |
| 499 (regexp, predicate)) | |
| 500 { | |
| 501 struct appropos_mapper_closure closure; | |
| 442 | 502 struct gcpro gcpro1; |
| 428 | 503 |
| 504 CHECK_STRING (regexp); | |
| 505 | |
| 506 closure.regexp = regexp; | |
| 507 closure.predicate = predicate; | |
| 508 closure.accumulation = Qnil; | |
| 442 | 509 GCPRO1 (closure.accumulation); |
| 428 | 510 map_obarray (Vobarray, apropos_mapper, &closure); |
|
5351
b5561bfd5061
Supply check_string_lessp_nokey explicitly to list_sort(), #'apropos-internal
Aidan Kehoe <kehoea@parhasard.net>
parents:
5338
diff
changeset
|
511 closure.accumulation = list_sort (closure.accumulation, |
|
b5561bfd5061
Supply check_string_lessp_nokey explicitly to list_sort(), #'apropos-internal
Aidan Kehoe <kehoea@parhasard.net>
parents:
5338
diff
changeset
|
512 check_string_lessp_nokey, Qnil, Qnil); |
| 442 | 513 UNGCPRO; |
| 428 | 514 return closure.accumulation; |
| 515 } | |
| 516 | |
| 517 | |
| 518 /* Extract and set components of symbols */ | |
| 519 | |
| 520 static void set_up_buffer_local_cache (Lisp_Object sym, | |
| 521 struct symbol_value_buffer_local *bfwd, | |
| 522 struct buffer *buf, | |
| 523 Lisp_Object new_alist_el, | |
| 524 int set_it_p); | |
| 525 | |
| 526 DEFUN ("boundp", Fboundp, 1, 1, 0, /* | |
| 527 Return t if SYMBOL's value is not void. | |
| 528 */ | |
| 529 (symbol)) | |
| 530 { | |
| 531 CHECK_SYMBOL (symbol); | |
| 532 return UNBOUNDP (find_symbol_value (symbol)) ? Qnil : Qt; | |
| 533 } | |
| 534 | |
| 535 DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /* | |
| 536 Return t if SYMBOL has a global (non-bound) value. | |
| 537 This is for the byte-compiler; you really shouldn't be using this. | |
| 538 */ | |
| 539 (symbol)) | |
| 540 { | |
| 541 CHECK_SYMBOL (symbol); | |
| 542 return UNBOUNDP (top_level_value (symbol)) ? Qnil : Qt; | |
| 543 } | |
| 544 | |
| 545 DEFUN ("fboundp", Ffboundp, 1, 1, 0, /* | |
| 546 Return t if SYMBOL's function definition is not void. | |
| 547 */ | |
| 548 (symbol)) | |
| 549 { | |
| 550 CHECK_SYMBOL (symbol); | |
| 551 return UNBOUNDP (XSYMBOL (symbol)->function) ? Qnil : Qt; | |
| 552 } | |
| 553 | |
| 554 /* Return non-zero if SYM's value or function (the current contents of | |
| 555 which should be passed in as VAL) is constant, i.e. unsettable. */ | |
| 556 | |
| 557 static int | |
| 558 symbol_is_constant (Lisp_Object sym, Lisp_Object val) | |
| 559 { | |
| 560 /* #### - I wonder if it would be better to just have a new magic value | |
| 561 type and make nil, t, and all keywords have that same magic | |
| 562 constant_symbol value. This test is awfully specific about what is | |
| 563 constant and what isn't. --Stig */ | |
| 564 if (EQ (sym, Qnil) || | |
| 565 EQ (sym, Qt)) | |
| 566 return 1; | |
| 567 | |
| 568 if (SYMBOL_VALUE_MAGIC_P (val)) | |
| 569 switch (XSYMBOL_VALUE_MAGIC_TYPE (val)) | |
| 570 { | |
| 571 case SYMVAL_CONST_OBJECT_FORWARD: | |
| 572 case SYMVAL_CONST_SPECIFIER_FORWARD: | |
| 573 case SYMVAL_CONST_FIXNUM_FORWARD: | |
| 574 case SYMVAL_CONST_BOOLEAN_FORWARD: | |
| 575 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: | |
| 576 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: | |
| 577 return 1; | |
| 578 default: break; /* Warning suppression */ | |
| 579 } | |
| 580 | |
| 581 /* We don't return true for keywords here because they are handled | |
| 582 specially by reject_constant_symbols(). */ | |
| 583 return 0; | |
| 584 } | |
| 585 | |
| 586 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is | |
| 587 non-zero) to NEWVAL. Make sure this is allowed. | |
| 588 FOLLOW_PAST_LISP_MAGIC specifies whether we delve past | |
| 589 symbol-value-lisp-magic objects. */ | |
| 590 | |
| 591 void | |
| 592 reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p, | |
| 593 Lisp_Object follow_past_lisp_magic) | |
| 594 { | |
| 595 Lisp_Object val = | |
| 596 (function_p ? XSYMBOL (sym)->function | |
| 597 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic)); | |
| 598 | |
| 599 if (SYMBOL_VALUE_MAGIC_P (val) && | |
| 600 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD) | |
| 563 | 601 invalid_change ("Use `set-specifier' to change a specifier's value", |
| 602 sym); | |
| 428 | 603 |
| 996 | 604 if ( |
| 605 #ifdef HAVE_SHLIB | |
| 606 !(unloading_module && UNBOUNDP(newval)) && | |
| 607 #endif | |
| 608 (symbol_is_constant (sym, val) | |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5182
diff
changeset
|
609 #ifdef NEED_TO_HANDLE_21_4_CODE |
|
4793
8b50bee3c88c
Remove attempted support for 1996-era emacs without self-quoting keywords.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4677
diff
changeset
|
610 || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)) |
|
8b50bee3c88c
Remove attempted support for 1996-era emacs without self-quoting keywords.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4677
diff
changeset
|
611 #endif |
|
8b50bee3c88c
Remove attempted support for 1996-era emacs without self-quoting keywords.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4677
diff
changeset
|
612 )) |
| 563 | 613 signal_error_1 (Qsetting_constant, |
| 614 UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval)); | |
| 428 | 615 } |
| 616 | |
| 617 /* Verify that it's ok to make SYM buffer-local. This rejects | |
| 618 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC | |
| 619 specifies whether we delve into symbol-value-lisp-magic objects. | |
| 620 (Should be a symbol indicating what action is being taken; that way, | |
| 621 we don't delve if there's a handler for that action, but do otherwise.) */ | |
| 622 | |
| 623 static void | |
| 624 verify_ok_for_buffer_local (Lisp_Object sym, | |
| 625 Lisp_Object follow_past_lisp_magic) | |
| 626 { | |
| 627 Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic); | |
| 628 | |
| 629 if (symbol_is_constant (sym, val)) | |
| 630 goto not_ok; | |
| 631 if (SYMBOL_VALUE_MAGIC_P (val)) | |
| 632 switch (XSYMBOL_VALUE_MAGIC_TYPE (val)) | |
| 633 { | |
| 634 case SYMVAL_DEFAULT_BUFFER_FORWARD: | |
| 635 case SYMVAL_DEFAULT_CONSOLE_FORWARD: | |
| 636 /* #### It's theoretically possible for it to be reasonable | |
| 637 to have both console-local and buffer-local variables, | |
| 638 but I don't want to consider that right now. */ | |
| 639 case SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 640 goto not_ok; | |
| 641 default: break; /* Warning suppression */ | |
| 642 } | |
| 643 | |
| 644 return; | |
| 645 | |
| 646 not_ok: | |
| 563 | 647 invalid_change ("Symbol may not be buffer-local", sym); |
| 428 | 648 } |
| 649 | |
| 650 DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /* | |
| 651 Make SYMBOL's value be void. | |
| 652 */ | |
| 653 (symbol)) | |
| 654 { | |
| 655 Fset (symbol, Qunbound); | |
| 656 return symbol; | |
| 657 } | |
| 658 | |
| 659 DEFUN ("fmakunbound", Ffmakunbound, 1, 1, 0, /* | |
| 660 Make SYMBOL's function definition be void. | |
| 661 */ | |
| 662 (symbol)) | |
| 663 { | |
| 664 CHECK_SYMBOL (symbol); | |
| 665 reject_constant_symbols (symbol, Qunbound, 1, Qt); | |
| 666 XSYMBOL (symbol)->function = Qunbound; | |
| 667 return symbol; | |
| 668 } | |
| 669 | |
| 670 DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /* | |
| 671 Return SYMBOL's function definition. Error if that is void. | |
| 672 */ | |
| 673 (symbol)) | |
| 674 { | |
| 675 CHECK_SYMBOL (symbol); | |
| 676 if (UNBOUNDP (XSYMBOL (symbol)->function)) | |
| 677 signal_void_function_error (symbol); | |
| 678 return XSYMBOL (symbol)->function; | |
| 679 } | |
| 680 | |
| 681 DEFUN ("symbol-plist", Fsymbol_plist, 1, 1, 0, /* | |
| 682 Return SYMBOL's property list. | |
| 683 */ | |
| 684 (symbol)) | |
| 685 { | |
| 686 CHECK_SYMBOL (symbol); | |
| 687 return XSYMBOL (symbol)->plist; | |
| 688 } | |
| 689 | |
| 690 DEFUN ("symbol-name", Fsymbol_name, 1, 1, 0, /* | |
| 691 Return SYMBOL's name, a string. | |
| 692 */ | |
| 693 (symbol)) | |
| 694 { | |
| 695 CHECK_SYMBOL (symbol); | |
| 793 | 696 return XSYMBOL (symbol)->name; |
| 428 | 697 } |
| 698 | |
| 699 DEFUN ("fset", Ffset, 2, 2, 0, /* | |
| 700 Set SYMBOL's function definition to NEWDEF, and return NEWDEF. | |
| 701 */ | |
| 702 (symbol, newdef)) | |
| 703 { | |
| 704 /* This function can GC */ | |
| 705 CHECK_SYMBOL (symbol); | |
| 706 reject_constant_symbols (symbol, newdef, 1, Qt); | |
| 707 if (!NILP (Vautoload_queue) && !UNBOUNDP (XSYMBOL (symbol)->function)) | |
| 708 Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function), | |
| 709 Vautoload_queue); | |
| 710 XSYMBOL (symbol)->function = newdef; | |
| 711 /* Handle automatic advice activation */ | |
| 712 if (CONSP (XSYMBOL (symbol)->plist) && | |
| 713 !NILP (Fget (symbol, Qad_advice_info, Qnil))) | |
| 714 { | |
| 715 call2 (Qad_activate, symbol, Qnil); | |
| 716 newdef = XSYMBOL (symbol)->function; | |
| 717 } | |
| 718 return newdef; | |
| 719 } | |
| 720 | |
| 721 /* FSFmacs */ | |
| 722 DEFUN ("define-function", Fdefine_function, 2, 2, 0, /* | |
| 723 Set SYMBOL's function definition to NEWDEF, and return NEWDEF. | |
| 724 Associates the function with the current load file, if any. | |
|
4921
17362f371cc2
add more byte-code assertions and better failure output
Ben Wing <ben@xemacs.org>
parents:
4905
diff
changeset
|
725 If NEWDEF is a compiled-function object, stores the function name in |
|
17362f371cc2
add more byte-code assertions and better failure output
Ben Wing <ben@xemacs.org>
parents:
4905
diff
changeset
|
726 the `annotated' slot of the compiled-function (retrievable using |
|
17362f371cc2
add more byte-code assertions and better failure output
Ben Wing <ben@xemacs.org>
parents:
4905
diff
changeset
|
727 `compiled-function-annotation'). |
| 428 | 728 */ |
| 729 (symbol, newdef)) | |
| 730 { | |
| 731 /* This function can GC */ | |
| 732 Ffset (symbol, newdef); | |
|
4535
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4503
diff
changeset
|
733 LOADHIST_ATTACH (Fcons (Qdefun, symbol)); |
|
4921
17362f371cc2
add more byte-code assertions and better failure output
Ben Wing <ben@xemacs.org>
parents:
4905
diff
changeset
|
734 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK |
|
17362f371cc2
add more byte-code assertions and better failure output
Ben Wing <ben@xemacs.org>
parents:
4905
diff
changeset
|
735 if (COMPILED_FUNCTIONP (newdef)) |
|
17362f371cc2
add more byte-code assertions and better failure output
Ben Wing <ben@xemacs.org>
parents:
4905
diff
changeset
|
736 XCOMPILED_FUNCTION (newdef)->annotated = symbol; |
|
17362f371cc2
add more byte-code assertions and better failure output
Ben Wing <ben@xemacs.org>
parents:
4905
diff
changeset
|
737 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */ |
| 428 | 738 return newdef; |
| 739 } | |
| 740 | |
| 3368 | 741 DEFUN ("subr-name", Fsubr_name, 1, 1, 0, /* |
| 742 Return name of function SUBR. | |
| 743 SUBR must be a built-in function. | |
| 744 */ | |
| 745 (subr)) | |
| 746 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
747 const Ascbyte *name; |
| 3497 | 748 CHECK_SUBR (subr); |
| 749 | |
| 3368 | 750 name = XSUBR (subr)->name; |
| 3379 | 751 return make_string ((const Ibyte *)name, strlen (name)); |
| 3368 | 752 } |
| 428 | 753 |
|
4905
755ae5b97edb
Change "special form" to "special operator" in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4793
diff
changeset
|
754 DEFUN ("special-operator-p", Fspecial_operator_p, 1, 1, 0, /* |
|
755ae5b97edb
Change "special form" to "special operator" in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4793
diff
changeset
|
755 Return whether SUBR is a special operator. |
|
755ae5b97edb
Change "special form" to "special operator" in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4793
diff
changeset
|
756 |
|
755ae5b97edb
Change "special form" to "special operator" in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4793
diff
changeset
|
757 A special operator is a built-in function (a subr, that is a function |
|
4337
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
758 implemented in C, not Lisp) which does not necessarily evaluate all its |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
759 arguments. Much of the basic XEmacs Lisp syntax is implemented by means of |
|
4905
755ae5b97edb
Change "special form" to "special operator" in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4793
diff
changeset
|
760 special operators; examples are `let', `condition-case', `setq', and so |
|
4337
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
761 on. |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
762 |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
763 If you intend to write a Lisp function that does not necessarily evaluate |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
764 all its arguments, the portable (across emacs variants, and across Lisp |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
765 implementations) way to go about it is to write a macro instead. See |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
766 `defmacro' and `backquote'. |
|
4336
cdc2f70d4319
Provide #'special-form-p, for the use of advice.el, perhaps other files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3497
diff
changeset
|
767 */ |
|
cdc2f70d4319
Provide #'special-form-p, for the use of advice.el, perhaps other files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3497
diff
changeset
|
768 (subr)) |
|
cdc2f70d4319
Provide #'special-form-p, for the use of advice.el, perhaps other files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3497
diff
changeset
|
769 { |
|
4337
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
770 subr = indirect_function (subr, 0); |
|
c32e4dca0296
#'special-form-p; don't error (thank you Jerry James); flesh out docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4336
diff
changeset
|
771 return (SUBRP (subr) && XSUBR (subr)->max_args == UNEVALLED) ? Qt : Qnil; |
|
4336
cdc2f70d4319
Provide #'special-form-p, for the use of advice.el, perhaps other files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3497
diff
changeset
|
772 } |
|
cdc2f70d4319
Provide #'special-form-p, for the use of advice.el, perhaps other files.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3497
diff
changeset
|
773 |
| 428 | 774 DEFUN ("setplist", Fsetplist, 2, 2, 0, /* |
| 775 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST. | |
| 776 */ | |
| 777 (symbol, newplist)) | |
| 778 { | |
| 779 CHECK_SYMBOL (symbol); | |
| 780 | |
| 781 XSYMBOL (symbol)->plist = newplist; | |
| 782 return newplist; | |
| 783 } | |
| 784 | |
| 785 | |
| 786 /**********************************************************************/ | |
| 787 /* symbol-value */ | |
| 788 /**********************************************************************/ | |
| 789 | |
|
4940
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
790 /* |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
791 NOTE NOTE NOTE: |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
792 --------------- |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
793 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
794 There are various different uses of "magic" with regard to symbols, |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
795 and they need to be distinguished: |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
796 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
797 1. `symbol-value-magic' class of objects (struct symbol_value_magic): |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
798 A set of Lisp object types used as the value of a variable with any |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
799 behavior other than just a plain repository of a value. This |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
800 includes buffer-local variables, console-local variables, read-only |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
801 variables, variable aliases, variables that are linked to a C |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
802 variable, etc. The more specific types are: |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
803 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
804 -- `symbol-value-forward': Variables that forward to a C variable. |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
805 NOTE:This includes built-in buffer-local and console-local |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
806 variables, since they forward to an element in a buffer or |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
807 console structure. |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
808 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
809 -- `symbol-value-buffer-local': Variables on which |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
810 `make-local-variable' or `make-variable-buffer-local' have |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
811 been called. |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
812 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
813 -- `symbol-value-lisp-magic': See below. |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
814 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
815 -- `symbol-value-varalias': Variable aliases. |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
816 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
817 2. `symbol-value-lisp-magic': Variables on which |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
818 `dontusethis-set-symbol-value-handler' have been called. These |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
819 variables are extra-magic in that operations that would normally |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
820 change their value instead get forwarded out to Lisp handlers, |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
821 which can do anything they want. (NOTE: Handlers for getting a |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
822 variable's value aren't implemented yet.) |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
823 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
824 3. "magicfun" handlers on C-forwarding variables, declared with any |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
825 of the following: |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
826 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
827 -- DEFVAR_LISP_MAGIC |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
828 -- DEFVAR_INT_MAGIC |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
829 -- DEFVAR_BOOL_MAGIC, |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
830 -- DEFVAR_BUFFER_LOCAL_MAGIC |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
831 -- DEFVAR_BUFFER_DEFAULTS_MAGIC |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
832 -- DEFVAR_CONSOLE_LOCAL_MAGIC |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
833 -- DEFVAR_CONSOLE_DEFAULTS_MAGIC |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
834 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
835 Here, the "magic function" is a handler that is notified whenever the |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
836 value of a variable is changed, so that some other updating can take |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
837 place (e.g. setting redisplay-related dirty bits, updating a cache, |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
838 etc.). |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
839 |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
840 Note that DEFVAR_LISP_MAGIC does *NOT* have anything to do with |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
841 `symbol-value-lisp-magic'. The former refers to variables that can |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
842 hold an arbitrary Lisp object and forward to a C variable declared |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
843 `Lisp_Object foo', and have a "magicfun" as just described; the |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
844 latter are variables that have Lisp-level handlers that function |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
845 in *PLACE* of normal variable-setting mechanisms, and are established |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
846 with `dontusethis-set-symbol-value-handler', as described above. |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
847 */ |
|
9113c5044de8
(for main branch) add long comment about types of magic symbols
Ben Wing <ben@xemacs.org>
parents:
4793
diff
changeset
|
848 |
| 428 | 849 /* If the contents of the value cell of a symbol is one of the following |
| 850 three types of objects, then the symbol is "magic" in that setting | |
| 851 and retrieving its value doesn't just set or retrieve the raw | |
| 852 contents of the value cell. None of these objects can escape to | |
| 853 the user level, so there is no loss of generality. | |
| 854 | |
| 855 If a symbol is "unbound", then the contents of its value cell is | |
| 856 Qunbound. Despite appearances, this is *not* a symbol, but is a | |
| 857 symbol-value-forward object. This is so that printing it results | |
| 858 in "INTERNAL OBJECT (XEmacs bug?)", in case it leaks to Lisp, somehow. | |
| 859 | |
| 860 Logically all of the following objects are "symbol-value-magic" | |
| 861 objects, and there are some games played w.r.t. this (#### this | |
| 862 should be cleaned up). SYMBOL_VALUE_MAGIC_P is true for all of | |
| 863 the object types. XSYMBOL_VALUE_MAGIC_TYPE returns the type of | |
| 864 symbol-value-magic object. There are more than three types | |
| 865 returned by this macro: in particular, symbol-value-forward | |
| 866 has eight subtypes, and symbol-value-buffer-local has two. See | |
| 867 symeval.h. | |
| 868 | |
| 869 1. symbol-value-forward | |
| 870 | |
| 871 symbol-value-forward is used for variables whose actual contents | |
| 872 are stored in a C variable of some sort, and for Qunbound. The | |
| 873 lcheader.next field (which is only used to chain together free | |
| 874 lcrecords) holds a pointer to the actual C variable. Included | |
| 875 in this type are "buffer-local" variables that are actually | |
| 876 stored in the buffer object itself; in this case, the "pointer" | |
| 877 is an offset into the struct buffer structure. | |
| 878 | |
| 879 The subtypes are as follows: | |
| 880 | |
| 881 SYMVAL_OBJECT_FORWARD: | |
| 882 (declare with DEFVAR_LISP) | |
| 883 The value of this variable is stored in a C variable of type | |
| 884 "Lisp_Object". Setting this variable sets the C variable. | |
| 885 Accessing this variable retrieves a value from the C variable. | |
| 886 These variables can be buffer-local -- in this case, the | |
| 887 raw symbol-value field gets converted into a | |
| 888 symbol-value-buffer-local, whose "current_value" slot contains | |
| 889 the symbol-value-forward. (See below.) | |
| 890 | |
| 891 SYMVAL_FIXNUM_FORWARD: | |
| 458 | 892 (declare with DEFVAR_INT) |
| 893 Similar to SYMVAL_OBJECT_FORWARD except that the C variable | |
| 894 is of type "Fixnum", a typedef for "EMACS_INT", and the corresponding | |
| 895 lisp variable is always the corresponding integer. | |
| 896 | |
| 428 | 897 SYMVAL_BOOLEAN_FORWARD: |
| 458 | 898 (declare with DEFVAR_BOOL) |
| 428 | 899 Similar to SYMVAL_OBJECT_FORWARD except that the C variable |
| 458 | 900 is of type "int" and is a boolean. |
| 428 | 901 |
| 902 SYMVAL_CONST_OBJECT_FORWARD: | |
| 903 SYMVAL_CONST_FIXNUM_FORWARD: | |
| 904 SYMVAL_CONST_BOOLEAN_FORWARD: | |
| 905 (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or | |
| 906 DEFVAR_CONST_BOOL) | |
| 907 Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or | |
| 908 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot | |
| 909 be changed. | |
| 910 | |
| 911 SYMVAL_CONST_SPECIFIER_FORWARD: | |
| 912 (declare with DEFVAR_SPECIFIER) | |
| 440 | 913 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that the error |
| 914 message you get when attempting to set the value says to use | |
| 428 | 915 `set-specifier' instead. |
| 916 | |
| 917 SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 918 (declare with DEFVAR_BUFFER_LOCAL) | |
| 919 This is used for built-in buffer-local variables -- i.e. | |
| 920 Lisp variables whose value is stored in the "struct buffer". | |
| 921 Variables of this sort always forward into C "Lisp_Object" | |
| 922 fields (although there's no reason in principle that other | |
| 923 types for ints and booleans couldn't be added). Note that | |
| 924 some of these variables are automatically local in each | |
| 925 buffer, while some are only local when they become set | |
| 926 (similar to `make-variable-buffer-local'). In these latter | |
| 927 cases, of course, the default value shows through in all | |
| 928 buffers in which the variable doesn't have a local value. | |
| 929 This is implemented by making sure the "struct buffer" field | |
| 930 always contains the correct value (whether it's local or | |
| 931 a default) and maintaining a mask in the "struct buffer" | |
| 932 indicating which fields are local. When `set-default' is | |
| 933 called on a variable that's not always local to all buffers, | |
| 934 it loops through each buffer and sets the corresponding | |
| 935 field in each buffer without a local value for the field, | |
| 936 according to the mask. | |
| 937 | |
| 938 Calling `make-local-variable' on a variable of this sort | |
| 939 only has the effect of maybe changing the current buffer's mask. | |
| 940 Calling `make-variable-buffer-local' on a variable of this | |
| 941 sort has no effect at all. | |
| 942 | |
| 943 SYMVAL_CONST_CURRENT_BUFFER_FORWARD: | |
| 944 (declare with DEFVAR_CONST_BUFFER_LOCAL) | |
| 945 Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the | |
| 946 value cannot be set. | |
| 947 | |
| 948 SYMVAL_DEFAULT_BUFFER_FORWARD: | |
| 949 (declare with DEFVAR_BUFFER_DEFAULTS) | |
| 950 This is used for the Lisp variables that contain the | |
| 951 default values of built-in buffer-local variables. Setting | |
| 952 or referencing one of these variables forwards into a slot | |
| 953 in the special struct buffer Vbuffer_defaults. | |
| 954 | |
| 955 SYMVAL_UNBOUND_MARKER: | |
| 956 This is used for only one object, Qunbound. | |
| 957 | |
| 958 SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 959 (declare with DEFVAR_CONSOLE_LOCAL) | |
| 960 This is used for built-in console-local variables -- i.e. | |
| 961 Lisp variables whose value is stored in the "struct console". | |
| 962 These work just like built-in buffer-local variables. | |
| 963 However, calling `make-local-variable' or | |
| 964 `make-variable-buffer-local' on one of these variables | |
| 965 is currently disallowed because that would entail having | |
| 966 both console-local and buffer-local variables, which is | |
| 967 trickier to implement. | |
| 968 | |
| 969 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: | |
| 970 (declare with DEFVAR_CONST_CONSOLE_LOCAL) | |
| 971 Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the | |
| 972 value cannot be set. | |
| 973 | |
| 974 SYMVAL_DEFAULT_CONSOLE_FORWARD: | |
| 975 (declare with DEFVAR_CONSOLE_DEFAULTS) | |
| 976 This is used for the Lisp variables that contain the | |
| 977 default values of built-in console-local variables. Setting | |
| 978 or referencing one of these variables forwards into a slot | |
| 979 in the special struct console Vconsole_defaults. | |
| 980 | |
| 981 | |
| 982 2. symbol-value-buffer-local | |
| 983 | |
| 984 symbol-value-buffer-local is used for variables that have had | |
| 985 `make-local-variable' or `make-variable-buffer-local' applied | |
| 986 to them. This object contains an alist mapping buffers to | |
| 987 values. In addition, the object contains a "current value", | |
| 988 which is the value in some buffer. Whenever you access the | |
| 989 variable with `symbol-value' or set it with `set' or `setq', | |
| 990 things are switched around so that the "current value" | |
| 991 refers to the current buffer, if it wasn't already. This | |
| 992 way, repeated references to a variable in the same buffer | |
| 993 are almost as efficient as if the variable weren't buffer | |
| 994 local. Note that the alist may not be up-to-date w.r.t. | |
| 995 the buffer whose value is current, as the "current value" | |
| 996 cache is normally only flushed into the alist when the | |
| 997 buffer it refers to changes. | |
| 998 | |
| 999 Note also that it is possible for `make-local-variable' | |
| 1000 or `make-variable-buffer-local' to be called on a variable | |
| 1001 that forwards into a C variable (i.e. a variable whose | |
| 1002 value cell is a symbol-value-forward). In this case, | |
| 1003 the value cell becomes a symbol-value-buffer-local (as | |
| 1004 always), and the symbol-value-forward moves into | |
| 1005 the "current value" cell in this object. Also, in | |
| 1006 this case the "current value" *always* refers to the | |
| 1007 current buffer, so that the values of the C variable | |
| 1008 always is the correct value for the current buffer. | |
| 1009 set_buffer_internal() automatically updates the current-value | |
| 1010 cells of all buffer-local variables that forward into C | |
| 1011 variables. (There is a list of all buffer-local variables | |
| 1012 that is maintained for this and other purposes.) | |
| 1013 | |
| 1014 Note that only certain types of `symbol-value-forward' objects | |
| 1015 can find their way into the "current value" cell of a | |
| 1016 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD, | |
| 1017 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and | |
| 1018 SYMVAL_UNBOUND_MARKER. The SYMVAL_CONST_*_FORWARD cannot | |
| 1019 be buffer-local because they are unsettable; | |
| 1020 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that | |
| 1021 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local | |
| 1022 does not have much of an effect (it's already buffer-local); and | |
| 1023 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because | |
| 1024 that's not currently implemented. | |
| 1025 | |
| 1026 | |
| 1027 3. symbol-value-varalias | |
| 1028 | |
| 1029 A symbol-value-varalias object is used for variables that | |
| 1030 are aliases for other variables. This object contains | |
| 1031 the symbol that this variable is aliased to. | |
| 1032 symbol-value-varalias objects cannot occur anywhere within | |
| 1033 a symbol-value-buffer-local object, and most of the | |
| 1034 low-level functions below do not accept them; you need | |
| 1035 to call follow_varalias_pointers to get the actual | |
| 1036 symbol to operate on. */ | |
| 1037 | |
| 1204 | 1038 static const struct memory_description symbol_value_buffer_local_description[] = { |
| 1039 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, default_value) }, | |
| 1040 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_value) }, | |
| 1041 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_buffer) }, | |
| 1042 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_alist_element) }, | |
| 1043 { XD_END } | |
| 1044 }; | |
| 1045 | |
| 428 | 1046 static Lisp_Object |
| 1047 mark_symbol_value_buffer_local (Lisp_Object obj) | |
| 1048 { | |
| 1049 struct symbol_value_buffer_local *bfwd; | |
| 1050 | |
| 800 | 1051 #ifdef ERROR_CHECK_TYPES |
| 428 | 1052 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL || |
| 1053 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL); | |
| 1054 #endif | |
| 1055 | |
| 1056 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj); | |
| 1057 mark_object (bfwd->default_value); | |
| 1058 mark_object (bfwd->current_value); | |
| 1059 mark_object (bfwd->current_buffer); | |
| 1060 return bfwd->current_alist_element; | |
| 1061 } | |
| 1062 | |
| 1204 | 1063 |
| 1064 static const struct memory_description symbol_value_lisp_magic_description[] = { | |
| 1065 { XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, handler), MAGIC_HANDLER_MAX }, | |
| 1066 { XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, harg), MAGIC_HANDLER_MAX }, | |
| 1067 { XD_LISP_OBJECT, offsetof (struct symbol_value_lisp_magic, shadowed) }, | |
| 1068 { XD_END } | |
| 1069 }; | |
| 1070 | |
| 428 | 1071 static Lisp_Object |
| 1072 mark_symbol_value_lisp_magic (Lisp_Object obj) | |
| 1073 { | |
| 1074 struct symbol_value_lisp_magic *bfwd; | |
| 1075 int i; | |
| 1076 | |
| 1077 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC); | |
| 1078 | |
| 1079 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj); | |
| 1080 for (i = 0; i < MAGIC_HANDLER_MAX; i++) | |
| 1081 { | |
| 1082 mark_object (bfwd->handler[i]); | |
| 1083 mark_object (bfwd->harg[i]); | |
| 1084 } | |
| 1085 return bfwd->shadowed; | |
| 1086 } | |
| 1087 | |
| 1204 | 1088 static const struct memory_description symbol_value_varalias_description[] = { |
| 1089 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, aliasee) }, | |
| 1090 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, shadowed) }, | |
| 1091 { XD_END } | |
| 1092 }; | |
| 1093 | |
| 428 | 1094 static Lisp_Object |
| 1095 mark_symbol_value_varalias (Lisp_Object obj) | |
| 1096 { | |
| 1097 struct symbol_value_varalias *bfwd; | |
| 1098 | |
| 1099 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS); | |
| 1100 | |
| 1101 bfwd = XSYMBOL_VALUE_VARALIAS (obj); | |
| 1102 mark_object (bfwd->shadowed); | |
| 1103 return bfwd->aliasee; | |
| 1104 } | |
| 1105 | |
| 1106 /* Should never, ever be called. (except by an external debugger) */ | |
| 1107 void | |
| 2286 | 1108 print_symbol_value_magic (Lisp_Object obj, Lisp_Object printcharfun, |
| 1109 int UNUSED (escapeflag)) | |
| 428 | 1110 { |
| 800 | 1111 write_fmt_string (printcharfun, |
|
5146
88bd4f3ef8e4
make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
1112 "#<INTERNAL OBJECT (XEmacs bug?) (%s type %d) 0x%x>", |
| 800 | 1113 XRECORD_LHEADER_IMPLEMENTATION (obj)->name, |
| 1114 XSYMBOL_VALUE_MAGIC_TYPE (obj), | |
|
5146
88bd4f3ef8e4
make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
1115 LISP_OBJECT_UID (obj)); |
| 428 | 1116 } |
| 1117 | |
| 1204 | 1118 static const struct memory_description symbol_value_forward_description[] = { |
| 428 | 1119 { XD_END } |
| 1120 }; | |
| 1121 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
1122 DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-forward", |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1123 symbol_value_forward, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1124 0, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1125 print_symbol_value_magic, 0, 0, 0, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1126 symbol_value_forward_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1127 struct symbol_value_forward); |
| 934 | 1128 |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
1129 DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-buffer-local", |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1130 symbol_value_buffer_local, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1131 mark_symbol_value_buffer_local, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1132 print_symbol_value_magic, 0, 0, 0, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1133 symbol_value_buffer_local_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1134 struct symbol_value_buffer_local); |
| 934 | 1135 |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
1136 DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-lisp-magic", |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1137 symbol_value_lisp_magic, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1138 mark_symbol_value_lisp_magic, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1139 print_symbol_value_magic, 0, 0, 0, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1140 symbol_value_lisp_magic_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1141 struct symbol_value_lisp_magic); |
| 934 | 1142 |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
1143 DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-varalias", |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1144 symbol_value_varalias, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1145 mark_symbol_value_varalias, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1146 print_symbol_value_magic, 0, 0, 0, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1147 symbol_value_varalias_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
1148 struct symbol_value_varalias); |
| 934 | 1149 |
| 428 | 1150 |
| 1151 /* Getting and setting values of symbols */ | |
| 1152 | |
| 1153 /* Given the raw contents of a symbol value cell, return the Lisp value of | |
| 1154 the symbol. However, VALCONTENTS cannot be a symbol-value-buffer-local, | |
| 1155 symbol-value-lisp-magic, or symbol-value-varalias. | |
| 1156 | |
| 1157 BUFFER specifies a buffer, and is used for built-in buffer-local | |
| 1158 variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD. | |
| 1159 Note that such variables are never encapsulated in a | |
| 1160 symbol-value-buffer-local structure. | |
| 1161 | |
| 1162 CONSOLE specifies a console, and is used for built-in console-local | |
| 1163 variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD. | |
| 1164 Note that such variables are (currently) never encapsulated in a | |
| 1165 symbol-value-buffer-local structure. | |
| 1166 */ | |
| 1167 | |
| 1168 static Lisp_Object | |
| 1169 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer, | |
| 1170 struct console *console) | |
| 1171 { | |
| 442 | 1172 const struct symbol_value_forward *fwd; |
| 428 | 1173 |
| 1174 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 1175 return valcontents; | |
| 1176 | |
| 1177 fwd = XSYMBOL_VALUE_FORWARD (valcontents); | |
| 1178 switch (fwd->magic.type) | |
| 1179 { | |
| 1180 case SYMVAL_FIXNUM_FORWARD: | |
| 1181 case SYMVAL_CONST_FIXNUM_FORWARD: | |
| 458 | 1182 return make_int (*((Fixnum *)symbol_value_forward_forward (fwd))); |
| 428 | 1183 |
| 1184 case SYMVAL_BOOLEAN_FORWARD: | |
| 1185 case SYMVAL_CONST_BOOLEAN_FORWARD: | |
| 1186 return *((int *)symbol_value_forward_forward (fwd)) ? Qt : Qnil; | |
| 1187 | |
| 1188 case SYMVAL_OBJECT_FORWARD: | |
| 1189 case SYMVAL_CONST_OBJECT_FORWARD: | |
| 1190 case SYMVAL_CONST_SPECIFIER_FORWARD: | |
| 1191 return *((Lisp_Object *)symbol_value_forward_forward (fwd)); | |
| 1192 | |
| 1193 case SYMVAL_DEFAULT_BUFFER_FORWARD: | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1194 return (*((Lisp_Object *)((Rawbyte *) XBUFFER (Vbuffer_defaults) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1195 + ((Rawbyte *)symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1196 - (Rawbyte *)&buffer_local_flags)))); |
| 428 | 1197 |
| 1198 | |
| 1199 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 1200 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: | |
| 1201 assert (buffer); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1202 return (*((Lisp_Object *)((Rawbyte *)buffer |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1203 + ((Rawbyte *)symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1204 - (Rawbyte *)&buffer_local_flags)))); |
| 428 | 1205 |
| 1206 case SYMVAL_DEFAULT_CONSOLE_FORWARD: | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1207 return (*((Lisp_Object *)((Rawbyte *) XCONSOLE (Vconsole_defaults) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1208 + ((Rawbyte *)symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1209 - (Rawbyte *)&console_local_flags)))); |
| 428 | 1210 |
| 1211 case SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 1212 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: | |
| 1213 assert (console); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1214 return (*((Lisp_Object *)((Rawbyte *)console |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1215 + ((Rawbyte *)symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1216 - (Rawbyte *)&console_local_flags)))); |
| 428 | 1217 |
| 1218 case SYMVAL_UNBOUND_MARKER: | |
| 1219 return valcontents; | |
| 1220 | |
| 1221 default: | |
| 2500 | 1222 ABORT (); |
| 428 | 1223 } |
| 1224 return Qnil; /* suppress compiler warning */ | |
| 1225 } | |
| 1226 | |
| 1227 /* Set the value of default-buffer-local variable SYM to VALUE. */ | |
| 1228 | |
| 1229 static void | |
| 1230 set_default_buffer_slot_variable (Lisp_Object sym, | |
| 1231 Lisp_Object value) | |
| 1232 { | |
| 1233 /* Handle variables like case-fold-search that have special slots in | |
| 1234 the buffer. Make them work apparently like buffer_local variables. | |
| 1235 */ | |
| 1236 /* At this point, the value cell may not contain a symbol-value-varalias | |
| 1237 or symbol-value-buffer-local, and if there's a handler, we should | |
| 1238 have already called it. */ | |
| 1239 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt); | |
| 442 | 1240 const struct symbol_value_forward *fwd |
| 428 | 1241 = XSYMBOL_VALUE_FORWARD (valcontents); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1242 int offset = ((Rawbyte *) symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1243 - (Rawbyte *) &buffer_local_flags); |
| 428 | 1244 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); |
| 1245 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object, | |
| 1246 int flags) = symbol_value_forward_magicfun (fwd); | |
| 1247 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1248 *((Lisp_Object *) (offset + (Rawbyte *) XBUFFER (Vbuffer_defaults))) |
| 428 | 1249 = value; |
| 1250 | |
| 1251 if (mask > 0) /* Not always per-buffer */ | |
| 1252 { | |
| 1253 /* Set value in each buffer which hasn't shadowed the default */ | |
| 1254 LIST_LOOP_2 (elt, Vbuffer_alist) | |
| 1255 { | |
| 1256 struct buffer *b = XBUFFER (XCDR (elt)); | |
| 1257 if (!(b->local_var_flags & mask)) | |
| 1258 { | |
| 1259 if (magicfun) | |
| 771 | 1260 magicfun (sym, &value, wrap_buffer (b), 0); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1261 *((Lisp_Object *) (offset + (Rawbyte *) b)) = value; |
| 428 | 1262 } |
| 1263 } | |
| 1264 } | |
| 1265 } | |
| 1266 | |
| 1267 /* Set the value of default-console-local variable SYM to VALUE. */ | |
| 1268 | |
| 1269 static void | |
| 1270 set_default_console_slot_variable (Lisp_Object sym, | |
| 1271 Lisp_Object value) | |
| 1272 { | |
| 1273 /* Handle variables like case-fold-search that have special slots in | |
| 1274 the console. Make them work apparently like console_local variables. | |
| 1275 */ | |
| 1276 /* At this point, the value cell may not contain a symbol-value-varalias | |
| 1277 or symbol-value-buffer-local, and if there's a handler, we should | |
| 1278 have already called it. */ | |
| 1279 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt); | |
| 442 | 1280 const struct symbol_value_forward *fwd |
| 428 | 1281 = XSYMBOL_VALUE_FORWARD (valcontents); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1282 int offset = ((Rawbyte *) symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1283 - (Rawbyte *) &console_local_flags); |
| 428 | 1284 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); |
| 1285 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object, | |
| 1286 int flags) = symbol_value_forward_magicfun (fwd); | |
| 1287 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1288 *((Lisp_Object *) (offset + (Rawbyte *) XCONSOLE (Vconsole_defaults))) |
| 428 | 1289 = value; |
| 1290 | |
| 1291 if (mask > 0) /* Not always per-console */ | |
| 1292 { | |
| 1293 /* Set value in each console which hasn't shadowed the default */ | |
| 1294 LIST_LOOP_2 (console, Vconsole_list) | |
| 1295 { | |
| 1296 struct console *d = XCONSOLE (console); | |
| 1297 if (!(d->local_var_flags & mask)) | |
| 1298 { | |
| 1299 if (magicfun) | |
| 1300 magicfun (sym, &value, console, 0); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1301 *((Lisp_Object *) (offset + (Rawbyte *) d)) = value; |
| 428 | 1302 } |
| 1303 } | |
| 1304 } | |
| 1305 } | |
| 1306 | |
| 1307 /* Store NEWVAL into SYM. | |
| 1308 | |
| 1309 SYM's value slot may *not* be types (5) or (6) above, | |
| 1310 i.e. no symbol-value-varalias objects. (You should have | |
| 1311 forwarded past all of these.) | |
| 1312 | |
| 1313 SYM should not be an unsettable symbol or a symbol with | |
| 1314 a magic `set-value' handler (unless you want to explicitly | |
| 1315 ignore this handler). | |
| 1316 | |
| 1317 OVALUE is the current value of SYM, but forwarded past any | |
| 1318 symbol-value-buffer-local and symbol-value-lisp-magic objects. | |
| 1319 (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be | |
| 1320 the contents of its current-value cell.) NEWVAL may only be | |
| 1321 a simple value or Qunbound. If SYM is a symbol-value-buffer-local, | |
| 1322 this function will only modify its current-value cell, which should | |
| 1323 already be set up to point to the current buffer. | |
| 1324 */ | |
| 1325 | |
| 1326 static void | |
| 1327 store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue, | |
| 1328 Lisp_Object newval) | |
| 1329 { | |
| 1330 if (!SYMBOL_VALUE_MAGIC_P (ovalue) || UNBOUNDP (ovalue)) | |
| 1331 { | |
| 1332 Lisp_Object *store_pointer = value_slot_past_magic (sym); | |
| 1333 | |
| 1334 if (SYMBOL_VALUE_BUFFER_LOCAL_P (*store_pointer)) | |
| 1335 store_pointer = | |
| 1336 &XSYMBOL_VALUE_BUFFER_LOCAL (*store_pointer)->current_value; | |
| 1337 | |
| 1338 assert (UNBOUNDP (*store_pointer) | |
| 1339 || !SYMBOL_VALUE_MAGIC_P (*store_pointer)); | |
| 1340 *store_pointer = newval; | |
| 1341 } | |
| 1342 else | |
| 1343 { | |
| 442 | 1344 const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue); |
| 428 | 1345 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, |
| 1346 Lisp_Object in_object, int flags) | |
| 1347 = symbol_value_forward_magicfun (fwd); | |
| 1348 | |
| 1349 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue)) | |
| 1350 { | |
| 1351 case SYMVAL_FIXNUM_FORWARD: | |
| 1352 CHECK_INT (newval); | |
| 1353 if (magicfun) | |
| 1354 magicfun (sym, &newval, Qnil, 0); | |
| 458 | 1355 *((Fixnum *) symbol_value_forward_forward (fwd)) = XINT (newval); |
| 428 | 1356 return; |
| 1357 | |
| 1358 case SYMVAL_BOOLEAN_FORWARD: | |
| 1359 if (magicfun) | |
| 1360 magicfun (sym, &newval, Qnil, 0); | |
| 1361 *((int *) symbol_value_forward_forward (fwd)) | |
| 1362 = !NILP (newval); | |
| 1363 return; | |
| 1364 | |
| 1365 case SYMVAL_OBJECT_FORWARD: | |
| 1366 if (magicfun) | |
| 1367 magicfun (sym, &newval, Qnil, 0); | |
| 1368 *((Lisp_Object *) symbol_value_forward_forward (fwd)) = newval; | |
| 1369 return; | |
| 1370 | |
| 1371 case SYMVAL_DEFAULT_BUFFER_FORWARD: | |
| 1372 set_default_buffer_slot_variable (sym, newval); | |
| 1373 return; | |
| 1374 | |
| 1375 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 1376 if (magicfun) | |
| 771 | 1377 magicfun (sym, &newval, wrap_buffer (current_buffer), 0); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1378 *((Lisp_Object *) ((Rawbyte *) current_buffer |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1379 + ((Rawbyte *) symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1380 - (Rawbyte *) &buffer_local_flags))) |
| 428 | 1381 = newval; |
| 1382 return; | |
| 1383 | |
| 1384 case SYMVAL_DEFAULT_CONSOLE_FORWARD: | |
| 1385 set_default_console_slot_variable (sym, newval); | |
| 1386 return; | |
| 1387 | |
| 1388 case SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 1389 if (magicfun) | |
| 1390 magicfun (sym, &newval, Vselected_console, 0); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1391 *((Lisp_Object *) ((Rawbyte *) XCONSOLE (Vselected_console) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1392 + ((Rawbyte *) symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
1393 - (Rawbyte *) &console_local_flags))) |
| 428 | 1394 = newval; |
| 1395 return; | |
| 1396 | |
| 1397 default: | |
| 2500 | 1398 ABORT (); |
| 428 | 1399 } |
| 1400 } | |
| 1401 } | |
| 1402 | |
| 1403 /* Given a per-buffer variable SYMBOL and its raw value-cell contents | |
| 1404 BFWD, locate and return a pointer to the element in BUFFER's | |
| 1405 local_var_alist for SYMBOL. The return value will be Qnil if | |
| 1406 BUFFER does not have its own value for SYMBOL (i.e. the default | |
| 1407 value is seen in that buffer). | |
| 1408 */ | |
| 1409 | |
| 1410 static Lisp_Object | |
| 1411 buffer_local_alist_element (struct buffer *buffer, Lisp_Object symbol, | |
| 1412 struct symbol_value_buffer_local *bfwd) | |
| 1413 { | |
| 1414 if (!NILP (bfwd->current_buffer) && | |
| 1415 XBUFFER (bfwd->current_buffer) == buffer) | |
| 1416 /* This is just an optimization of the below. */ | |
| 1417 return bfwd->current_alist_element; | |
| 1418 else | |
| 1419 return assq_no_quit (symbol, buffer->local_var_alist); | |
| 1420 } | |
| 1421 | |
| 1422 /* [Remember that the slot that mirrors CURRENT-VALUE in the | |
| 1423 symbol-value-buffer-local of a per-buffer variable -- i.e. the | |
| 1424 slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE | |
| 1425 slot -- may be out of date.] | |
| 1426 | |
| 1427 Write out any cached value in buffer-local variable SYMBOL's | |
| 1428 buffer-local structure, which is passed in as BFWD. | |
| 1429 */ | |
| 1430 | |
| 1431 static void | |
| 2286 | 1432 write_out_buffer_local_cache (Lisp_Object UNUSED (symbol), |
| 428 | 1433 struct symbol_value_buffer_local *bfwd) |
| 1434 { | |
| 1435 if (!NILP (bfwd->current_buffer)) | |
| 1436 { | |
| 1437 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD | |
| 1438 uses it, and that type cannot be inside a symbol-value-buffer-local */ | |
| 1439 Lisp_Object cval = do_symval_forwarding (bfwd->current_value, 0, 0); | |
| 1440 if (NILP (bfwd->current_alist_element)) | |
| 1441 /* current_value may be updated more recently than default_value */ | |
| 1442 bfwd->default_value = cval; | |
| 1443 else | |
| 1444 Fsetcdr (bfwd->current_alist_element, cval); | |
| 1445 } | |
| 1446 } | |
| 1447 | |
| 1448 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure. | |
| 1449 Set up BFWD's cache for validity in buffer BUF. This assumes that | |
| 1450 the cache is currently in a consistent state (this can include | |
| 1451 not having any value cached, if BFWD->CURRENT_BUFFER is nil). | |
| 1452 | |
| 1453 If the cache is already set up for BUF, this function does nothing | |
| 1454 at all. | |
| 1455 | |
| 1456 Otherwise, if SYM forwards out to a C variable, this also forwards | |
| 1457 SYM's value in BUF out to the variable. Therefore, you generally | |
| 1458 only want to call this when BUF is, or is about to become, the | |
| 1459 current buffer. | |
| 1460 | |
| 1461 (Otherwise, you can just retrieve the value without changing the | |
| 1462 cache, at the expense of slower retrieval.) | |
| 1463 */ | |
| 1464 | |
| 1465 static void | |
| 1466 set_up_buffer_local_cache (Lisp_Object sym, | |
| 1467 struct symbol_value_buffer_local *bfwd, | |
| 1468 struct buffer *buf, | |
| 1469 Lisp_Object new_alist_el, | |
| 1470 int set_it_p) | |
| 1471 { | |
| 1472 Lisp_Object new_val; | |
| 1473 | |
| 1474 if (!NILP (bfwd->current_buffer) | |
| 1475 && buf == XBUFFER (bfwd->current_buffer)) | |
| 1476 /* Cache is already set up. */ | |
| 1477 return; | |
| 1478 | |
| 1479 /* Flush out the old cache. */ | |
| 1480 write_out_buffer_local_cache (sym, bfwd); | |
| 1481 | |
| 1482 /* Retrieve the new alist element and new value. */ | |
| 1483 if (NILP (new_alist_el) | |
| 1484 && set_it_p) | |
| 1485 new_alist_el = buffer_local_alist_element (buf, sym, bfwd); | |
| 1486 | |
| 1487 if (NILP (new_alist_el)) | |
| 1488 new_val = bfwd->default_value; | |
| 1489 else | |
| 1490 new_val = Fcdr (new_alist_el); | |
| 1491 | |
| 1492 bfwd->current_alist_element = new_alist_el; | |
| 793 | 1493 bfwd->current_buffer = wrap_buffer (buf); |
| 428 | 1494 |
| 1495 /* Now store the value into the current-value slot. | |
| 1496 We don't simply write it there, because the current-value | |
| 1497 slot might be a forwarding pointer, in which case we need | |
| 1498 to instead write the value into the C variable. | |
| 1499 | |
| 1500 We might also want to call a magic function. | |
| 1501 | |
| 1502 So instead, we call this function. */ | |
| 1503 store_symval_forwarding (sym, bfwd->current_value, new_val); | |
| 1504 } | |
| 1505 | |
| 446 | 1506 |
| 1507 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure. | |
| 1508 Flush the cache. BFWD->CURRENT_BUFFER will be nil after this operation. | |
| 1509 */ | |
| 1510 | |
| 1511 static void | |
| 1512 flush_buffer_local_cache (Lisp_Object sym, | |
| 1513 struct symbol_value_buffer_local *bfwd) | |
| 1514 { | |
| 1515 if (NILP (bfwd->current_buffer)) | |
| 1516 /* Cache is already flushed. */ | |
| 1517 return; | |
| 1518 | |
| 1519 /* Flush out the old cache. */ | |
| 1520 write_out_buffer_local_cache (sym, bfwd); | |
| 1521 | |
| 1522 bfwd->current_alist_element = Qnil; | |
| 1523 bfwd->current_buffer = Qnil; | |
| 1524 | |
| 1525 /* Now store default the value into the current-value slot. | |
| 1526 We don't simply write it there, because the current-value | |
| 1527 slot might be a forwarding pointer, in which case we need | |
| 1528 to instead write the value into the C variable. | |
| 1529 | |
| 1530 We might also want to call a magic function. | |
| 1531 | |
| 1532 So instead, we call this function. */ | |
| 1533 store_symval_forwarding (sym, bfwd->current_value, bfwd->default_value); | |
| 1534 } | |
| 1535 | |
| 1536 /* Flush all the buffer-local variable caches. Whoever has a | |
| 1537 non-interned buffer-local variable will be spanked. Whoever has a | |
| 1538 magic variable that interns or uninterns symbols... I don't even | |
| 1539 want to think about it. | |
| 1540 */ | |
| 1541 | |
| 1542 void | |
| 1543 flush_all_buffer_local_cache (void) | |
| 1544 { | |
| 1545 Lisp_Object *syms = XVECTOR_DATA (Vobarray); | |
| 1546 long count = XVECTOR_LENGTH (Vobarray); | |
| 1547 long i; | |
| 1548 | |
| 1549 for (i=0; i<count; i++) | |
| 1550 { | |
| 1551 Lisp_Object sym = syms[i]; | |
| 1552 Lisp_Object value; | |
| 1553 | |
| 1554 if (!ZEROP (sym)) | |
| 1555 for(;;) | |
| 1556 { | |
| 1557 Lisp_Symbol *next; | |
| 1558 assert (SYMBOLP (sym)); | |
| 1559 value = fetch_value_maybe_past_magic (sym, Qt); | |
| 1560 if (SYMBOL_VALUE_BUFFER_LOCAL_P (value)) | |
| 1561 flush_buffer_local_cache (sym, XSYMBOL_VALUE_BUFFER_LOCAL (value)); | |
| 1562 | |
| 1563 next = symbol_next (XSYMBOL (sym)); | |
| 1564 if (!next) | |
| 1565 break; | |
| 793 | 1566 sym = wrap_symbol (next); |
| 446 | 1567 } |
| 1568 } | |
| 1569 } | |
| 1570 | |
| 428 | 1571 |
| 1572 void | |
| 1573 kill_buffer_local_variables (struct buffer *buf) | |
| 1574 { | |
| 1575 Lisp_Object prev = Qnil; | |
| 1576 Lisp_Object alist; | |
| 1577 | |
| 1578 /* Any which are supposed to be permanent, | |
| 1579 make local again, with the same values they had. */ | |
| 1580 | |
| 1581 for (alist = buf->local_var_alist; !NILP (alist); alist = XCDR (alist)) | |
| 1582 { | |
| 1583 Lisp_Object sym = XCAR (XCAR (alist)); | |
| 1584 struct symbol_value_buffer_local *bfwd; | |
| 1585 /* Variables with a symbol-value-varalias should not be here | |
| 1586 (we should have forwarded past them) and there must be a | |
| 1587 symbol-value-buffer-local. If there's a symbol-value-lisp-magic, | |
| 1588 just forward past it; if the variable has a handler, it was | |
| 1589 already called. */ | |
| 1590 Lisp_Object value = fetch_value_maybe_past_magic (sym, Qt); | |
| 1591 | |
| 1592 assert (SYMBOL_VALUE_BUFFER_LOCAL_P (value)); | |
| 1593 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (value); | |
| 1594 | |
| 1595 if (!NILP (Fget (sym, Qpermanent_local, Qnil))) | |
| 1596 /* prev points to the last alist element that is still | |
| 1597 staying around, so *only* update it now. This didn't | |
| 1598 used to be the case; this bug has been around since | |
| 1599 mly's rewrite two years ago! */ | |
| 1600 prev = alist; | |
| 1601 else | |
| 1602 { | |
| 1603 /* Really truly kill it. */ | |
| 1604 if (!NILP (prev)) | |
| 1605 XCDR (prev) = XCDR (alist); | |
| 1606 else | |
| 1607 buf->local_var_alist = XCDR (alist); | |
| 1608 | |
| 1609 /* We just effectively changed the value for this variable | |
| 1610 in BUF. So: */ | |
| 1611 | |
| 1612 /* (1) If the cache is caching BUF, invalidate the cache. */ | |
| 1613 if (!NILP (bfwd->current_buffer) && | |
| 1614 buf == XBUFFER (bfwd->current_buffer)) | |
| 1615 bfwd->current_buffer = Qnil; | |
| 1616 | |
| 1617 /* (2) If we changed the value in current_buffer and this | |
| 1618 variable forwards to a C variable, we need to change the | |
| 1619 value of the C variable. set_up_buffer_local_cache() | |
| 1620 will do this. It doesn't hurt to do it whenever | |
| 1621 BUF == current_buffer, so just go ahead and do that. */ | |
| 1622 if (buf == current_buffer) | |
| 1623 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0); | |
| 1624 } | |
| 1625 } | |
| 1626 } | |
| 1627 | |
| 1628 static Lisp_Object | |
| 1629 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf, | |
| 1630 struct console *con, int swap_it_in, | |
| 1631 Lisp_Object symcons, int set_it_p) | |
| 1632 { | |
| 1633 Lisp_Object valcontents; | |
| 1634 | |
| 1635 retry: | |
| 1636 valcontents = XSYMBOL (sym)->value; | |
| 1637 | |
| 1638 retry_2: | |
| 1639 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 1640 return valcontents; | |
| 1641 | |
| 1642 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 1643 { | |
| 1644 case SYMVAL_LISP_MAGIC: | |
| 1645 /* #### kludge */ | |
| 1646 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 1647 /* semi-change-o */ | |
| 1648 goto retry_2; | |
| 1649 | |
| 1650 case SYMVAL_VARALIAS: | |
| 1651 sym = follow_varalias_pointers (sym, Qt /* #### kludge */); | |
| 1652 symcons = Qnil; | |
| 1653 /* presto change-o! */ | |
| 1654 goto retry; | |
| 1655 | |
| 1656 case SYMVAL_BUFFER_LOCAL: | |
| 1657 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 1658 { | |
| 1659 struct symbol_value_buffer_local *bfwd | |
| 1660 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 1661 | |
| 1662 if (swap_it_in) | |
| 1663 { | |
| 1664 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p); | |
| 1665 valcontents = bfwd->current_value; | |
| 1666 } | |
| 1667 else | |
| 1668 { | |
| 1669 if (!NILP (bfwd->current_buffer) && | |
| 1670 buf == XBUFFER (bfwd->current_buffer)) | |
| 1671 valcontents = bfwd->current_value; | |
| 1672 else if (NILP (symcons)) | |
| 1673 { | |
| 1674 if (set_it_p) | |
| 1675 valcontents = assq_no_quit (sym, buf->local_var_alist); | |
| 1676 if (NILP (valcontents)) | |
| 1677 valcontents = bfwd->default_value; | |
| 1678 else | |
| 1679 valcontents = XCDR (valcontents); | |
| 1680 } | |
| 1681 else | |
| 1682 valcontents = XCDR (symcons); | |
| 1683 } | |
| 1684 break; | |
| 1685 } | |
| 1686 | |
| 1687 default: | |
| 1688 break; | |
| 1689 } | |
| 1690 return do_symval_forwarding (valcontents, buf, con); | |
| 1691 } | |
| 1692 | |
| 1693 | |
| 1694 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not | |
| 1695 bound. Note that it must not be possible to QUIT within this | |
| 1696 function. */ | |
| 1697 | |
| 1698 Lisp_Object | |
| 1699 symbol_value_in_buffer (Lisp_Object sym, Lisp_Object buffer) | |
| 1700 { | |
| 1701 struct buffer *buf; | |
| 1702 | |
| 1703 CHECK_SYMBOL (sym); | |
| 1704 | |
| 1705 if (NILP (buffer)) | |
| 1706 buf = current_buffer; | |
| 1707 else | |
| 1708 { | |
| 1709 CHECK_BUFFER (buffer); | |
| 1710 buf = XBUFFER (buffer); | |
| 1711 } | |
| 1712 | |
| 1713 return find_symbol_value_1 (sym, buf, | |
| 1714 /* If it bombs out at startup due to a | |
| 1715 Lisp error, this may be nil. */ | |
| 1716 CONSOLEP (Vselected_console) | |
| 1717 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1); | |
| 1718 } | |
| 1719 | |
| 1720 static Lisp_Object | |
| 1721 symbol_value_in_console (Lisp_Object sym, Lisp_Object console) | |
| 1722 { | |
| 1723 CHECK_SYMBOL (sym); | |
| 1724 | |
| 1725 if (NILP (console)) | |
| 1726 console = Vselected_console; | |
| 1727 else | |
| 1728 CHECK_CONSOLE (console); | |
| 1729 | |
| 1730 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0, | |
| 1731 Qnil, 1); | |
| 1732 } | |
| 1733 | |
| 1734 /* Return the current value of SYM. The difference between this function | |
| 1735 and calling symbol_value_in_buffer with a BUFFER of Qnil is that | |
| 1736 this updates the CURRENT_VALUE slot of buffer-local variables to | |
| 1737 point to the current buffer, while symbol_value_in_buffer doesn't. */ | |
| 1738 | |
| 1739 Lisp_Object | |
| 1740 find_symbol_value (Lisp_Object sym) | |
| 1741 { | |
| 1742 /* WARNING: This function can be called when current_buffer is 0 | |
| 1743 and Vselected_console is Qnil, early in initialization. */ | |
| 1744 struct console *con; | |
| 1745 Lisp_Object valcontents; | |
| 1746 | |
| 1747 CHECK_SYMBOL (sym); | |
| 1748 | |
| 1749 valcontents = XSYMBOL (sym)->value; | |
| 1750 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 1751 return valcontents; | |
| 1752 | |
| 1753 if (CONSOLEP (Vselected_console)) | |
| 1754 con = XCONSOLE (Vselected_console); | |
| 1755 else | |
| 1756 { | |
| 1757 /* This can also get called while we're preparing to shutdown. | |
| 1758 #### What should really happen in that case? Should we | |
| 1759 actually fix things so we can't get here in that case? */ | |
| 1760 #ifndef PDUMP | |
| 1761 assert (!initialized || preparing_for_armageddon); | |
| 1762 #endif | |
| 1763 con = 0; | |
| 1764 } | |
| 1765 | |
| 1766 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1); | |
| 1767 } | |
| 1768 | |
| 1769 /* This is an optimized function for quick lookup of buffer local symbols | |
| 1770 by avoiding O(n) search. This will work when either: | |
| 1771 a) We have already found the symbol e.g. by traversing local_var_alist. | |
| 1772 or | |
| 1773 b) We know that the symbol will not be found in the current buffer's | |
| 1774 list of local variables. | |
| 1775 In the former case, find_it_p is 1 and symbol_cons is the element from | |
| 1776 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons | |
| 1777 is the symbol. | |
| 1778 | |
| 1779 This function is called from set_buffer_internal which does both of these | |
| 1780 things. */ | |
| 1781 | |
| 1782 Lisp_Object | |
| 1783 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p) | |
| 1784 { | |
| 1785 /* WARNING: This function can be called when current_buffer is 0 | |
| 1786 and Vselected_console is Qnil, early in initialization. */ | |
| 1787 struct console *con; | |
| 1788 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons; | |
| 1789 | |
| 1790 CHECK_SYMBOL (sym); | |
| 1791 if (CONSOLEP (Vselected_console)) | |
| 1792 con = XCONSOLE (Vselected_console); | |
| 1793 else | |
| 1794 { | |
| 1795 /* This can also get called while we're preparing to shutdown. | |
| 1796 #### What should really happen in that case? Should we | |
| 1797 actually fix things so we can't get here in that case? */ | |
| 1798 #ifndef PDUMP | |
| 1799 assert (!initialized || preparing_for_armageddon); | |
| 1800 #endif | |
| 1801 con = 0; | |
| 1802 } | |
| 1803 | |
| 1804 return find_symbol_value_1 (sym, current_buffer, con, 1, | |
| 1805 find_it_p ? symbol_cons : Qnil, | |
| 1806 find_it_p); | |
| 1807 } | |
| 1808 | |
| 1809 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /* | |
| 1810 Return SYMBOL's value. Error if that is void. | |
| 1811 */ | |
| 1812 (symbol)) | |
| 1813 { | |
| 1814 Lisp_Object val = find_symbol_value (symbol); | |
| 1815 | |
| 1816 if (UNBOUNDP (val)) | |
| 1817 return Fsignal (Qvoid_variable, list1 (symbol)); | |
| 1818 else | |
| 1819 return val; | |
| 1820 } | |
| 1821 | |
| 1822 DEFUN ("set", Fset, 2, 2, 0, /* | |
| 1823 Set SYMBOL's value to NEWVAL, and return NEWVAL. | |
| 1824 */ | |
| 1825 (symbol, newval)) | |
| 1826 { | |
| 1827 REGISTER Lisp_Object valcontents; | |
| 440 | 1828 Lisp_Symbol *sym; |
| 428 | 1829 /* remember, we're called by Fmakunbound() as well */ |
| 1830 | |
| 1831 CHECK_SYMBOL (symbol); | |
| 1832 | |
| 1833 retry: | |
| 1834 sym = XSYMBOL (symbol); | |
| 1835 valcontents = sym->value; | |
| 1836 | |
| 1837 if (EQ (symbol, Qnil) || | |
| 1838 EQ (symbol, Qt) || | |
| 1839 SYMBOL_IS_KEYWORD (symbol)) | |
| 1840 reject_constant_symbols (symbol, newval, 0, | |
| 1841 UNBOUNDP (newval) ? Qmakunbound : Qset); | |
| 1842 | |
| 1843 if (!SYMBOL_VALUE_MAGIC_P (valcontents) || UNBOUNDP (valcontents)) | |
| 1844 { | |
| 1845 sym->value = newval; | |
| 1846 return newval; | |
| 1847 } | |
| 1848 | |
| 1849 reject_constant_symbols (symbol, newval, 0, | |
| 1850 UNBOUNDP (newval) ? Qmakunbound : Qset); | |
| 1851 | |
| 1852 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 1853 { | |
| 1854 case SYMVAL_LISP_MAGIC: | |
| 1855 { | |
| 1856 if (UNBOUNDP (newval)) | |
| 440 | 1857 { |
| 1858 maybe_call_magic_handler (symbol, Qmakunbound, 0); | |
| 1859 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = Qunbound; | |
| 1860 } | |
| 428 | 1861 else |
| 440 | 1862 { |
| 1863 maybe_call_magic_handler (symbol, Qset, 1, newval); | |
| 1864 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = newval; | |
| 1865 } | |
| 428 | 1866 } |
| 1867 | |
| 1868 case SYMVAL_VARALIAS: | |
| 1869 symbol = follow_varalias_pointers (symbol, | |
| 1870 UNBOUNDP (newval) | |
| 1871 ? Qmakunbound : Qset); | |
| 1872 /* presto change-o! */ | |
| 1873 goto retry; | |
| 1874 | |
| 1875 case SYMVAL_FIXNUM_FORWARD: | |
| 996 | 1876 case SYMVAL_CONST_FIXNUM_FORWARD: |
| 428 | 1877 case SYMVAL_BOOLEAN_FORWARD: |
| 996 | 1878 case SYMVAL_CONST_BOOLEAN_FORWARD: |
| 428 | 1879 case SYMVAL_DEFAULT_BUFFER_FORWARD: |
| 1880 case SYMVAL_DEFAULT_CONSOLE_FORWARD: | |
| 1881 if (UNBOUNDP (newval)) | |
| 996 | 1882 { |
| 1883 #ifdef HAVE_SHLIB | |
| 1884 if (unloading_module) | |
| 1885 { | |
| 1886 sym->value = newval; | |
| 1887 return newval; | |
| 1888 } | |
| 1889 else | |
| 1890 #endif | |
| 1891 invalid_change ("Cannot makunbound", symbol); | |
| 1892 } | |
| 1893 break; | |
| 1894 | |
| 1895 case SYMVAL_OBJECT_FORWARD: | |
| 1896 case SYMVAL_CONST_OBJECT_FORWARD: | |
| 1897 if (UNBOUNDP (newval)) | |
| 1898 { | |
| 1899 #ifdef HAVE_SHLIB | |
| 1900 if (unloading_module) | |
| 1901 { | |
| 1111 | 1902 unstaticpro_nodump ((Lisp_Object *) |
| 1903 symbol_value_forward_forward | |
| 996 | 1904 (XSYMBOL_VALUE_FORWARD (valcontents))); |
| 1905 sym->value = newval; | |
| 1906 return newval; | |
| 1907 } | |
| 1908 else | |
| 1909 #endif | |
| 1910 invalid_change ("Cannot makunbound", symbol); | |
| 1911 } | |
| 428 | 1912 break; |
| 1913 | |
| 1914 /* case SYMVAL_UNBOUND_MARKER: break; */ | |
| 1915 | |
| 1916 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 1917 { | |
| 442 | 1918 const struct symbol_value_forward *fwd |
| 428 | 1919 = XSYMBOL_VALUE_FORWARD (valcontents); |
| 1920 int mask = XINT (*((Lisp_Object *) | |
| 1921 symbol_value_forward_forward (fwd))); | |
| 1922 if (mask > 0) | |
| 1923 /* Setting this variable makes it buffer-local */ | |
| 1924 current_buffer->local_var_flags |= mask; | |
| 1925 break; | |
| 1926 } | |
| 1927 | |
| 1928 case SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 1929 { | |
| 442 | 1930 const struct symbol_value_forward *fwd |
| 428 | 1931 = XSYMBOL_VALUE_FORWARD (valcontents); |
| 1932 int mask = XINT (*((Lisp_Object *) | |
| 1933 symbol_value_forward_forward (fwd))); | |
| 1934 if (mask > 0) | |
| 1935 /* Setting this variable makes it console-local */ | |
| 1936 XCONSOLE (Vselected_console)->local_var_flags |= mask; | |
| 1937 break; | |
| 1938 } | |
| 1939 | |
| 1940 case SYMVAL_BUFFER_LOCAL: | |
| 1941 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 1942 { | |
| 1943 /* If we want to examine or set the value and | |
| 1944 CURRENT-BUFFER is current, we just examine or set | |
| 1945 CURRENT-VALUE. If CURRENT-BUFFER is not current, we | |
| 1946 store the current CURRENT-VALUE value into | |
| 1947 CURRENT-ALIST- ELEMENT, then find the appropriate alist | |
| 1948 element for the buffer now current and set up | |
| 1949 CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE out | |
| 1950 of that element, and store into CURRENT-BUFFER. | |
| 1951 | |
| 1952 If we are setting the variable and the current buffer does | |
| 1953 not have an alist entry for this variable, an alist entry is | |
| 1954 created. | |
| 1955 | |
| 1956 Note that CURRENT-VALUE can be a forwarding pointer. | |
| 1957 Each time it is examined or set, forwarding must be | |
| 1958 done. */ | |
| 1959 struct symbol_value_buffer_local *bfwd | |
| 1960 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 1961 int some_buffer_local_p = | |
| 1962 (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL); | |
| 1963 /* What value are we caching right now? */ | |
| 1964 Lisp_Object aelt = bfwd->current_alist_element; | |
| 1965 | |
| 1966 if (!NILP (bfwd->current_buffer) && | |
| 1967 current_buffer == XBUFFER (bfwd->current_buffer) | |
| 1968 && ((some_buffer_local_p) | |
| 1969 ? 1 /* doesn't automatically become local */ | |
| 1970 : !NILP (aelt) /* already local */ | |
| 1971 )) | |
| 1972 { | |
| 1973 /* Cache is valid */ | |
| 1974 valcontents = bfwd->current_value; | |
| 1975 } | |
| 1976 else | |
| 1977 { | |
| 1978 /* If the current buffer is not the buffer whose binding is | |
| 1979 currently cached, or if it's a SYMVAL_BUFFER_LOCAL and | |
| 1980 we're looking at the default value, the cache is invalid; we | |
| 1981 need to write it out, and find the new CURRENT-ALIST-ELEMENT | |
| 1982 */ | |
| 1983 | |
| 1984 /* Write out the cached value for the old buffer; copy it | |
| 1985 back to its alist element. This works if the current | |
| 1986 buffer only sees the default value, too. */ | |
| 1987 write_out_buffer_local_cache (symbol, bfwd); | |
| 1988 | |
| 1989 /* Find the new value for CURRENT-ALIST-ELEMENT. */ | |
| 1990 aelt = buffer_local_alist_element (current_buffer, symbol, bfwd); | |
| 1991 if (NILP (aelt)) | |
| 1992 { | |
| 1993 /* This buffer is still seeing the default value. */ | |
| 1994 if (!some_buffer_local_p) | |
| 1995 { | |
| 1996 /* If it's a SYMVAL_BUFFER_LOCAL, give this buffer a | |
| 1997 new assoc for a local value and set | |
| 1998 CURRENT-ALIST-ELEMENT to point to that. */ | |
| 1999 aelt = | |
| 2000 do_symval_forwarding (bfwd->current_value, | |
| 2001 current_buffer, | |
| 2002 XCONSOLE (Vselected_console)); | |
| 2003 aelt = Fcons (symbol, aelt); | |
| 2004 current_buffer->local_var_alist | |
| 2005 = Fcons (aelt, current_buffer->local_var_alist); | |
| 2006 } | |
| 2007 else | |
| 2008 { | |
| 2009 /* If the variable is a SYMVAL_SOME_BUFFER_LOCAL, | |
| 2010 we're currently seeing the default value. */ | |
| 2011 ; | |
| 2012 } | |
| 2013 } | |
| 2014 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */ | |
| 2015 bfwd->current_alist_element = aelt; | |
| 2016 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */ | |
| 793 | 2017 bfwd->current_buffer = wrap_buffer (current_buffer); |
| 428 | 2018 valcontents = bfwd->current_value; |
| 2019 } | |
| 2020 break; | |
| 2021 } | |
| 2022 default: | |
| 2500 | 2023 ABORT (); |
| 428 | 2024 } |
| 2025 store_symval_forwarding (symbol, valcontents, newval); | |
| 2026 | |
| 2027 return newval; | |
| 2028 } | |
| 2029 | |
| 2030 | |
| 2031 /* Access or set a buffer-local symbol's default value. */ | |
| 2032 | |
| 2033 /* Return the default value of SYM, but don't check for voidness. | |
| 2034 Return Qunbound if it is void. */ | |
| 2035 | |
| 2036 static Lisp_Object | |
| 2037 default_value (Lisp_Object sym) | |
| 2038 { | |
| 2039 Lisp_Object valcontents; | |
| 2040 | |
| 2041 CHECK_SYMBOL (sym); | |
| 2042 | |
| 2043 retry: | |
| 2044 valcontents = XSYMBOL (sym)->value; | |
| 2045 | |
| 2046 retry_2: | |
| 2047 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2048 return valcontents; | |
| 2049 | |
| 2050 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2051 { | |
| 2052 case SYMVAL_LISP_MAGIC: | |
| 2053 /* #### kludge */ | |
| 2054 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2055 /* semi-change-o */ | |
| 2056 goto retry_2; | |
| 2057 | |
| 2058 case SYMVAL_VARALIAS: | |
| 2059 sym = follow_varalias_pointers (sym, Qt /* #### kludge */); | |
| 2060 /* presto change-o! */ | |
| 2061 goto retry; | |
| 2062 | |
| 2063 case SYMVAL_UNBOUND_MARKER: | |
| 2064 return valcontents; | |
| 2065 | |
| 2066 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 2067 { | |
| 442 | 2068 const struct symbol_value_forward *fwd |
| 428 | 2069 = XSYMBOL_VALUE_FORWARD (valcontents); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2070 return (*((Lisp_Object *)((Rawbyte *) XBUFFER (Vbuffer_defaults) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2071 + ((Rawbyte *)symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2072 - (Rawbyte *)&buffer_local_flags)))); |
| 428 | 2073 } |
| 2074 | |
| 2075 case SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 2076 { | |
| 442 | 2077 const struct symbol_value_forward *fwd |
| 428 | 2078 = XSYMBOL_VALUE_FORWARD (valcontents); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2079 return (*((Lisp_Object *)((Rawbyte *) XCONSOLE (Vconsole_defaults) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2080 + ((Rawbyte *)symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2081 - (Rawbyte *)&console_local_flags)))); |
| 428 | 2082 } |
| 2083 | |
| 2084 case SYMVAL_BUFFER_LOCAL: | |
| 2085 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 2086 { | |
| 2087 struct symbol_value_buffer_local *bfwd = | |
| 2088 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 2089 | |
| 2090 /* Handle user-created local variables. */ | |
| 2091 /* If var is set up for a buffer that lacks a local value for it, | |
| 2092 the current value is nominally the default value. | |
| 2093 But the current value slot may be more up to date, since | |
| 2094 ordinary setq stores just that slot. So use that. */ | |
| 2095 if (NILP (bfwd->current_alist_element)) | |
| 2096 return do_symval_forwarding (bfwd->current_value, current_buffer, | |
| 2097 XCONSOLE (Vselected_console)); | |
| 2098 else | |
| 2099 return bfwd->default_value; | |
| 2100 } | |
| 2101 default: | |
| 2102 /* For other variables, get the current value. */ | |
| 2103 return do_symval_forwarding (valcontents, current_buffer, | |
| 2104 XCONSOLE (Vselected_console)); | |
| 2105 } | |
| 2106 | |
| 1204 | 2107 RETURN_NOT_REACHED (Qnil); /* suppress compiler warning */ |
| 428 | 2108 } |
| 2109 | |
| 2110 DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /* | |
| 2111 Return t if SYMBOL has a non-void default value. | |
| 2112 This is the value that is seen in buffers that do not have their own values | |
| 2113 for this variable. | |
| 2114 */ | |
| 2115 (symbol)) | |
| 2116 { | |
| 2117 return UNBOUNDP (default_value (symbol)) ? Qnil : Qt; | |
| 2118 } | |
| 2119 | |
| 2120 DEFUN ("default-value", Fdefault_value, 1, 1, 0, /* | |
| 2121 Return SYMBOL's default value. | |
| 2122 This is the value that is seen in buffers that do not have their own values | |
| 2123 for this variable. The default value is meaningful for variables with | |
| 2124 local bindings in certain buffers. | |
| 2125 */ | |
| 2126 (symbol)) | |
| 2127 { | |
| 2128 Lisp_Object value = default_value (symbol); | |
| 2129 | |
| 2130 return UNBOUNDP (value) ? Fsignal (Qvoid_variable, list1 (symbol)) : value; | |
| 2131 } | |
| 2132 | |
| 2133 DEFUN ("set-default", Fset_default, 2, 2, 0, /* | |
| 444 | 2134 Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated. |
| 428 | 2135 The default value is seen in buffers that do not have their own values |
| 2136 for this variable. | |
| 2137 */ | |
| 2138 (symbol, value)) | |
| 2139 { | |
| 2140 Lisp_Object valcontents; | |
| 2141 | |
| 2142 CHECK_SYMBOL (symbol); | |
| 2143 | |
| 2144 retry: | |
| 2145 valcontents = XSYMBOL (symbol)->value; | |
| 2146 | |
| 2147 retry_2: | |
| 2148 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2149 return Fset (symbol, value); | |
| 2150 | |
| 2151 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2152 { | |
| 2153 case SYMVAL_LISP_MAGIC: | |
| 2154 RETURN_IF_NOT_UNBOUND (maybe_call_magic_handler (symbol, Qset_default, 1, | |
| 2155 value)); | |
| 2156 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2157 /* semi-change-o */ | |
| 2158 goto retry_2; | |
| 2159 | |
| 2160 case SYMVAL_VARALIAS: | |
| 2161 symbol = follow_varalias_pointers (symbol, Qset_default); | |
| 2162 /* presto change-o! */ | |
| 2163 goto retry; | |
| 2164 | |
| 2165 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 2166 set_default_buffer_slot_variable (symbol, value); | |
| 2167 return value; | |
| 2168 | |
| 2169 case SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 2170 set_default_console_slot_variable (symbol, value); | |
| 2171 return value; | |
| 2172 | |
| 2173 case SYMVAL_BUFFER_LOCAL: | |
| 2174 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 2175 { | |
| 2176 /* Store new value into the DEFAULT-VALUE slot */ | |
| 2177 struct symbol_value_buffer_local *bfwd | |
| 2178 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 2179 | |
| 2180 bfwd->default_value = value; | |
| 2181 /* If current-buffer doesn't shadow default_value, | |
| 2182 * we must set the CURRENT-VALUE slot too */ | |
| 2183 if (NILP (bfwd->current_alist_element)) | |
| 2184 store_symval_forwarding (symbol, bfwd->current_value, value); | |
| 2185 return value; | |
| 2186 } | |
| 2187 | |
| 2188 default: | |
| 2189 return Fset (symbol, value); | |
| 2190 } | |
| 2191 } | |
| 2192 | |
| 2193 DEFUN ("setq-default", Fsetq_default, 0, UNEVALLED, 0, /* | |
| 2194 Set the default value of variable SYMBOL to VALUE. | |
| 2195 SYMBOL, the variable name, is literal (not evaluated); | |
| 2196 VALUE is an expression and it is evaluated. | |
| 2197 The default value of a variable is seen in buffers | |
| 2198 that do not have their own values for the variable. | |
| 2199 | |
| 2200 More generally, you can use multiple variables and values, as in | |
| 2201 (setq-default SYMBOL VALUE SYMBOL VALUE...) | |
| 2202 This sets each SYMBOL's default value to the corresponding VALUE. | |
| 2203 The VALUE for the Nth SYMBOL can refer to the new default values | |
| 2204 of previous SYMBOLs. | |
| 2205 */ | |
| 2206 (args)) | |
| 2207 { | |
| 2208 /* This function can GC */ | |
| 2209 int nargs; | |
| 2421 | 2210 Lisp_Object retval = Qnil; |
| 428 | 2211 |
| 2212 GET_LIST_LENGTH (args, nargs); | |
| 2213 | |
| 2214 if (nargs & 1) /* Odd number of arguments? */ | |
| 2215 Fsignal (Qwrong_number_of_arguments, | |
| 2216 list2 (Qsetq_default, make_int (nargs))); | |
| 2217 | |
| 2421 | 2218 GC_PROPERTY_LIST_LOOP_3 (symbol, val, args) |
| 428 | 2219 { |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4642
diff
changeset
|
2220 val = IGNORE_MULTIPLE_VALUES (Feval (val)); |
| 428 | 2221 Fset_default (symbol, val); |
| 2421 | 2222 retval = val; |
| 428 | 2223 } |
| 2224 | |
| 2421 | 2225 END_GC_PROPERTY_LIST_LOOP (symbol); |
| 2226 return retval; | |
| 428 | 2227 } |
| 2228 | |
| 2229 /* Lisp functions for creating and removing buffer-local variables. */ | |
| 2230 | |
| 2231 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1, | |
| 2232 "vMake Variable Buffer Local: ", /* | |
| 2233 Make VARIABLE have a separate value for each buffer. | |
| 2234 At any time, the value for the current buffer is in effect. | |
| 2235 There is also a default value which is seen in any buffer which has not yet | |
| 2236 set its own value. | |
| 2237 Using `set' or `setq' to set the variable causes it to have a separate value | |
| 2238 for the current buffer if it was previously using the default value. | |
| 2239 The function `default-value' gets the default value and `set-default' | |
| 2240 sets it. | |
| 2241 */ | |
| 2242 (variable)) | |
| 2243 { | |
| 2244 Lisp_Object valcontents; | |
| 2245 | |
| 2246 CHECK_SYMBOL (variable); | |
| 2247 | |
| 2248 retry: | |
| 2249 verify_ok_for_buffer_local (variable, Qmake_variable_buffer_local); | |
| 2250 | |
| 2251 valcontents = XSYMBOL (variable)->value; | |
| 2252 | |
| 2253 retry_2: | |
| 2254 if (SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2255 { | |
| 2256 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2257 { | |
| 2258 case SYMVAL_LISP_MAGIC: | |
| 2259 if (!UNBOUNDP (maybe_call_magic_handler | |
| 2260 (variable, Qmake_variable_buffer_local, 0))) | |
| 2261 return variable; | |
| 2262 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2263 /* semi-change-o */ | |
| 2264 goto retry_2; | |
| 2265 | |
| 2266 case SYMVAL_VARALIAS: | |
| 2267 variable = follow_varalias_pointers (variable, | |
| 2268 Qmake_variable_buffer_local); | |
| 2269 /* presto change-o! */ | |
| 2270 goto retry; | |
| 2271 | |
| 2272 case SYMVAL_FIXNUM_FORWARD: | |
| 2273 case SYMVAL_BOOLEAN_FORWARD: | |
| 2274 case SYMVAL_OBJECT_FORWARD: | |
| 2275 case SYMVAL_UNBOUND_MARKER: | |
| 2276 break; | |
| 2277 | |
| 2278 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 2279 case SYMVAL_BUFFER_LOCAL: | |
| 2280 /* Already per-each-buffer */ | |
| 2281 return variable; | |
| 2282 | |
| 2283 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 2284 /* Transmogrify */ | |
| 2285 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->magic.type = | |
| 2286 SYMVAL_BUFFER_LOCAL; | |
| 2287 return variable; | |
| 2288 | |
| 2289 default: | |
| 2500 | 2290 ABORT (); |
| 428 | 2291 } |
| 2292 } | |
| 2293 | |
| 2294 { | |
| 2295 struct symbol_value_buffer_local *bfwd | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
2296 = XSYMBOL_VALUE_BUFFER_LOCAL |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
2297 (ALLOC_NORMAL_LISP_OBJECT (symbol_value_buffer_local)); |
| 428 | 2298 Lisp_Object foo; |
| 2299 bfwd->magic.type = SYMVAL_BUFFER_LOCAL; | |
| 2300 | |
| 2301 bfwd->default_value = find_symbol_value (variable); | |
| 2302 bfwd->current_value = valcontents; | |
| 2303 bfwd->current_alist_element = Qnil; | |
| 2304 bfwd->current_buffer = Fcurrent_buffer (); | |
| 793 | 2305 foo = wrap_symbol_value_magic (bfwd); |
| 428 | 2306 *value_slot_past_magic (variable) = foo; |
| 2307 #if 1 /* #### Yuck! FSFmacs bug-compatibility*/ | |
| 2308 /* This sets the default-value of any make-variable-buffer-local to nil. | |
| 2309 That just sucks. User can just use setq-default to effect that, | |
| 2310 but there's no way to do makunbound-default to undo this lossage. */ | |
| 2311 if (UNBOUNDP (valcontents)) | |
| 2312 bfwd->default_value = Qnil; | |
| 2313 #endif | |
| 2314 #if 0 /* #### Yuck! */ | |
| 2315 /* This sets the value to nil in this buffer. | |
| 2316 User could use (setq variable nil) to do this. | |
| 2317 It isn't as egregious to do this automatically | |
| 2318 as it is to do so to the default-value, but it's | |
| 2319 still really dubious. */ | |
| 2320 if (UNBOUNDP (valcontents)) | |
| 2321 Fset (variable, Qnil); | |
| 2322 #endif | |
| 2323 return variable; | |
| 2324 } | |
| 2325 } | |
| 2326 | |
| 2327 DEFUN ("make-local-variable", Fmake_local_variable, 1, 1, | |
| 2328 "vMake Local Variable: ", /* | |
| 2329 Make VARIABLE have a separate value in the current buffer. | |
| 2330 Other buffers will continue to share a common default value. | |
| 2331 \(The buffer-local value of VARIABLE starts out as the same value | |
| 2332 VARIABLE previously had. If VARIABLE was void, it remains void.) | |
| 2333 See also `make-variable-buffer-local'. | |
| 2334 | |
| 2335 If the variable is already arranged to become local when set, | |
| 2336 this function causes a local value to exist for this buffer, | |
| 2337 just as setting the variable would do. | |
| 2338 | |
| 2339 Do not use `make-local-variable' to make a hook variable buffer-local. | |
| 2340 Use `make-local-hook' instead. | |
| 2341 */ | |
| 2342 (variable)) | |
| 2343 { | |
| 2344 Lisp_Object valcontents; | |
| 2345 struct symbol_value_buffer_local *bfwd; | |
| 2346 | |
| 2347 CHECK_SYMBOL (variable); | |
| 2348 | |
| 2349 retry: | |
| 2350 verify_ok_for_buffer_local (variable, Qmake_local_variable); | |
| 2351 | |
| 2352 valcontents = XSYMBOL (variable)->value; | |
| 2353 | |
| 2354 retry_2: | |
| 2355 if (SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2356 { | |
| 2357 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2358 { | |
| 2359 case SYMVAL_LISP_MAGIC: | |
| 2360 if (!UNBOUNDP (maybe_call_magic_handler | |
| 2361 (variable, Qmake_local_variable, 0))) | |
| 2362 return variable; | |
| 2363 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2364 /* semi-change-o */ | |
| 2365 goto retry_2; | |
| 2366 | |
| 2367 case SYMVAL_VARALIAS: | |
| 2368 variable = follow_varalias_pointers (variable, Qmake_local_variable); | |
| 2369 /* presto change-o! */ | |
| 2370 goto retry; | |
| 2371 | |
| 2372 case SYMVAL_FIXNUM_FORWARD: | |
| 2373 case SYMVAL_BOOLEAN_FORWARD: | |
| 2374 case SYMVAL_OBJECT_FORWARD: | |
| 2375 case SYMVAL_UNBOUND_MARKER: | |
| 2376 break; | |
| 2377 | |
| 2378 case SYMVAL_BUFFER_LOCAL: | |
| 2379 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 2380 { | |
| 2381 /* Make sure the symbol has a local value in this particular | |
| 2382 buffer, by setting it to the same value it already has. */ | |
| 2383 Fset (variable, find_symbol_value (variable)); | |
| 2384 return variable; | |
| 2385 } | |
| 2386 | |
| 2387 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 2388 { | |
| 2389 if (!NILP (buffer_local_alist_element (current_buffer, | |
| 2390 variable, | |
| 2391 (XSYMBOL_VALUE_BUFFER_LOCAL | |
| 2392 (valcontents))))) | |
| 2393 goto already_local_to_current_buffer; | |
| 2394 else | |
| 2395 goto already_local_to_some_other_buffer; | |
| 2396 } | |
| 2397 | |
| 2398 default: | |
| 2500 | 2399 ABORT (); |
| 428 | 2400 } |
| 2401 } | |
| 2402 | |
| 2403 /* Make sure variable is set up to hold per-buffer values */ | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
2404 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
2405 (ALLOC_NORMAL_LISP_OBJECT (symbol_value_buffer_local)); |
| 428 | 2406 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL; |
| 2407 | |
| 2408 bfwd->current_buffer = Qnil; | |
| 2409 bfwd->current_alist_element = Qnil; | |
| 2410 bfwd->current_value = valcontents; | |
| 2411 /* passing 0 is OK because this should never be a | |
| 2412 SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD | |
| 2413 variable. */ | |
| 2414 bfwd->default_value = do_symval_forwarding (valcontents, 0, 0); | |
| 2415 | |
| 2416 #if 0 | |
| 2417 if (UNBOUNDP (bfwd->default_value)) | |
| 2418 bfwd->default_value = Qnil; /* Yuck! */ | |
| 2419 #endif | |
| 2420 | |
| 793 | 2421 valcontents = wrap_symbol_value_magic (bfwd); |
| 428 | 2422 *value_slot_past_magic (variable) = valcontents; |
| 2423 | |
| 2424 already_local_to_some_other_buffer: | |
| 2425 | |
| 2426 /* Make sure this buffer has its own value of variable */ | |
| 2427 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 2428 | |
| 2429 if (UNBOUNDP (bfwd->default_value)) | |
| 2430 { | |
| 2431 /* If default value is unbound, set local value to nil. */ | |
| 793 | 2432 bfwd->current_buffer = wrap_buffer (current_buffer); |
| 428 | 2433 bfwd->current_alist_element = Fcons (variable, Qnil); |
| 2434 current_buffer->local_var_alist = | |
| 2435 Fcons (bfwd->current_alist_element, current_buffer->local_var_alist); | |
| 2436 store_symval_forwarding (variable, bfwd->current_value, Qnil); | |
| 2437 return variable; | |
| 2438 } | |
| 2439 | |
| 2440 current_buffer->local_var_alist | |
| 2441 = Fcons (Fcons (variable, bfwd->default_value), | |
| 2442 current_buffer->local_var_alist); | |
| 2443 | |
| 2444 /* Make sure symbol does not think it is set up for this buffer; | |
| 2445 force it to look once again for this buffer's value */ | |
| 2446 if (!NILP (bfwd->current_buffer) && | |
| 2447 current_buffer == XBUFFER (bfwd->current_buffer)) | |
| 2448 bfwd->current_buffer = Qnil; | |
| 2449 | |
| 2450 already_local_to_current_buffer: | |
| 2451 | |
| 2452 /* If the symbol forwards into a C variable, then swap in the | |
| 2453 variable for this buffer immediately. If C code modifies the | |
| 2454 variable before we swap in, then that new value will clobber the | |
| 2455 default value the next time we swap. */ | |
| 2456 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 2457 if (SYMBOL_VALUE_MAGIC_P (bfwd->current_value)) | |
| 2458 { | |
| 2459 switch (XSYMBOL_VALUE_MAGIC_TYPE (bfwd->current_value)) | |
| 2460 { | |
| 2461 case SYMVAL_FIXNUM_FORWARD: | |
| 2462 case SYMVAL_BOOLEAN_FORWARD: | |
| 2463 case SYMVAL_OBJECT_FORWARD: | |
| 2464 case SYMVAL_DEFAULT_BUFFER_FORWARD: | |
| 2465 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1); | |
| 2466 break; | |
| 2467 | |
| 2468 case SYMVAL_UNBOUND_MARKER: | |
| 2469 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 2470 break; | |
| 2471 | |
| 2472 default: | |
| 2500 | 2473 ABORT (); |
| 428 | 2474 } |
| 2475 } | |
| 2476 | |
| 2477 return variable; | |
| 2478 } | |
| 2479 | |
| 2480 DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1, | |
| 2481 "vKill Local Variable: ", /* | |
| 2482 Make VARIABLE no longer have a separate value in the current buffer. | |
| 2483 From now on the default value will apply in this buffer. | |
| 2484 */ | |
| 2485 (variable)) | |
| 2486 { | |
| 2487 Lisp_Object valcontents; | |
| 2488 | |
| 2489 CHECK_SYMBOL (variable); | |
| 2490 | |
| 2491 retry: | |
| 2492 valcontents = XSYMBOL (variable)->value; | |
| 2493 | |
| 2494 retry_2: | |
| 2495 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2496 return variable; | |
| 2497 | |
| 2498 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2499 { | |
| 2500 case SYMVAL_LISP_MAGIC: | |
| 2501 if (!UNBOUNDP (maybe_call_magic_handler | |
| 2502 (variable, Qkill_local_variable, 0))) | |
| 2503 return variable; | |
| 2504 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2505 /* semi-change-o */ | |
| 2506 goto retry_2; | |
| 2507 | |
| 2508 case SYMVAL_VARALIAS: | |
| 2509 variable = follow_varalias_pointers (variable, Qkill_local_variable); | |
| 2510 /* presto change-o! */ | |
| 2511 goto retry; | |
| 2512 | |
| 2513 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 2514 { | |
| 442 | 2515 const struct symbol_value_forward *fwd |
| 428 | 2516 = XSYMBOL_VALUE_FORWARD (valcontents); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2517 int offset = ((Rawbyte *) symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2518 - (Rawbyte *) &buffer_local_flags); |
| 428 | 2519 int mask = |
| 2520 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); | |
| 2521 | |
| 2522 if (mask > 0) | |
| 2523 { | |
| 2524 int (*magicfun) (Lisp_Object sym, Lisp_Object *val, | |
| 2525 Lisp_Object in_object, int flags) = | |
| 2526 symbol_value_forward_magicfun (fwd); | |
| 2527 Lisp_Object oldval = * (Lisp_Object *) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2528 (offset + (Rawbyte *) XBUFFER (Vbuffer_defaults)); |
| 428 | 2529 if (magicfun) |
| 771 | 2530 (magicfun) (variable, &oldval, wrap_buffer (current_buffer), 0); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2531 *(Lisp_Object *) (offset + (Rawbyte *) current_buffer) |
| 428 | 2532 = oldval; |
| 2533 current_buffer->local_var_flags &= ~mask; | |
| 2534 } | |
| 2535 return variable; | |
| 2536 } | |
| 2537 | |
| 2538 case SYMVAL_BUFFER_LOCAL: | |
| 2539 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 2540 { | |
| 2541 /* Get rid of this buffer's alist element, if any */ | |
| 2542 struct symbol_value_buffer_local *bfwd | |
| 2543 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 2544 Lisp_Object alist = current_buffer->local_var_alist; | |
| 2545 Lisp_Object alist_element | |
| 2546 = buffer_local_alist_element (current_buffer, variable, bfwd); | |
| 2547 | |
| 2548 if (!NILP (alist_element)) | |
|
5338
8608eadee6ba
Move #'delq, #'delete to Lisp, adding support for sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2549 current_buffer->local_var_alist = delq_no_quit (alist_element, |
|
8608eadee6ba
Move #'delq, #'delete to Lisp, adding support for sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5277
diff
changeset
|
2550 alist); |
| 428 | 2551 |
| 2552 /* Make sure symbol does not think it is set up for this buffer; | |
| 2553 force it to look once again for this buffer's value */ | |
| 2554 if (!NILP (bfwd->current_buffer) && | |
| 2555 current_buffer == XBUFFER (bfwd->current_buffer)) | |
| 2556 bfwd->current_buffer = Qnil; | |
| 2557 | |
| 2558 /* We just changed the value in the current_buffer. If this | |
| 2559 variable forwards to a C variable, we need to change the | |
| 2560 value of the C variable. set_up_buffer_local_cache() | |
| 2561 will do this. It doesn't hurt to do it always, | |
| 2562 so just go ahead and do that. */ | |
| 2563 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1); | |
| 2564 } | |
| 2565 return variable; | |
| 2566 | |
| 2567 default: | |
| 2568 return variable; | |
| 2569 } | |
| 1204 | 2570 RETURN_NOT_REACHED(Qnil); /* suppress compiler warning */ |
| 428 | 2571 } |
| 2572 | |
| 2573 | |
| 2574 DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1, | |
| 2575 "vKill Console Local Variable: ", /* | |
| 2576 Make VARIABLE no longer have a separate value in the selected console. | |
| 2577 From now on the default value will apply in this console. | |
| 2578 */ | |
| 2579 (variable)) | |
| 2580 { | |
| 2581 Lisp_Object valcontents; | |
| 2582 | |
| 2583 CHECK_SYMBOL (variable); | |
| 2584 | |
| 2585 retry: | |
| 2586 valcontents = XSYMBOL (variable)->value; | |
| 2587 | |
| 2588 retry_2: | |
| 2589 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2590 return variable; | |
| 2591 | |
| 2592 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2593 { | |
| 2594 case SYMVAL_LISP_MAGIC: | |
| 2595 if (!UNBOUNDP (maybe_call_magic_handler | |
| 2596 (variable, Qkill_console_local_variable, 0))) | |
| 2597 return variable; | |
| 2598 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2599 /* semi-change-o */ | |
| 2600 goto retry_2; | |
| 2601 | |
| 2602 case SYMVAL_VARALIAS: | |
| 2603 variable = follow_varalias_pointers (variable, | |
| 2604 Qkill_console_local_variable); | |
| 2605 /* presto change-o! */ | |
| 2606 goto retry; | |
| 2607 | |
| 2608 case SYMVAL_SELECTED_CONSOLE_FORWARD: | |
| 2609 { | |
| 442 | 2610 const struct symbol_value_forward *fwd |
| 428 | 2611 = XSYMBOL_VALUE_FORWARD (valcontents); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2612 int offset = ((Rawbyte *) symbol_value_forward_forward (fwd) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2613 - (Rawbyte *) &console_local_flags); |
| 428 | 2614 int mask = |
| 2615 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); | |
| 2616 | |
| 2617 if (mask > 0) | |
| 2618 { | |
| 2619 int (*magicfun) (Lisp_Object sym, Lisp_Object *val, | |
| 2620 Lisp_Object in_object, int flags) = | |
| 2621 symbol_value_forward_magicfun (fwd); | |
| 2622 Lisp_Object oldval = * (Lisp_Object *) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2623 (offset + (Rawbyte *) XCONSOLE (Vconsole_defaults)); |
| 428 | 2624 if (magicfun) |
| 2625 magicfun (variable, &oldval, Vselected_console, 0); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
2626 *(Lisp_Object *) (offset + (Rawbyte *) XCONSOLE (Vselected_console)) |
| 428 | 2627 = oldval; |
| 2628 XCONSOLE (Vselected_console)->local_var_flags &= ~mask; | |
| 2629 } | |
| 2630 return variable; | |
| 2631 } | |
| 2632 | |
| 2633 default: | |
| 2634 return variable; | |
| 2635 } | |
| 2636 } | |
| 2637 | |
| 2638 /* Used by specbind to determine what effects it might have. Returns: | |
| 2639 * 0 if symbol isn't buffer-local, and wouldn't be after it is set | |
| 2640 * <0 if symbol isn't presently buffer-local, but set would make it so | |
| 2641 * >0 if symbol is presently buffer-local | |
| 2642 */ | |
| 2643 int | |
| 2644 symbol_value_buffer_local_info (Lisp_Object symbol, struct buffer *buffer) | |
| 2645 { | |
| 2646 Lisp_Object valcontents; | |
| 2647 | |
| 2648 retry: | |
| 2649 valcontents = XSYMBOL (symbol)->value; | |
| 2650 | |
| 2651 retry_2: | |
| 2652 if (SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2653 { | |
| 2654 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2655 { | |
| 2656 case SYMVAL_LISP_MAGIC: | |
| 2657 /* #### kludge */ | |
| 2658 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2659 /* semi-change-o */ | |
| 2660 goto retry_2; | |
| 2661 | |
| 2662 case SYMVAL_VARALIAS: | |
| 2663 symbol = follow_varalias_pointers (symbol, Qt /* #### kludge */); | |
| 2664 /* presto change-o! */ | |
| 2665 goto retry; | |
| 2666 | |
| 2667 case SYMVAL_CURRENT_BUFFER_FORWARD: | |
| 2668 { | |
| 442 | 2669 const struct symbol_value_forward *fwd |
| 428 | 2670 = XSYMBOL_VALUE_FORWARD (valcontents); |
| 2671 int mask = XINT (*((Lisp_Object *) | |
| 2672 symbol_value_forward_forward (fwd))); | |
| 2673 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask))) | |
| 2674 /* Already buffer-local */ | |
| 2675 return 1; | |
| 2676 else | |
| 2677 /* Would be buffer-local after set */ | |
| 2678 return -1; | |
| 2679 } | |
| 2680 case SYMVAL_BUFFER_LOCAL: | |
| 2681 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 2682 { | |
| 2683 struct symbol_value_buffer_local *bfwd | |
| 2684 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); | |
| 2685 if (buffer | |
| 2686 && !NILP (buffer_local_alist_element (buffer, symbol, bfwd))) | |
| 2687 return 1; | |
| 2688 else | |
| 2689 /* Automatically becomes local when set */ | |
| 2690 return bfwd->magic.type == SYMVAL_BUFFER_LOCAL ? -1 : 0; | |
| 2691 } | |
| 2692 default: | |
| 2693 return 0; | |
| 2694 } | |
| 2695 } | |
| 2696 return 0; | |
| 2697 } | |
| 2698 | |
| 2699 | |
| 2700 DEFUN ("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0, /* | |
| 2701 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound. | |
| 2702 */ | |
| 2703 (symbol, buffer, unbound_value)) | |
| 2704 { | |
| 2705 Lisp_Object value; | |
| 2706 CHECK_SYMBOL (symbol); | |
| 2707 CHECK_BUFFER (buffer); | |
| 2708 value = symbol_value_in_buffer (symbol, buffer); | |
| 2709 return UNBOUNDP (value) ? unbound_value : value; | |
| 2710 } | |
| 2711 | |
| 2712 DEFUN ("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0, /* | |
| 2713 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound. | |
| 2714 */ | |
| 2715 (symbol, console, unbound_value)) | |
| 2716 { | |
| 2717 Lisp_Object value; | |
| 2718 CHECK_SYMBOL (symbol); | |
| 2719 CHECK_CONSOLE (console); | |
| 2720 value = symbol_value_in_console (symbol, console); | |
| 2721 return UNBOUNDP (value) ? unbound_value : value; | |
| 2722 } | |
| 2723 | |
| 2724 DEFUN ("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0, /* | |
| 2725 If SYMBOL is a built-in variable, return info about this; else return nil. | |
| 2726 The returned info will be a symbol, one of | |
| 2727 | |
| 2728 `object' A simple built-in variable. | |
| 2729 `const-object' Same, but cannot be set. | |
| 2730 `integer' A built-in integer variable. | |
| 2731 `const-integer' Same, but cannot be set. | |
| 2732 `boolean' A built-in boolean variable. | |
| 2733 `const-boolean' Same, but cannot be set. | |
| 2734 `const-specifier' Always contains a specifier; e.g. `has-modeline-p'. | |
| 2735 `current-buffer' A built-in buffer-local variable. | |
| 2736 `const-current-buffer' Same, but cannot be set. | |
| 2737 `default-buffer' Forwards to the default value of a built-in | |
| 2738 buffer-local variable. | |
| 2739 `selected-console' A built-in console-local variable. | |
| 2740 `const-selected-console' Same, but cannot be set. | |
| 2741 `default-console' Forwards to the default value of a built-in | |
| 2742 console-local variable. | |
| 2743 */ | |
| 2744 (symbol)) | |
| 2745 { | |
| 2746 REGISTER Lisp_Object valcontents; | |
| 2747 | |
| 2748 CHECK_SYMBOL (symbol); | |
| 2749 | |
| 2750 retry: | |
| 2751 valcontents = XSYMBOL (symbol)->value; | |
| 2752 | |
| 2753 retry_2: | |
| 2754 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) | |
| 2755 return Qnil; | |
| 2756 | |
| 2757 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) | |
| 2758 { | |
| 2759 case SYMVAL_LISP_MAGIC: | |
| 2760 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; | |
| 2761 /* semi-change-o */ | |
| 2762 goto retry_2; | |
| 2763 | |
| 2764 case SYMVAL_VARALIAS: | |
| 2765 symbol = follow_varalias_pointers (symbol, Qt); | |
| 2766 /* presto change-o! */ | |
| 2767 goto retry; | |
| 2768 | |
| 2769 case SYMVAL_BUFFER_LOCAL: | |
| 2770 case SYMVAL_SOME_BUFFER_LOCAL: | |
| 2771 valcontents = | |
| 2772 XSYMBOL_VALUE_BUFFER_LOCAL (valcontents)->current_value; | |
| 2773 /* semi-change-o */ | |
| 2774 goto retry_2; | |
| 2775 | |
| 2776 case SYMVAL_FIXNUM_FORWARD: return Qinteger; | |
| 2777 case SYMVAL_CONST_FIXNUM_FORWARD: return Qconst_integer; | |
| 2778 case SYMVAL_BOOLEAN_FORWARD: return Qboolean; | |
| 2779 case SYMVAL_CONST_BOOLEAN_FORWARD: return Qconst_boolean; | |
| 2780 case SYMVAL_OBJECT_FORWARD: return Qobject; | |
| 2781 case SYMVAL_CONST_OBJECT_FORWARD: return Qconst_object; | |
| 2782 case SYMVAL_CONST_SPECIFIER_FORWARD: return Qconst_specifier; | |
| 2783 case SYMVAL_DEFAULT_BUFFER_FORWARD: return Qdefault_buffer; | |
| 2784 case SYMVAL_CURRENT_BUFFER_FORWARD: return Qcurrent_buffer; | |
| 2785 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: return Qconst_current_buffer; | |
| 2786 case SYMVAL_DEFAULT_CONSOLE_FORWARD: return Qdefault_console; | |
| 2787 case SYMVAL_SELECTED_CONSOLE_FORWARD: return Qselected_console; | |
| 2788 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: return Qconst_selected_console; | |
| 2789 case SYMVAL_UNBOUND_MARKER: return Qnil; | |
| 2790 | |
| 2791 default: | |
| 2500 | 2792 ABORT (); return Qnil; |
| 428 | 2793 } |
| 2794 } | |
| 2795 | |
| 2796 | |
| 2797 DEFUN ("local-variable-p", Flocal_variable_p, 2, 3, 0, /* | |
| 2798 Return t if SYMBOL's value is local to BUFFER. | |
| 444 | 2799 If optional third arg AFTER-SET is non-nil, return t if SYMBOL would be |
| 428 | 2800 buffer-local after it is set, regardless of whether it is so presently. |
| 2801 A nil value for BUFFER is *not* the same as (current-buffer), but means | |
| 2802 "no buffer". Specifically: | |
| 2803 | |
| 2804 -- If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that | |
| 2805 the variable is one of the special built-in variables that is always | |
| 2806 buffer-local. (This includes `buffer-file-name', `buffer-read-only', | |
| 2807 `buffer-undo-list', and others.) | |
| 2808 | |
| 2809 -- If BUFFER is nil and AFTER-SET is t, a return value of t indicates that | |
| 2810 the variable has had `make-variable-buffer-local' applied to it. | |
| 2811 */ | |
| 2812 (symbol, buffer, after_set)) | |
| 2813 { | |
| 2814 int local_info; | |
| 2815 | |
| 2816 CHECK_SYMBOL (symbol); | |
| 2817 if (!NILP (buffer)) | |
| 2818 { | |
| 2819 buffer = get_buffer (buffer, 1); | |
| 2820 local_info = symbol_value_buffer_local_info (symbol, XBUFFER (buffer)); | |
| 2821 } | |
| 2822 else | |
| 2823 { | |
| 2824 local_info = symbol_value_buffer_local_info (symbol, 0); | |
| 2825 } | |
| 2826 | |
| 2827 if (NILP (after_set)) | |
| 2828 return local_info > 0 ? Qt : Qnil; | |
| 2829 else | |
| 2830 return local_info != 0 ? Qt : Qnil; | |
| 2831 } | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2832 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2833 DEFUN ("custom-variable-p", Fcustom_variable_p, 1, 1, 0, /* |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2834 Return non-nil if SYMBOL names a custom variable. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2835 Does not follow the variable alias chain. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2836 */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2837 (symbol)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2838 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2839 return (!(NILP (Fget(symbol, intern ("standard-value"), Qnil))) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2840 || !(NILP (Fget(symbol, intern ("custom-autoload"), Qnil)))) ? |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2841 Qt: Qnil; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2842 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2843 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2844 static Lisp_Object |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2845 user_variable_alias_check_fun (Lisp_Object symbol) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2846 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2847 Lisp_Object documentation = Fget (symbol, Qvariable_documentation, Qnil); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2848 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2849 if ((INTP (documentation) && XINT (documentation) < 0) || |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2850 (STRINGP (documentation) && |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2851 (string_byte (documentation, 0) == '*')) || |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2852 /* If (STRING . INTEGER), a negative integer means a user variable. */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2853 (CONSP (documentation) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2854 && STRINGP (XCAR (documentation)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2855 && INTP (XCDR (documentation)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2856 && XINT (XCDR (documentation)) < 0) || |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2857 !NILP (Fcustom_variable_p (symbol))) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2858 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2859 return make_int(1); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2860 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2861 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2862 return Qzero; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2863 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2864 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2865 DEFUN ("user-variable-p", Fuser_variable_p, 1, 1, 0, /* |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2866 Return t if SYMBOL names a variable intended to be set and modified by users. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2867 \(The alternative is a variable used internally in a Lisp program.) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2868 A symbol names a user variable if |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2869 \(1) the first character of its documentation is `*', or |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2870 \(2) it is customizable (`custom-variable-p' gives t), or |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2871 \(3) it names a variable alias that eventually resolves to another user variable. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2872 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2873 The GNU Emacs implementation of `user-variable-p' returns nil if there is a |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2874 loop in the chain of symbols. Since this is indistinguishable from the case |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2875 where a symbol names a non-user variable, XEmacs signals a |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2876 `cyclic-variable-indirection' error instead; use `condition-case' to catch |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2877 this error if you really want to avoid this. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2878 */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2879 (symbol)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2880 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2881 Lisp_Object mapped; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2882 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2883 if (!SYMBOLP (symbol)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2884 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2885 return Qnil; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2886 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2887 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2888 /* Called for its side-effects, we want it to signal if there's a loop. */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2889 follow_varalias_pointers (symbol, Qt); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2890 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2891 /* Look through the various aliases. */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2892 mapped = map_varalias_chain (symbol, Qt, user_variable_alias_check_fun); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2893 if (EQ (Qzero, mapped)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2894 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2895 return Qnil; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2896 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2897 |
|
4503
af95657e0bfd
Use EQ() and !EQ() in symbols.c, thank you Robert Delius Royar.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4502
diff
changeset
|
2898 assert (EQ (make_int (1), mapped)); |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2899 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2900 return Qt; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2901 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2902 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
2903 |
| 428 | 2904 |
| 2905 | |
| 2906 /* | |
| 2907 I've gone ahead and partially implemented this because it's | |
| 2908 super-useful for dealing with the compatibility problems in supporting | |
| 2909 the old pointer-shape variables, and preventing people from `setq'ing | |
| 2910 the new variables. Any other way of handling this problem is way | |
| 2911 ugly, likely to be slow, and generally not something I want to waste | |
| 2912 my time worrying about. | |
| 2913 | |
| 2914 The interface and/or function name is sure to change before this | |
| 2915 gets into its final form. I currently like the way everything is | |
| 2916 set up and it has all the features I want it to have, except for | |
| 2917 one: I really want to be able to have multiple nested handlers, | |
| 2918 to implement an `advice'-like capability. This would allow, | |
| 2919 for example, a clean way of implementing `debug-if-set' or | |
| 2920 `debug-if-referenced' and such. | |
| 2921 | |
| 2922 NOTE NOTE NOTE NOTE NOTE NOTE NOTE: | |
| 2923 ************************************************************ | |
| 2924 **Only** the `set-value', `make-unbound', and `make-local' | |
| 2925 handler types are currently implemented. Implementing the | |
| 2926 get-value and bound-predicate handlers is somewhat tricky | |
| 2927 because there are lots of subfunctions (e.g. find_symbol_value()). | |
| 2928 find_symbol_value(), in fact, is called from outside of | |
| 2929 this module. You'd have to have it do this: | |
| 2930 | |
| 2931 -- check for a `bound-predicate' handler, call that if so; | |
| 2932 if it returns nil, return Qunbound | |
| 2933 -- check for a `get-value' handler and call it and return | |
| 2934 that value | |
| 2935 | |
| 2936 It gets even trickier when you have to deal with | |
| 2937 sub-subfunctions like find_symbol_value_1(), and esp. | |
| 2938 when you have to properly handle variable aliases, which | |
| 2939 can lead to lots of tricky situations. So I've just | |
| 2940 punted on this, since the interface isn't officially | |
| 2941 exported and we can get by with just a `set-value' | |
| 2942 handler. | |
| 2943 | |
| 2944 Actions in unimplemented handler types will correctly | |
| 2945 ignore any handlers, and will not fuck anything up or | |
| 2946 go awry. | |
| 2947 | |
| 2948 WARNING WARNING: If you do go and implement another | |
| 2949 type of handler, make *sure* to change | |
| 2950 would_be_magic_handled() so it knows about this, | |
| 2951 or dire things could result. | |
| 2952 ************************************************************ | |
| 2953 NOTE NOTE NOTE NOTE NOTE NOTE NOTE | |
| 2954 | |
| 2955 Real documentation is as follows. | |
| 2956 | |
| 2957 Set a magic handler for VARIABLE. | |
| 2958 This allows you to specify arbitrary behavior that results from | |
| 2959 accessing or setting a variable. For example, retrieving the | |
| 2960 variable's value might actually retrieve the first element off of | |
| 2961 a list stored in another variable, and setting the variable's value | |
| 2962 might add an element to the front of that list. (This is how the | |
| 2963 obsolete variable `unread-command-event' is implemented.) | |
| 2964 | |
| 2965 In general it is NOT good programming practice to use magic variables | |
| 2966 in a new package that you are designing. If you feel the need to | |
| 2967 do this, it's almost certainly a sign that you should be using a | |
| 2968 function instead of a variable. This facility is provided to allow | |
| 2969 a package to support obsolete variables and provide compatibility | |
| 2970 with similar packages with different variable names and semantics. | |
| 2971 By using magic handlers, you can cleanly provide obsoleteness and | |
| 2972 compatibility support and separate this support from the core | |
| 2973 routines in a package. | |
| 2974 | |
| 2975 VARIABLE should be a symbol naming the variable for which the | |
| 2976 magic behavior is provided. HANDLER-TYPE is a symbol specifying | |
| 2977 which behavior is being controlled, and HANDLER is the function | |
| 2978 that will be called to control this behavior. HARG is a | |
| 2979 value that will be passed to HANDLER but is otherwise | |
| 2980 uninterpreted. KEEP-EXISTING specifies what to do with existing | |
| 2981 handlers of the same type; nil means "erase them all", t means | |
| 2982 "keep them but insert at the beginning", the list (t) means | |
| 2983 "keep them but insert at the end", a function means "keep | |
| 2984 them but insert before the specified function", a list containing | |
| 2985 a function means "keep them but insert after the specified | |
| 2986 function". | |
| 2987 | |
| 2988 You can specify magic behavior for any type of variable at all, | |
| 2989 and for any handler types that are unspecified, the standard | |
| 2990 behavior applies. This allows you, for example, to use | |
| 2991 `defvaralias' in conjunction with this function. (For that | |
| 2992 matter, `defvaralias' could be implemented using this function.) | |
| 2993 | |
| 2994 The behaviors that can be specified in HANDLER-TYPE are | |
| 2995 | |
| 2996 get-value (SYM ARGS FUN HARG HANDLERS) | |
| 2997 This means that one of the functions `symbol-value', | |
| 2998 `default-value', `symbol-value-in-buffer', or | |
| 2999 `symbol-value-in-console' was called on SYM. | |
| 3000 | |
| 3001 set-value (SYM ARGS FUN HARG HANDLERS) | |
| 3002 This means that one of the functions `set' or `set-default' | |
| 3003 was called on SYM. | |
| 3004 | |
| 3005 bound-predicate (SYM ARGS FUN HARG HANDLERS) | |
| 3006 This means that one of the functions `boundp', `globally-boundp', | |
| 3007 or `default-boundp' was called on SYM. | |
| 3008 | |
| 3009 make-unbound (SYM ARGS FUN HARG HANDLERS) | |
| 3010 This means that the function `makunbound' was called on SYM. | |
| 3011 | |
| 3012 local-predicate (SYM ARGS FUN HARG HANDLERS) | |
| 3013 This means that the function `local-variable-p' was called | |
| 3014 on SYM. | |
| 3015 | |
| 3016 make-local (SYM ARGS FUN HARG HANDLERS) | |
| 3017 This means that one of the functions `make-local-variable', | |
| 3018 `make-variable-buffer-local', `kill-local-variable', | |
| 3019 or `kill-console-local-variable' was called on SYM. | |
| 3020 | |
| 3021 The meanings of the arguments are as follows: | |
| 3022 | |
| 3023 SYM is the symbol on which the function was called, and is always | |
| 3024 the first argument to the function. | |
| 3025 | |
| 3026 ARGS are the remaining arguments in the original call (i.e. all | |
| 3027 but the first). In the case of `set-value' in particular, | |
| 3028 the first element of ARGS is the value to which the variable | |
| 3029 is being set. In some cases, ARGS is sanitized from what was | |
| 3030 actually given. For example, whenever `nil' is passed to an | |
| 3031 argument and it means `current-buffer', the current buffer is | |
| 3032 substituted instead. | |
| 3033 | |
| 3034 FUN is a symbol indicating which function is being called. | |
| 3035 For many of the functions, you can determine the corresponding | |
| 3036 function of a different class using | |
| 3037 `symbol-function-corresponding-function'. | |
| 3038 | |
| 3039 HARG is the argument that was given in the call | |
| 3040 to `set-symbol-value-handler' for SYM and HANDLER-TYPE. | |
| 3041 | |
| 3042 HANDLERS is a structure containing the remaining handlers | |
| 3043 for the variable; to call one of them, use | |
| 3044 `chain-to-symbol-value-handler'. | |
| 3045 | |
| 3046 NOTE: You may *not* modify the list in ARGS, and if you want to | |
| 3047 keep it around after the handler function exits, you must make | |
| 3048 a copy using `copy-sequence'. (Same caveats for HANDLERS also.) | |
| 3049 */ | |
| 3050 | |
| 3051 static enum lisp_magic_handler | |
| 3052 decode_magic_handler_type (Lisp_Object symbol) | |
| 3053 { | |
| 3054 if (EQ (symbol, Qget_value)) return MAGIC_HANDLER_GET_VALUE; | |
| 3055 if (EQ (symbol, Qset_value)) return MAGIC_HANDLER_SET_VALUE; | |
| 3056 if (EQ (symbol, Qbound_predicate)) return MAGIC_HANDLER_BOUND_PREDICATE; | |
| 3057 if (EQ (symbol, Qmake_unbound)) return MAGIC_HANDLER_MAKE_UNBOUND; | |
| 3058 if (EQ (symbol, Qlocal_predicate)) return MAGIC_HANDLER_LOCAL_PREDICATE; | |
| 3059 if (EQ (symbol, Qmake_local)) return MAGIC_HANDLER_MAKE_LOCAL; | |
| 3060 | |
| 563 | 3061 invalid_constant ("Unrecognized symbol value handler type", symbol); |
| 1204 | 3062 RETURN_NOT_REACHED (MAGIC_HANDLER_MAX); |
| 428 | 3063 } |
| 3064 | |
| 3065 static enum lisp_magic_handler | |
| 3066 handler_type_from_function_symbol (Lisp_Object funsym, int abort_if_not_found) | |
| 3067 { | |
| 3068 if (EQ (funsym, Qsymbol_value) | |
| 3069 || EQ (funsym, Qdefault_value) | |
| 3070 || EQ (funsym, Qsymbol_value_in_buffer) | |
| 3071 || EQ (funsym, Qsymbol_value_in_console)) | |
| 3072 return MAGIC_HANDLER_GET_VALUE; | |
| 3073 | |
| 3074 if (EQ (funsym, Qset) | |
| 3075 || EQ (funsym, Qset_default)) | |
| 3076 return MAGIC_HANDLER_SET_VALUE; | |
| 3077 | |
| 3078 if (EQ (funsym, Qboundp) | |
| 3079 || EQ (funsym, Qglobally_boundp) | |
| 3080 || EQ (funsym, Qdefault_boundp)) | |
| 3081 return MAGIC_HANDLER_BOUND_PREDICATE; | |
| 3082 | |
| 3083 if (EQ (funsym, Qmakunbound)) | |
| 3084 return MAGIC_HANDLER_MAKE_UNBOUND; | |
| 3085 | |
| 3086 if (EQ (funsym, Qlocal_variable_p)) | |
| 3087 return MAGIC_HANDLER_LOCAL_PREDICATE; | |
| 3088 | |
| 3089 if (EQ (funsym, Qmake_variable_buffer_local) | |
| 3090 || EQ (funsym, Qmake_local_variable)) | |
| 3091 return MAGIC_HANDLER_MAKE_LOCAL; | |
| 3092 | |
| 3093 if (abort_if_not_found) | |
| 2500 | 3094 ABORT (); |
| 563 | 3095 invalid_argument ("Unrecognized symbol-value function", funsym); |
| 1204 | 3096 RETURN_NOT_REACHED (MAGIC_HANDLER_MAX); |
| 428 | 3097 } |
| 3098 | |
| 3099 static int | |
| 3100 would_be_magic_handled (Lisp_Object sym, Lisp_Object funsym) | |
| 3101 { | |
| 3102 /* does not take into account variable aliasing. */ | |
| 3103 Lisp_Object valcontents = XSYMBOL (sym)->value; | |
| 3104 enum lisp_magic_handler slot; | |
| 3105 | |
| 3106 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents)) | |
| 3107 return 0; | |
| 3108 slot = handler_type_from_function_symbol (funsym, 1); | |
| 3109 if (slot != MAGIC_HANDLER_SET_VALUE && slot != MAGIC_HANDLER_MAKE_UNBOUND | |
| 3110 && slot != MAGIC_HANDLER_MAKE_LOCAL) | |
| 3111 /* #### temporary kludge because we haven't implemented | |
| 3112 lisp-magic variables completely */ | |
| 3113 return 0; | |
| 3114 return !NILP (XSYMBOL_VALUE_LISP_MAGIC (valcontents)->handler[slot]); | |
| 3115 } | |
| 3116 | |
| 3117 static Lisp_Object | |
| 3118 fetch_value_maybe_past_magic (Lisp_Object sym, | |
| 3119 Lisp_Object follow_past_lisp_magic) | |
| 3120 { | |
| 3121 Lisp_Object value = XSYMBOL (sym)->value; | |
| 3122 if (SYMBOL_VALUE_LISP_MAGIC_P (value) | |
| 3123 && (EQ (follow_past_lisp_magic, Qt) | |
| 3124 || (!NILP (follow_past_lisp_magic) | |
| 3125 && !would_be_magic_handled (sym, follow_past_lisp_magic)))) | |
| 3126 value = XSYMBOL_VALUE_LISP_MAGIC (value)->shadowed; | |
| 3127 return value; | |
| 3128 } | |
| 3129 | |
| 3130 static Lisp_Object * | |
| 3131 value_slot_past_magic (Lisp_Object sym) | |
| 3132 { | |
| 3133 Lisp_Object *store_pointer = &XSYMBOL (sym)->value; | |
| 3134 | |
| 3135 if (SYMBOL_VALUE_LISP_MAGIC_P (*store_pointer)) | |
| 3136 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC (sym)->shadowed; | |
| 3137 return store_pointer; | |
| 3138 } | |
| 3139 | |
| 3140 static Lisp_Object | |
| 3141 maybe_call_magic_handler (Lisp_Object sym, Lisp_Object funsym, int nargs, ...) | |
| 3142 { | |
| 3143 va_list vargs; | |
| 3144 Lisp_Object args[20]; /* should be enough ... */ | |
| 3145 int i; | |
| 3146 enum lisp_magic_handler htype; | |
| 3147 Lisp_Object legerdemain; | |
| 3148 struct symbol_value_lisp_magic *bfwd; | |
| 3149 | |
| 440 | 3150 assert (nargs >= 0 && nargs < countof (args)); |
| 428 | 3151 legerdemain = XSYMBOL (sym)->value; |
| 3152 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain)); | |
| 3153 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain); | |
| 3154 | |
| 3155 va_start (vargs, nargs); | |
| 3156 for (i = 0; i < nargs; i++) | |
| 3157 args[i] = va_arg (vargs, Lisp_Object); | |
| 3158 va_end (vargs); | |
| 3159 | |
| 3160 htype = handler_type_from_function_symbol (funsym, 1); | |
| 3161 if (NILP (bfwd->handler[htype])) | |
| 3162 return Qunbound; | |
| 3163 /* #### should be reusing the arglist, not always consing anew. | |
| 3164 Repeated handler invocations should not cause repeated consing. | |
| 3165 Doesn't matter for now, because this is just a quick implementation | |
| 3166 for obsolescence support. */ | |
| 3167 return call5 (bfwd->handler[htype], sym, Flist (nargs, args), funsym, | |
| 3168 bfwd->harg[htype], Qnil); | |
| 3169 } | |
| 3170 | |
| 3171 DEFUN ("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler, | |
| 3172 3, 5, 0, /* | |
| 3173 Don't you dare use this. | |
| 3174 If you do, suffer the wrath of Ben, who is likely to rename | |
| 3175 this function (or change the semantics of its arguments) without | |
| 3176 pity, thereby invalidating your code. | |
| 3177 */ | |
| 2286 | 3178 (variable, handler_type, handler, harg, |
|
4642
48b45a606961
Support #'function-arglist with built-in special forms.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4535
diff
changeset
|
3179 UNUSED (keep_existing ))) |
| 428 | 3180 { |
| 3181 Lisp_Object valcontents; | |
| 3182 struct symbol_value_lisp_magic *bfwd; | |
| 3183 enum lisp_magic_handler htype; | |
| 3184 int i; | |
| 3185 | |
| 3186 /* #### WARNING, only some handler types are implemented. See above. | |
| 3187 Actions of other types will ignore a handler if it's there. | |
| 3188 | |
| 3189 #### Also, `chain-to-symbol-value-handler' and | |
| 3190 `symbol-function-corresponding-function' are not implemented. */ | |
| 3191 CHECK_SYMBOL (variable); | |
| 3192 CHECK_SYMBOL (handler_type); | |
| 3193 htype = decode_magic_handler_type (handler_type); | |
| 3194 valcontents = XSYMBOL (variable)->value; | |
| 3195 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents)) | |
| 3196 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
3197 bfwd = |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
3198 XSYMBOL_VALUE_LISP_MAGIC |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
3199 (ALLOC_NORMAL_LISP_OBJECT (symbol_value_lisp_magic)); |
| 428 | 3200 bfwd->magic.type = SYMVAL_LISP_MAGIC; |
| 3201 for (i = 0; i < MAGIC_HANDLER_MAX; i++) | |
| 3202 { | |
| 3203 bfwd->handler[i] = Qnil; | |
| 3204 bfwd->harg[i] = Qnil; | |
| 3205 } | |
| 3206 bfwd->shadowed = valcontents; | |
| 793 | 3207 XSYMBOL (variable)->value = wrap_symbol_value_magic (bfwd); |
| 428 | 3208 } |
| 3209 else | |
| 3210 bfwd = XSYMBOL_VALUE_LISP_MAGIC (valcontents); | |
| 3211 bfwd->handler[htype] = handler; | |
| 3212 bfwd->harg[htype] = harg; | |
| 3213 | |
| 3214 for (i = 0; i < MAGIC_HANDLER_MAX; i++) | |
| 3215 if (!NILP (bfwd->handler[i])) | |
| 3216 break; | |
| 3217 | |
| 3218 if (i == MAGIC_HANDLER_MAX) | |
| 3219 /* there are no remaining handlers, so remove the structure. */ | |
| 3220 XSYMBOL (variable)->value = bfwd->shadowed; | |
| 3221 | |
| 3222 return Qnil; | |
| 3223 } | |
| 3224 | |
| 3225 | |
| 3226 /* functions for working with variable aliases. */ | |
| 3227 | |
| 3228 /* Follow the chain of variable aliases for SYMBOL. Return the | |
| 3229 resulting symbol, whose value cell is guaranteed not to be a | |
| 3230 symbol-value-varalias. | |
| 3231 | |
| 3232 Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias. | |
| 3233 If FUNSYM is t, always follow in such a case. If FUNSYM is nil, | |
| 3234 never follow; stop right there. Otherwise FUNSYM should be a | |
| 3235 recognized symbol-value function symbol; this means, follow | |
| 3236 unless there is a special handler for the named function. | |
| 3237 | |
| 3238 OK, there is at least one reason why it's necessary for | |
| 3239 FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we | |
| 3240 can always be sure to catch cyclic variable aliasing. If we never | |
| 3241 follow past Lisp magic, then if the following is done: | |
| 3242 | |
| 3243 (defvaralias 'a 'b) | |
| 3244 add some magic behavior to a, but not a "get-value" handler | |
| 3245 (defvaralias 'b 'a) | |
| 3246 | |
| 3247 then an attempt to retrieve a's or b's value would cause infinite | |
| 3248 looping in `symbol-value'. | |
| 3249 | |
| 3250 We (of course) can't always follow past Lisp magic, because then | |
| 3251 we make any variable that is lisp-magic -> varalias behave as if | |
| 3252 the lisp-magic is not present at all. | |
| 3253 */ | |
| 3254 | |
| 3255 static Lisp_Object | |
| 3256 follow_varalias_pointers (Lisp_Object symbol, | |
| 3257 Lisp_Object follow_past_lisp_magic) | |
| 3258 { | |
| 3259 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16 | |
| 3260 Lisp_Object tortoise, hare, val; | |
| 3261 int count; | |
| 3262 | |
| 3263 /* quick out just in case */ | |
| 3264 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value)) | |
| 3265 return symbol; | |
| 3266 | |
| 3267 /* Compare implementation of indirect_function(). */ | |
| 3268 for (hare = tortoise = symbol, count = 0; | |
| 3269 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic), | |
| 3270 SYMBOL_VALUE_VARALIAS_P (val); | |
| 3271 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)), | |
| 3272 count++) | |
| 3273 { | |
| 3274 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue; | |
| 3275 | |
| 3276 if (count & 1) | |
| 3277 tortoise = symbol_value_varalias_aliasee | |
| 3278 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic | |
| 3279 (tortoise, follow_past_lisp_magic))); | |
| 3280 if (EQ (hare, tortoise)) | |
| 3281 return Fsignal (Qcyclic_variable_indirection, list1 (symbol)); | |
| 3282 } | |
| 3283 | |
| 3284 return hare; | |
| 3285 } | |
| 3286 | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3287 /* Map FN over the chain of variable aliases for SYMBOL. If FN returns |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3288 something other than Qzero for some link in the chain, return that |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3289 immediately. Otherwise return Qzero (which is not a symbol). |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3290 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3291 FN may be called twice on the same symbol if the varalias chain is |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3292 cyclic. Prevent this by calling follow_varalias_pointers first for its |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3293 side-effects. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3294 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3295 Signals a cyclic-variable-indirection error if a cyclic structure is |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3296 detected. */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3297 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3298 static Lisp_Object |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3299 map_varalias_chain (Lisp_Object symbol, |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3300 Lisp_Object follow_past_lisp_magic, |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3301 Lisp_Object (*fn) (Lisp_Object arg)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3302 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3303 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3304 Lisp_Object tortoise, hare, val, res; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3305 int count; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3306 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3307 assert (fn); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3308 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3309 /* quick out just in case */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3310 if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3311 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3312 return (fn)(symbol); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3313 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3314 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3315 /* Compare implementation of indirect_function(). */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3316 for (hare = tortoise = symbol, count = 0; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3317 val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic), |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3318 SYMBOL_VALUE_VARALIAS_P (val); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3319 hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)), |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3320 count++) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3321 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3322 res = (fn) (hare); |
|
4503
af95657e0bfd
Use EQ() and !EQ() in symbols.c, thank you Robert Delius Royar.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4502
diff
changeset
|
3323 if (!EQ (Qzero, res)) |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3324 { |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3325 return res; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3326 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3327 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3328 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue; |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3329 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3330 if (count & 1) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3331 tortoise = symbol_value_varalias_aliasee |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3332 (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3333 (tortoise, follow_past_lisp_magic))); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3334 if (EQ (hare, tortoise)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3335 return Fsignal (Qcyclic_variable_indirection, list1 (symbol)); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3336 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3337 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3338 return (fn) (hare); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3339 } |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3340 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3341 /* |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3342 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3343 OED entry, 2nd edition, IPA transliterated using Kirshenbaum: |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3344 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3345 alias ('eIlI@s, '&lI@s), adv. and n. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3346 [...] |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3347 B. n. (with pl. aliases.) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3348 1. Another name, an assumed name. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3349 1605 Camden Rem. (1614) 147 An Alias or double name cannot preiudice the honest. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3350 1831 Edin. Rev. LIII. 364 He has been assuming various aliases. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3351 1861 Macaulay Hist. Eng. V. 92 The monk who was sometimes called Harrison |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3352 and sometimes went by the alias of Johnson. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3353 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3354 The alias is the fake name. Let's try to follow that usage in our |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3355 documentation. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3356 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3357 */ |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3358 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3359 DEFUN ("defvaralias", Fdefvaralias, 2, 3, 0, /* |
| 428 | 3360 Define a variable as an alias for another variable. |
| 3361 Thenceforth, any operations performed on VARIABLE will actually be | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3362 performed on ALIASED. Both VARIABLE and ALIASED should be symbols. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3363 If ALIASED is nil and VARIABLE is an existing alias, remove that alias. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3364 ALIASED can itself be an alias, and the chain of variable aliases |
| 428 | 3365 will be followed appropriately. |
| 3366 If VARIABLE already has a value, this value will be shadowed | |
| 3367 until the alias is removed, at which point it will be restored. | |
| 3368 Currently VARIABLE cannot be a built-in variable, a variable that | |
| 3369 has a buffer-local value in any buffer, or the symbols nil or t. | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3370 \(ALIASED, however, can be any type of variable.) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3371 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3372 Optional argument DOCSTRING is documentation for VARIABLE in its use as an |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3373 alias for ALIASED. The XEmacs help code ignores this documentation, using |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3374 the documentation of ALIASED instead, and the docstring, if specified, is |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3375 not shadowed in the same way that the value is. Only use it if you know |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3376 what you're doing. |
| 428 | 3377 */ |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3378 (variable, aliased, docstring)) |
| 428 | 3379 { |
| 3380 struct symbol_value_varalias *bfwd; | |
| 3381 Lisp_Object valcontents; | |
| 3382 | |
| 3383 CHECK_SYMBOL (variable); | |
| 3384 reject_constant_symbols (variable, Qunbound, 0, Qt); | |
| 3385 | |
| 3386 valcontents = XSYMBOL (variable)->value; | |
| 3387 | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3388 if (NILP (aliased)) |
| 428 | 3389 { |
| 3390 if (SYMBOL_VALUE_VARALIAS_P (valcontents)) | |
| 3391 { | |
| 3392 XSYMBOL (variable)->value = | |
| 3393 symbol_value_varalias_shadowed | |
| 3394 (XSYMBOL_VALUE_VARALIAS (valcontents)); | |
| 3395 } | |
| 3396 return Qnil; | |
| 3397 } | |
| 3398 | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3399 CHECK_SYMBOL (aliased); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3400 |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3401 if (!NILP (docstring)) |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3402 Fput (variable, Qvariable_documentation, docstring); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3403 |
| 428 | 3404 if (SYMBOL_VALUE_VARALIAS_P (valcontents)) |
| 3405 { | |
| 3406 /* transmogrify */ | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3407 XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = aliased; |
| 428 | 3408 return Qnil; |
| 3409 } | |
| 3410 | |
| 3411 if (SYMBOL_VALUE_MAGIC_P (valcontents) | |
| 3412 && !UNBOUNDP (valcontents)) | |
| 563 | 3413 invalid_change ("Variable is magic and cannot be aliased", variable); |
| 428 | 3414 reject_constant_symbols (variable, Qunbound, 0, Qt); |
| 3415 | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
3416 bfwd = |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
3417 XSYMBOL_VALUE_VARALIAS (ALLOC_NORMAL_LISP_OBJECT (symbol_value_varalias)); |
| 428 | 3418 bfwd->magic.type = SYMVAL_VARALIAS; |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3419 bfwd->aliasee = aliased; |
| 428 | 3420 bfwd->shadowed = valcontents; |
| 3421 | |
| 793 | 3422 valcontents = wrap_symbol_value_magic (bfwd); |
| 428 | 3423 XSYMBOL (variable)->value = valcontents; |
| 3424 return Qnil; | |
| 3425 } | |
| 3426 | |
| 3427 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /* | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3428 If VARIABLE is an alias of another variable, return that variable. |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3429 VARIABLE should be a symbol. If VARIABLE is not an alias, return nil. |
| 428 | 3430 Variable aliases are created with `defvaralias'. See also |
| 3431 `indirect-variable'. | |
| 3432 */ | |
| 3433 (variable, follow_past_lisp_magic)) | |
| 3434 { | |
| 3435 Lisp_Object valcontents; | |
| 3436 | |
| 3437 CHECK_SYMBOL (variable); | |
| 3438 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt)) | |
| 3439 { | |
| 3440 CHECK_SYMBOL (follow_past_lisp_magic); | |
| 3441 handler_type_from_function_symbol (follow_past_lisp_magic, 0); | |
| 3442 } | |
| 3443 | |
| 3444 valcontents = fetch_value_maybe_past_magic (variable, | |
| 3445 follow_past_lisp_magic); | |
| 3446 | |
| 3447 if (SYMBOL_VALUE_VARALIAS_P (valcontents)) | |
| 3448 return symbol_value_varalias_aliasee | |
| 3449 (XSYMBOL_VALUE_VARALIAS (valcontents)); | |
| 3450 else | |
| 3451 return Qnil; | |
| 3452 } | |
| 3453 | |
| 3454 DEFUN ("indirect-variable", Findirect_variable, 1, 2, 0, /* | |
| 3455 Return the variable at the end of OBJECT's variable-alias chain. | |
| 3456 If OBJECT is a symbol, follow all variable aliases and return | |
| 3457 the final (non-aliased) symbol. Variable aliases are created with | |
| 3458 the function `defvaralias'. | |
| 3459 If OBJECT is not a symbol, just return it. | |
| 3460 Signal a cyclic-variable-indirection error if there is a loop in the | |
| 3461 variable chain of symbols. | |
| 3462 */ | |
| 3463 (object, follow_past_lisp_magic)) | |
| 3464 { | |
| 3465 if (!SYMBOLP (object)) | |
| 3466 return object; | |
| 3467 if (!NILP (follow_past_lisp_magic) && !EQ (follow_past_lisp_magic, Qt)) | |
| 3468 { | |
| 3469 CHECK_SYMBOL (follow_past_lisp_magic); | |
| 3470 handler_type_from_function_symbol (follow_past_lisp_magic, 0); | |
| 3471 } | |
| 3472 return follow_varalias_pointers (object, follow_past_lisp_magic); | |
| 3473 } | |
| 3474 | |
| 1674 | 3475 DEFUN ("variable-binding-locus", Fvariable_binding_locus, 1, 1, 0, /* |
| 3476 Return a value indicating where VARIABLE's current binding comes from. | |
| 3477 If the current binding is buffer-local, the value is the current buffer. | |
| 3478 If the current binding is global (the default), the value is nil. | |
| 3479 */ | |
| 3480 (variable)) | |
| 3481 { | |
| 3482 Lisp_Object valcontents; | |
| 3483 | |
| 3484 CHECK_SYMBOL (variable); | |
| 3485 variable = Findirect_variable (variable, Qnil); | |
| 3486 | |
| 3487 /* Make sure the current binding is actually swapped in. */ | |
| 3488 find_symbol_value (variable); | |
| 3489 | |
| 3490 valcontents = XSYMBOL (variable)->value; | |
| 3491 | |
| 3492 if (SYMBOL_VALUE_MAGIC_P (valcontents) | |
| 3493 && ((XSYMBOL_VALUE_MAGIC_TYPE (valcontents) == SYMVAL_BUFFER_LOCAL) | |
| 3494 || (XSYMBOL_VALUE_MAGIC_TYPE (valcontents) == SYMVAL_SOME_BUFFER_LOCAL)) | |
| 3495 && (!NILP (Flocal_variable_p (variable, Fcurrent_buffer (), Qnil)))) | |
| 3496 return Fcurrent_buffer (); | |
| 3497 else | |
| 3498 return Qnil; | |
| 3499 } | |
| 428 | 3500 |
| 3501 /************************************************************************/ | |
| 3502 /* initialization */ | |
| 3503 /************************************************************************/ | |
| 3504 | |
| 3505 /* A dumped XEmacs image has a lot more than 1511 symbols. Last | |
| 3506 estimate was that there were actually around 6300. So let's try | |
| 3507 making this bigger and see if we get better hashing behavior. */ | |
| 3508 #define OBARRAY_SIZE 16411 | |
| 3509 | |
| 3510 #ifndef Qzero | |
| 3511 Lisp_Object Qzero; | |
| 3512 #endif | |
| 3513 #ifndef Qnull_pointer | |
| 3514 Lisp_Object Qnull_pointer; | |
| 3515 #endif | |
| 3516 | |
| 3263 | 3517 #ifndef NEW_GC |
| 428 | 3518 /* some losing systems can't have static vars at function scope... */ |
| 442 | 3519 static const struct symbol_value_magic guts_of_unbound_marker = |
| 3520 { /* struct symbol_value_magic */ | |
| 3024 | 3521 { /* struct old_lcrecord_header */ |
| 442 | 3522 { /* struct lrecord_header */ |
| 3523 lrecord_type_symbol_value_forward, /* lrecord_type_index */ | |
| 3524 1, /* mark bit */ | |
| 3525 1, /* c_readonly bit */ | |
| 3526 1, /* lisp_readonly bit */ | |
| 3527 }, | |
| 3528 0, /* next */ | |
| 3529 }, | |
| 3530 0, /* value */ | |
| 3531 SYMVAL_UNBOUND_MARKER | |
| 3532 }; | |
| 3263 | 3533 #endif /* not NEW_GC */ |
| 428 | 3534 |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3535 static void |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3536 reinit_symbol_objects_early (void) |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3537 { |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3538 OBJECT_HAS_METHOD (symbol, getprop); |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3539 OBJECT_HAS_METHOD (symbol, putprop); |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3540 OBJECT_HAS_METHOD (symbol, remprop); |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3541 OBJECT_HAS_NAMED_METHOD (symbol, plist, Fsymbol_plist); |
|
5255
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
3542 OBJECT_HAS_NAMED_METHOD (symbol, setplist, Fsetplist); |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3543 } |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3544 |
| 428 | 3545 void |
| 3546 init_symbols_once_early (void) | |
| 3547 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
3548 INIT_LISP_OBJECT (symbol); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
3549 INIT_LISP_OBJECT (symbol_value_forward); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
3550 INIT_LISP_OBJECT (symbol_value_buffer_local); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
3551 INIT_LISP_OBJECT (symbol_value_lisp_magic); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
3552 INIT_LISP_OBJECT (symbol_value_varalias); |
| 442 | 3553 |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3554 reinit_symbol_objects_early (); |
| 428 | 3555 |
| 3556 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is | |
| 3557 called the first time. */ | |
| 867 | 3558 Qnil = Fmake_symbol (make_string_nocopy ((const Ibyte *) "nil", 3)); |
| 793 | 3559 XSTRING_PLIST (XSYMBOL (Qnil)->name) = Qnil; |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3560 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihilo */ |
| 428 | 3561 XSYMBOL (Qnil)->plist = Qnil; |
| 3562 | |
| 3563 Vobarray = make_vector (OBARRAY_SIZE, Qzero); | |
| 3564 initial_obarray = Vobarray; | |
| 3565 staticpro (&initial_obarray); | |
| 3566 /* Intern nil in the obarray */ | |
| 3567 { | |
| 793 | 3568 unsigned int hash = hash_string (XSTRING_DATA (XSYMBOL (Qnil)->name), 3); |
| 428 | 3569 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil; |
| 3570 } | |
| 3571 | |
| 3572 { | |
| 3573 /* Required to get around a GCC syntax error on certain | |
| 3574 architectures */ | |
| 3263 | 3575 #ifdef NEW_GC |
| 2720 | 3576 struct symbol_value_magic *tem = (struct symbol_value_magic *) |
| 3577 mc_alloc (sizeof (struct symbol_value_magic)); | |
| 3578 MARK_LRECORD_AS_LISP_READONLY (tem); | |
| 3579 MARK_LRECORD_AS_NOT_FREE (tem); | |
| 3580 tem->header.type = lrecord_type_symbol_value_forward; | |
| 3581 mcpro (wrap_pointer_1 (tem)); | |
| 3582 tem->value = 0; | |
| 3583 tem->type = SYMVAL_UNBOUND_MARKER; | |
| 2994 | 3584 #ifdef ALLOC_TYPE_STATS |
| 2775 | 3585 inc_lrecord_stats (sizeof (struct symbol_value_magic), |
| 3586 (const struct lrecord_header *) tem); | |
| 2994 | 3587 #endif /* ALLOC_TYPE_STATS */ |
| 3263 | 3588 #else /* not NEW_GC */ |
| 442 | 3589 const struct symbol_value_magic *tem = &guts_of_unbound_marker; |
| 3263 | 3590 #endif /* not NEW_GC */ |
| 428 | 3591 |
| 793 | 3592 Qunbound = wrap_symbol_value_magic (tem); |
| 428 | 3593 } |
| 3594 | |
| 3595 XSYMBOL (Qnil)->function = Qunbound; | |
| 3596 | |
| 563 | 3597 DEFSYMBOL (Qt); |
| 444 | 3598 XSYMBOL (Qt)->value = Qt; /* Veritas aeterna */ |
| 428 | 3599 Vquit_flag = Qnil; |
| 3600 | |
| 1204 | 3601 dump_add_root_lisp_object (&Qnil); |
| 3602 dump_add_root_lisp_object (&Qunbound); | |
| 3603 dump_add_root_lisp_object (&Vquit_flag); | |
| 428 | 3604 } |
| 3605 | |
| 3606 void | |
| 1204 | 3607 reinit_symbols_early (void) |
| 440 | 3608 { |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3609 reinit_symbol_objects_early (); |
| 440 | 3610 } |
| 3611 | |
| 442 | 3612 static void |
|
4979
4234fd5a7b17
fix bug #668 (compile error, not --with-debug)
Ben Wing <ben@xemacs.org>
parents:
4971
diff
changeset
|
3613 defsymbol_massage_name_1 (Lisp_Object *location, const Ascbyte *name, |
|
4234fd5a7b17
fix bug #668 (compile error, not --with-debug)
Ben Wing <ben@xemacs.org>
parents:
4971
diff
changeset
|
3614 int dump_p, int multiword_predicate_p) |
| 442 | 3615 { |
| 3616 char temp[500]; | |
| 3617 int len = strlen (name) - 1; | |
| 3618 int i; | |
| 3619 | |
| 3620 if (multiword_predicate_p) | |
| 647 | 3621 assert (len + 1 < (int) sizeof (temp)); |
| 442 | 3622 else |
| 647 | 3623 assert (len < (int) sizeof (temp)); |
| 442 | 3624 strcpy (temp, name + 1); /* Remove initial Q */ |
| 3625 if (multiword_predicate_p) | |
| 3626 { | |
| 3627 strcpy (temp + len - 1, "_p"); | |
| 3628 len++; | |
| 3629 } | |
| 3630 for (i = 0; i < len; i++) | |
| 3631 if (temp[i] == '_') | |
| 3632 temp[i] = '-'; | |
| 867 | 3633 *location = Fintern (make_string ((const Ibyte *) temp, len), Qnil); |
| 442 | 3634 if (dump_p) |
|
4971
bcdf496e49d0
put back patch to get more informative staticpro debugging
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
3635 staticpro_1 (location, name); |
| 442 | 3636 else |
|
4971
bcdf496e49d0
put back patch to get more informative staticpro debugging
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
3637 staticpro_nodump_1 (location, name); |
| 442 | 3638 } |
| 3639 | |
| 440 | 3640 void |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3641 defsymbol_massage_name_nodump (Lisp_Object *location, const Ascbyte *name) |
| 442 | 3642 { |
| 3643 defsymbol_massage_name_1 (location, name, 0, 0); | |
| 3644 } | |
| 3645 | |
| 3646 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3647 defsymbol_massage_name (Lisp_Object *location, const Ascbyte *name) |
| 428 | 3648 { |
| 442 | 3649 defsymbol_massage_name_1 (location, name, 1, 0); |
| 3650 } | |
| 3651 | |
| 3652 void | |
| 3653 defsymbol_massage_multiword_predicate_nodump (Lisp_Object *location, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3654 const Ascbyte *name) |
| 442 | 3655 { |
| 3656 defsymbol_massage_name_1 (location, name, 0, 1); | |
| 3657 } | |
| 3658 | |
| 3659 void | |
|
4979
4234fd5a7b17
fix bug #668 (compile error, not --with-debug)
Ben Wing <ben@xemacs.org>
parents:
4971
diff
changeset
|
3660 defsymbol_massage_multiword_predicate (Lisp_Object *location, |
|
4234fd5a7b17
fix bug #668 (compile error, not --with-debug)
Ben Wing <ben@xemacs.org>
parents:
4971
diff
changeset
|
3661 const Ascbyte *name) |
| 442 | 3662 { |
| 3663 defsymbol_massage_name_1 (location, name, 1, 1); | |
| 3664 } | |
| 3665 | |
| 3666 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3667 defsymbol_nodump (Lisp_Object *location, const Ascbyte *name) |
| 442 | 3668 { |
| 867 | 3669 *location = Fintern (make_string_nocopy ((const Ibyte *) name, |
| 428 | 3670 strlen (name)), |
| 3671 Qnil); | |
|
4971
bcdf496e49d0
put back patch to get more informative staticpro debugging
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
3672 staticpro_nodump_1 (location, name); |
| 428 | 3673 } |
| 3674 | |
| 3675 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3676 defsymbol (Lisp_Object *location, const Ascbyte *name) |
| 428 | 3677 { |
| 867 | 3678 *location = Fintern (make_string_nocopy ((const Ibyte *) name, |
| 428 | 3679 strlen (name)), |
| 3680 Qnil); | |
|
4971
bcdf496e49d0
put back patch to get more informative staticpro debugging
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
3681 staticpro_1 (location, name); |
| 428 | 3682 } |
| 3683 | |
| 3684 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3685 defkeyword (Lisp_Object *location, const Ascbyte *name) |
| 428 | 3686 { |
| 3687 defsymbol (location, name); | |
| 3688 Fset (*location, *location); | |
| 3689 } | |
| 3690 | |
| 442 | 3691 void |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3692 defkeyword_massage_name (Lisp_Object *location, const Ascbyte *name) |
| 442 | 3693 { |
| 3694 char temp[500]; | |
| 3695 int len = strlen (name); | |
| 3696 | |
| 647 | 3697 assert (len < (int) sizeof (temp)); |
| 442 | 3698 strcpy (temp, name); |
| 3699 temp[1] = ':'; /* it's an underscore in the C variable */ | |
| 3700 | |
| 3701 defsymbol_massage_name (location, temp); | |
| 3702 Fset (*location, *location); | |
| 3703 } | |
| 3704 | |
| 428 | 3705 #ifdef DEBUG_XEMACS |
| 930 | 3706 /* Check that nobody spazzed writing a builtin (non-module) DEFUN. */ |
| 428 | 3707 static void |
| 3708 check_sane_subr (Lisp_Subr *subr, Lisp_Object sym) | |
| 3709 { | |
| 930 | 3710 if (!initialized) { |
| 3711 assert (subr->min_args >= 0); | |
| 3712 assert (subr->min_args <= SUBR_MAX_ARGS); | |
| 3713 | |
| 3714 if (subr->max_args != MANY && | |
| 3715 subr->max_args != UNEVALLED) | |
| 3716 { | |
| 3717 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */ | |
| 3718 assert (subr->max_args <= SUBR_MAX_ARGS); | |
| 3719 assert (subr->min_args <= subr->max_args); | |
| 3720 } | |
| 3721 assert (UNBOUNDP (XSYMBOL (sym)->function)); | |
| 3722 } | |
| 428 | 3723 } |
| 3724 #else | |
| 3725 #define check_sane_subr(subr, sym) /* nothing */ | |
| 3726 #endif | |
| 3727 | |
| 3728 #ifdef HAVE_SHLIB | |
| 3263 | 3729 #ifndef NEW_GC |
| 428 | 3730 /* |
| 3731 * If we are not in a pure undumped Emacs, we need to make a duplicate of | |
| 3732 * the subr. This is because the only time this function will be called | |
| 3733 * in a running Emacs is when a dynamically loaded module is adding a | |
| 3734 * subr, and we need to make sure that the subr is in allocated, Lisp- | |
| 3735 * accessible memory. The address assigned to the static subr struct | |
| 3736 * in the shared object will be a trampoline address, so we need to create | |
| 3737 * a copy here to ensure that a real address is used. | |
| 3738 * | |
| 3739 * Once we have copied everything across, we re-use the original static | |
| 3740 * structure to store a pointer to the newly allocated one. This will be | |
| 3741 * used in emodules.c by emodules_doc_subr() to find a pointer to the | |
| 442 | 3742 * allocated object so that we can set its doc string properly. |
| 428 | 3743 * |
| 442 | 3744 * NOTE: We don't actually use the DOC pointer here any more, but we did |
| 428 | 3745 * in an earlier implementation of module support. There is no harm in |
| 3746 * setting it here in case we ever need it in future implementations. | |
| 3747 * subr->doc will point to the new subr structure that was allocated. | |
| 442 | 3748 * Code can then get this value from the static subr structure and use |
| 428 | 3749 * it if required. |
| 3750 * | |
| 442 | 3751 * FIXME: Should newsubr be staticpro()'ed? I don't think so but I need |
| 428 | 3752 * a guru to check. |
| 3753 */ | |
| 930 | 3754 #define check_module_subr(subr) \ |
| 3755 do { \ | |
| 3756 if (initialized) { \ | |
| 3757 Lisp_Subr *newsubr; \ | |
| 3758 Lisp_Object f; \ | |
| 3759 \ | |
| 3760 if (subr->min_args < 0) \ | |
| 3761 signal_ferror (Qdll_error, "%s min_args (%hd) too small", \ | |
| 3762 subr_name (subr), subr->min_args); \ | |
| 3763 if (subr->min_args > SUBR_MAX_ARGS) \ | |
| 3764 signal_ferror (Qdll_error, "%s min_args (%hd) too big (max = %d)", \ | |
| 3765 subr_name (subr), subr->min_args, SUBR_MAX_ARGS); \ | |
| 3766 \ | |
| 3767 if (subr->max_args != MANY && \ | |
| 3768 subr->max_args != UNEVALLED) \ | |
| 3769 { \ | |
| 3770 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */ \ | |
| 3771 if (subr->max_args > SUBR_MAX_ARGS) \ | |
| 3772 signal_ferror (Qdll_error, "%s max_args (%hd) too big (max = %d)", \ | |
| 3773 subr_name (subr), subr->max_args, SUBR_MAX_ARGS); \ | |
| 3774 if (subr->min_args > subr->max_args) \ | |
| 3775 signal_ferror (Qdll_error, "%s min_args (%hd) > max_args (%hd)", \ | |
| 3776 subr_name (subr), subr->min_args, subr->max_args); \ | |
| 3777 } \ | |
| 3778 \ | |
| 3779 f = XSYMBOL (sym)->function; \ | |
| 3780 if (!UNBOUNDP (f) && (!CONSP (f) || !EQ (XCAR (f), Qautoload))) \ | |
| 3781 signal_ferror (Qdll_error, "Attempt to redefine %s", subr_name (subr)); \ | |
| 3782 \ | |
| 2367 | 3783 newsubr = xnew (Lisp_Subr); \ |
| 930 | 3784 memcpy (newsubr, subr, sizeof (Lisp_Subr)); \ |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3785 subr->doc = (const CIbyte *)newsubr; \ |
| 930 | 3786 subr = newsubr; \ |
| 3787 } \ | |
| 428 | 3788 } while (0) |
| 3263 | 3789 #else /* NEW_GC */ |
| 2963 | 3790 /* |
| 3791 * If we have the new allocator enabled, we do not need to make a | |
| 3792 * duplicate of the subr. The new allocator already does allocate all | |
| 3793 * subrs in Lisp-accessible memory rather than have it in the static | |
| 3794 * subr struct. | |
| 3795 * | |
| 3796 * NOTE: The DOC pointer is not set here as described above. | |
| 3797 */ | |
| 3798 #define check_module_subr(subr) \ | |
| 3799 do { \ | |
| 3800 if (initialized) { \ | |
| 3801 Lisp_Object f; \ | |
| 3802 \ | |
| 3803 if (subr->min_args < 0) \ | |
| 3804 signal_ferror (Qdll_error, "%s min_args (%hd) too small", \ | |
| 3805 subr_name (subr), subr->min_args); \ | |
| 3806 if (subr->min_args > SUBR_MAX_ARGS) \ | |
| 3807 signal_ferror (Qdll_error, "%s min_args (%hd) too big (max = %d)", \ | |
| 3808 subr_name (subr), subr->min_args, SUBR_MAX_ARGS); \ | |
| 3809 \ | |
| 3810 if (subr->max_args != MANY && \ | |
| 3811 subr->max_args != UNEVALLED) \ | |
| 3812 { \ | |
| 3813 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */ \ | |
| 3814 if (subr->max_args > SUBR_MAX_ARGS) \ | |
| 3815 signal_ferror (Qdll_error, "%s max_args (%hd) too big (max = %d)", \ | |
| 3816 subr_name (subr), subr->max_args, SUBR_MAX_ARGS); \ | |
| 3817 if (subr->min_args > subr->max_args) \ | |
| 3818 signal_ferror (Qdll_error, "%s min_args (%hd) > max_args (%hd)", \ | |
| 3819 subr_name (subr), subr->min_args, subr->max_args); \ | |
| 3820 } \ | |
| 3821 \ | |
| 3822 f = XSYMBOL (sym)->function; \ | |
| 3823 if (!UNBOUNDP (f) && (!CONSP (f) || !EQ (XCAR (f), Qautoload))) \ | |
| 3824 signal_ferror (Qdll_error, "Attempt to redefine %s", subr_name (subr)); \ | |
| 3825 } \ | |
| 3826 } while (0) | |
| 3263 | 3827 #endif /* NEW_GC */ |
| 428 | 3828 #else /* ! HAVE_SHLIB */ |
| 930 | 3829 #define check_module_subr(subr) |
| 428 | 3830 #endif |
| 3831 | |
| 3832 void | |
| 3833 defsubr (Lisp_Subr *subr) | |
| 3834 { | |
| 3835 Lisp_Object sym = intern (subr_name (subr)); | |
| 3836 Lisp_Object fun; | |
| 3837 | |
| 3838 check_sane_subr (subr, sym); | |
| 930 | 3839 check_module_subr (subr); |
| 428 | 3840 |
| 793 | 3841 fun = wrap_subr (subr); |
| 428 | 3842 XSYMBOL (sym)->function = fun; |
| 996 | 3843 |
| 3844 #ifdef HAVE_SHLIB | |
| 3845 /* If it is declared in a module, update the load history */ | |
| 3846 if (initialized) | |
| 3847 LOADHIST_ATTACH (sym); | |
| 3848 #endif | |
| 428 | 3849 } |
| 3850 | |
| 3851 /* Define a lisp macro using a Lisp_Subr. */ | |
| 3852 void | |
| 3853 defsubr_macro (Lisp_Subr *subr) | |
| 3854 { | |
| 3855 Lisp_Object sym = intern (subr_name (subr)); | |
| 3856 Lisp_Object fun; | |
| 3857 | |
| 3858 check_sane_subr (subr, sym); | |
| 930 | 3859 check_module_subr (subr); |
| 428 | 3860 |
| 793 | 3861 fun = wrap_subr (subr); |
| 428 | 3862 XSYMBOL (sym)->function = Fcons (Qmacro, fun); |
| 996 | 3863 |
| 3864 #ifdef HAVE_SHLIB | |
| 3865 /* If it is declared in a module, update the load history */ | |
| 3866 if (initialized) | |
| 3867 LOADHIST_ATTACH (sym); | |
| 3868 #endif | |
| 428 | 3869 } |
| 3870 | |
| 442 | 3871 static void |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3872 deferror_1 (Lisp_Object *symbol, const Ascbyte *name, const Ascbyte *messuhhj, |
| 442 | 3873 Lisp_Object inherits_from, int massage_p) |
| 428 | 3874 { |
| 3875 Lisp_Object conds; | |
| 442 | 3876 if (massage_p) |
| 3877 defsymbol_massage_name (symbol, name); | |
| 3878 else | |
| 3879 defsymbol (symbol, name); | |
| 428 | 3880 |
| 3881 assert (SYMBOLP (inherits_from)); | |
| 3882 conds = Fget (inherits_from, Qerror_conditions, Qnil); | |
| 3883 Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds)); | |
| 771 | 3884 /* NOT build_msg_string (). This function is called at load time |
| 428 | 3885 and the string needs to get translated at run time. (This happens |
| 3886 in the function (display-error) in cmdloop.el.) */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3887 Fput (*symbol, Qerror_message, build_defer_string (messuhhj)); |
| 428 | 3888 } |
| 3889 | |
| 3890 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3891 deferror (Lisp_Object *symbol, const Ascbyte *name, const Ascbyte *messuhhj, |
| 442 | 3892 Lisp_Object inherits_from) |
| 3893 { | |
| 3894 deferror_1 (symbol, name, messuhhj, inherits_from, 0); | |
| 3895 } | |
| 3896 | |
| 3897 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3898 deferror_massage_name (Lisp_Object *symbol, const Ascbyte *name, |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3899 const Ascbyte *messuhhj, Lisp_Object inherits_from) |
| 442 | 3900 { |
| 3901 deferror_1 (symbol, name, messuhhj, inherits_from, 1); | |
| 3902 } | |
| 3903 | |
| 3904 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
3905 deferror_massage_name_and_message (Lisp_Object *symbol, const Ascbyte *name, |
| 442 | 3906 Lisp_Object inherits_from) |
| 3907 { | |
| 3908 char temp[500]; | |
| 3909 int i; | |
| 3910 int len = strlen (name) - 1; | |
| 3911 | |
| 647 | 3912 assert (len < (int) sizeof (temp)); |
| 442 | 3913 strcpy (temp, name + 1); /* Remove initial Q */ |
| 3914 temp[0] = toupper (temp[0]); | |
| 3915 for (i = 0; i < len; i++) | |
| 3916 if (temp[i] == '_') | |
| 3917 temp[i] = ' '; | |
| 3918 | |
| 3919 deferror_1 (symbol, name, temp, inherits_from, 1); | |
| 3920 } | |
| 3921 | |
| 3922 void | |
| 428 | 3923 syms_of_symbols (void) |
| 3924 { | |
| 442 | 3925 DEFSYMBOL (Qvariable_documentation); |
| 3926 DEFSYMBOL (Qvariable_domain); /* I18N3 */ | |
| 3927 DEFSYMBOL (Qad_advice_info); | |
| 3928 DEFSYMBOL (Qad_activate); | |
| 3929 | |
| 3930 DEFSYMBOL (Qget_value); | |
| 3931 DEFSYMBOL (Qset_value); | |
| 3932 DEFSYMBOL (Qbound_predicate); | |
| 3933 DEFSYMBOL (Qmake_unbound); | |
| 3934 DEFSYMBOL (Qlocal_predicate); | |
| 3935 DEFSYMBOL (Qmake_local); | |
| 3936 | |
| 3937 DEFSYMBOL (Qboundp); | |
| 3938 DEFSYMBOL (Qglobally_boundp); | |
| 3939 DEFSYMBOL (Qmakunbound); | |
| 3940 DEFSYMBOL (Qsymbol_value); | |
| 3941 DEFSYMBOL (Qset); | |
| 3942 DEFSYMBOL (Qsetq_default); | |
| 3943 DEFSYMBOL (Qdefault_boundp); | |
| 3944 DEFSYMBOL (Qdefault_value); | |
| 3945 DEFSYMBOL (Qset_default); | |
| 3946 DEFSYMBOL (Qmake_variable_buffer_local); | |
| 3947 DEFSYMBOL (Qmake_local_variable); | |
| 3948 DEFSYMBOL (Qkill_local_variable); | |
| 3949 DEFSYMBOL (Qkill_console_local_variable); | |
| 3950 DEFSYMBOL (Qsymbol_value_in_buffer); | |
| 3951 DEFSYMBOL (Qsymbol_value_in_console); | |
| 3952 DEFSYMBOL (Qlocal_variable_p); | |
| 3953 DEFSYMBOL (Qconst_integer); | |
| 3954 DEFSYMBOL (Qconst_boolean); | |
| 3955 DEFSYMBOL (Qconst_object); | |
| 3956 DEFSYMBOL (Qconst_specifier); | |
| 3957 DEFSYMBOL (Qdefault_buffer); | |
| 3958 DEFSYMBOL (Qcurrent_buffer); | |
| 3959 DEFSYMBOL (Qconst_current_buffer); | |
| 3960 DEFSYMBOL (Qdefault_console); | |
| 3961 DEFSYMBOL (Qselected_console); | |
| 3962 DEFSYMBOL (Qconst_selected_console); | |
| 428 | 3963 |
| 3964 DEFSUBR (Fintern); | |
| 3965 DEFSUBR (Fintern_soft); | |
| 3966 DEFSUBR (Funintern); | |
| 3967 DEFSUBR (Fmapatoms); | |
| 3968 DEFSUBR (Fapropos_internal); | |
| 3969 | |
| 3970 DEFSUBR (Fsymbol_function); | |
| 3971 DEFSUBR (Fsymbol_plist); | |
| 3972 DEFSUBR (Fsymbol_name); | |
| 3973 DEFSUBR (Fmakunbound); | |
| 3974 DEFSUBR (Ffmakunbound); | |
| 3975 DEFSUBR (Fboundp); | |
| 3976 DEFSUBR (Fglobally_boundp); | |
| 3977 DEFSUBR (Ffboundp); | |
| 3978 DEFSUBR (Ffset); | |
| 3979 DEFSUBR (Fdefine_function); | |
| 3980 Ffset (intern ("defalias"), intern ("define-function")); | |
| 3368 | 3981 DEFSUBR (Fsubr_name); |
|
4905
755ae5b97edb
Change "special form" to "special operator" in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4793
diff
changeset
|
3982 DEFSUBR (Fspecial_operator_p); |
| 428 | 3983 DEFSUBR (Fsetplist); |
| 3984 DEFSUBR (Fsymbol_value_in_buffer); | |
| 3985 DEFSUBR (Fsymbol_value_in_console); | |
| 3986 DEFSUBR (Fbuilt_in_variable_type); | |
| 3987 DEFSUBR (Fsymbol_value); | |
| 3988 DEFSUBR (Fset); | |
| 3989 DEFSUBR (Fdefault_boundp); | |
| 3990 DEFSUBR (Fdefault_value); | |
| 3991 DEFSUBR (Fset_default); | |
| 3992 DEFSUBR (Fsetq_default); | |
| 3993 DEFSUBR (Fmake_variable_buffer_local); | |
| 3994 DEFSUBR (Fmake_local_variable); | |
| 3995 DEFSUBR (Fkill_local_variable); | |
| 3996 DEFSUBR (Fkill_console_local_variable); | |
| 3997 DEFSUBR (Flocal_variable_p); | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3998 DEFSUBR (Fcustom_variable_p); |
|
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3999 DEFSUBR (Fuser_variable_p); |
| 428 | 4000 DEFSUBR (Fdefvaralias); |
| 4001 DEFSUBR (Fvariable_alias); | |
| 4002 DEFSUBR (Findirect_variable); | |
| 1674 | 4003 DEFSUBR (Fvariable_binding_locus); |
| 428 | 4004 DEFSUBR (Fdontusethis_set_symbol_value_handler); |
| 4005 } | |
| 4006 | |
| 4007 /* Create and initialize a Lisp variable whose value is forwarded to C data */ | |
| 4008 void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
4009 defvar_magic (const Ascbyte *symbol_name, |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
4010 const struct symbol_value_forward *magic) |
| 428 | 4011 { |
| 442 | 4012 Lisp_Object sym; |
| 428 | 4013 |
| 996 | 4014 #ifdef HAVE_SHLIB |
| 428 | 4015 /* |
| 4016 * As with defsubr(), this will only be called in a dumped Emacs when | |
| 4017 * we are adding variables from a dynamically loaded module. That means | |
| 4018 * we can't use purespace. Take that into account. | |
| 4019 */ | |
| 4020 if (initialized) | |
| 996 | 4021 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4940
diff
changeset
|
4022 sym = Fintern (build_ascstring (symbol_name), Qnil); |
| 996 | 4023 LOADHIST_ATTACH (sym); |
| 4024 } | |
| 428 | 4025 else |
| 4026 #endif | |
| 867 | 4027 sym = Fintern (make_string_nocopy ((const Ibyte *) symbol_name, |
| 428 | 4028 strlen (symbol_name)), Qnil); |
| 4029 | |
| 793 | 4030 XSYMBOL (sym)->value = wrap_pointer_1 (magic); |
| 428 | 4031 } |
| 4032 | |
| 4033 void | |
| 4034 vars_of_symbols (void) | |
| 4035 { | |
| 4036 DEFVAR_LISP ("obarray", &Vobarray /* | |
| 4037 Symbol table for use by `intern' and `read'. | |
| 4038 It is a vector whose length ought to be prime for best results. | |
| 4039 The vector's contents don't make sense if examined from Lisp programs; | |
| 4040 to find all the symbols in an obarray, use `mapatoms'. | |
| 4041 */ ); | |
| 4042 /* obarray has been initialized long before */ | |
| 4043 } |