annotate src/symbols.c @ 665:fdefd0186b75

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