fc4a3ad079dea144ccc74b80840ceafd9dbf6fd6
[chise/xemacs-chise.git.1] / src / symeval.h
1 /* Definitions of symbol-value forwarding for XEmacs Lisp interpreter.
2    Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.
3
4 This file is part of XEmacs.
5
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
9 later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING.  If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA.  */
20
21 /* Synched up with: Not in FSF. */
22
23 /* Fsymbol_value checks whether XSYMBOL (sym)->value is one of these,
24  *  and does weird magic stuff if so */
25
26 #ifndef _XEMACS_SYMEVAL_H_
27 #define _XEMACS_SYMEVAL_H_
28
29 enum symbol_value_type
30 {
31   /* The following tags use the 'symbol_value_forward' structure
32      and are strictly for variables DEFVARed on the C level. */
33   SYMVAL_FIXNUM_FORWARD,        /* Forward C "int" */
34   SYMVAL_CONST_FIXNUM_FORWARD,  /* Same, but can't be set */
35   SYMVAL_BOOLEAN_FORWARD,       /* Forward C boolean ("int") */
36   SYMVAL_CONST_BOOLEAN_FORWARD, /* Same, but can't be set */
37   SYMVAL_OBJECT_FORWARD,        /* Forward C Lisp_Object */
38   SYMVAL_CONST_OBJECT_FORWARD,  /* Same, but can't be set */
39   SYMVAL_CONST_SPECIFIER_FORWARD, /* Same, can't be set, but gives a
40                                      different message when attempting to
41                                      set that says "use set-specifier" */
42   SYMVAL_DEFAULT_BUFFER_FORWARD, /* Forward Lisp_Object into Vbuffer_defaults */
43   SYMVAL_CURRENT_BUFFER_FORWARD, /* Forward Lisp_Object into current_buffer */
44   SYMVAL_CONST_CURRENT_BUFFER_FORWARD, /* Forward Lisp_Object into
45                                           current_buffer, can't be set */
46   SYMVAL_DEFAULT_CONSOLE_FORWARD, /* Forward Lisp_Object into
47                                      Vconsole_defaults */
48   SYMVAL_SELECTED_CONSOLE_FORWARD, /* Forward Lisp_Object into
49                                       Vselected_console */
50   SYMVAL_CONST_SELECTED_CONSOLE_FORWARD, /* Forward Lisp_Object into
51                                             Vselected_console,
52                                             can't be set */
53   SYMVAL_UNBOUND_MARKER,        /* Only Qunbound actually has this tag */
54
55   /* The following tags use the 'symbol_value_buffer_local' structure */
56   SYMVAL_BUFFER_LOCAL,          /* make-variable-buffer-local */
57   SYMVAL_SOME_BUFFER_LOCAL,     /* make-local-variable */
58
59   /* The following tag uses the 'symbol_value_lisp_magic' structure */
60   SYMVAL_LISP_MAGIC,            /* Forward to lisp callbacks */
61
62   /* The following tag uses the 'symbol_value_varalias' structure */
63   SYMVAL_VARALIAS               /* defvaralias */
64
65 #if 0
66   /* NYI */
67   SYMVAL_CONSTANT_SYMBOL,       /* Self-evaluating symbol */
68   /* NYI */
69 #endif
70 };
71
72 struct symbol_value_magic
73 {
74   struct lcrecord_header lcheader;
75   enum symbol_value_type type;
76 };
77 #define SYMBOL_VALUE_MAGIC_P(x)                         \
78   (LRECORDP (x)                                         \
79    && (XRECORD_LHEADER_IMPLEMENTATION (x)->printer      \
80        == print_symbol_value_magic))
81 #define XSYMBOL_VALUE_MAGIC_TYPE(v) \
82         (((struct symbol_value_magic *) XPNTR (v))->type)
83 #define XSETSYMBOL_VALUE_MAGIC(s, p) XSETOBJ (s, Lisp_Type_Record, p)
84 void print_symbol_value_magic (Lisp_Object, Lisp_Object, int);
85
86 /********** The various different symbol-value-magic types ***********/
87
88 /* 1. symbol-value-forward */
89
90 /* This type of symbol-value-magic is used for variables declared
91    DEFVAR_LISP, DEFVAR_INT, DEFVAR_BOOL, DEFVAR_BUFFER_LOCAL,
92    DEFVAR_BUFFER_DEFAULTS, DEFVAR_SPECIFIER, and for Qunbound.
93
94    Note that some of these types of variables can be made buffer-local.
95    Then, the symbol's value field contains a symbol-value-buffer-local,
96    whose CURRENT-VALUE field then contains a symbol-value-forward.
97  */
98
99 struct symbol_value_forward
100 {
101   struct symbol_value_magic magic;
102   /* void *forward; -- use magic.lcheader.next instead */
103   /* Function controlling magic behavior of this forward variable.
104
105      SYM is the symbol being operated on (read, set, etc.);
106
107      VAL is either the value to set or the value to be returned.
108
109      IN_OBJECT is the buffer or console that the value is read in
110        or set in.  A value of Qnil means that the current buffer
111        and possibly other buffers are being set. (This value will
112        never be passed for built-in buffer-local or console-local
113        variables such as `truncate-lines'.) (Currently, a value of
114        Qnil is always passed for DEFVAR_INT, DEFVAR_LISP, and
115        DEFVAR_BOOL variables; the code isn't smart enough to figure
116        out what buffers besides the current buffer are being
117        affected.  Because the magic function is called
118        before the value is changed, it's not that easy
119        to determine which buffers are getting changed.
120        #### If this information is important, let me know
121        and I will look into providing it.) (Remember also
122        that the only console-local variables currently existing
123        are built-in ones, because others can't be created.)
124
125      FLAGS gives more information about the operation being
126        performed.
127
128      The return value indicates what the magic function actually
129        did.
130
131      Currently FLAGS and the return value are not used.  This
132      function is only called when the value of a forward variable
133      is about to be changed.  Note that this can occur explicitly
134      through a call to `set', `setq', `set-default', or `setq-default',
135      or implicitly by the current buffer being changed.
136
137      */
138
139   int (*magicfun) (Lisp_Object sym, Lisp_Object *val, Lisp_Object in_object,
140                    int flags);
141 };
142 DECLARE_LRECORD (symbol_value_forward, struct symbol_value_forward);
143 #define XSYMBOL_VALUE_FORWARD(x) \
144         XRECORD (x, symbol_value_forward, struct symbol_value_forward)
145 #define symbol_value_forward_forward(m) ((void *)((m)->magic.lcheader.next))
146 #define symbol_value_forward_magicfun(m) ((m)->magicfun)
147
148 /* 2. symbol-value-buffer-local */
149
150 struct symbol_value_buffer_local
151 {
152   struct symbol_value_magic magic;
153   /* Used in a symbol value cell when the symbol's value is per-buffer.
154
155      The type of the symbol-value-magic will be either
156      SYMVAL_BUFFER_LOCAL (i.e. `make-variable-buffer-local' was called)
157      or SYMVAL_SOME_BUFFER_LOCAL (i.e. `make-local-variable' was called).
158      The only difference between the two is that when setting the
159      former kind of variable, an implicit `make-local-variable' is
160      called.
161
162      A buffer-local variable logically has
163
164      -- a default value
165      -- local values in some buffers
166
167      The primary place where the local values are stored is in each
168      buffer's local_var_alist slot.
169
170      In the simplest implementation, all that this structure needs to
171      keep track of is the default value; to retrieve the value in
172      a buffer, look in that buffer's local_var_alist, and use the
173      default value if there is no local value.  To implement
174      `make-local-variable' in a buffer, look in the buffer's
175      local_var_alist, and if no element exists for this symbol,
176      add one, copying the value from the default value.  When setting
177      the value in a buffer, look in the buffer's local_var_alist, and set
178      the value in that list if an element exists for this symbol;
179      otherwise, set the default. (Remember that SYMVAL_BUFFER_LOCAL
180      variables implicitly call `make-local-variable' first, so when
181      setting a value, there will always be an entry in the buffer's
182      local_var_alist to set.)
183
184      However, this operation is potentially slow.  To speed it up,
185      we cache the value in one buffer in this structure.
186
187      NOTE: This is *not* a write-through cache.  I.e. when setting
188      the value in the buffer that is cached, we *only* change the
189      cache and don't write the value through to either the buffer's
190      local_var_alist or the default value.  Therefore, when retrieving
191      a value in a buffer, you must *always* look in the cache to see if
192      it refers to that buffer.
193
194      The cache consists of
195
196      -- a buffer, or nil if the cache has not been set up
197      -- the value in that buffer
198      -- the element (a cons) from the buffer's local_var_alist, or
199         nil if there is no local value in the buffer
200
201     These slots are called CURRENT-BUFFER, CURRENT-VALUE, and
202     CURRENT-ALIST-ELEMENT, respectively.
203
204     If we want to examine or set the value in BUFFER and CURRENT-BUFFER
205     equals BUFFER, we just examine or set CURRENT-VALUE.  Otherwise,
206     we store CURRENT-VALUE value into CURRENT-ALIST-ELEMENT (or maybe
207     into DEFAULT-VALUE), then find the appropriate alist element for
208     BUFFER and set up CURRENT-ALIST-ELEMENT.  Then we set CURRENT-VALUE
209     out of that element (or maybe out of DEFAULT-VALUE), and store
210     BUFFER into CURRENT-BUFFER.
211
212     If we are setting the variable and the current buffer does not have
213     an alist entry for this variable, an alist entry is created.
214
215     Note that CURRENT-BUFFER's local_var_alist value for this variable
216     might be out-of-date (the correct value is stored in CURRENT-VALUE).
217     Similarly, if CURRENT-BUFFER sees the default value, then
218     DEFAULT-VALUE might be out-of-date.
219
220     Note that CURRENT-VALUE (but not DEFAULT-VALUE) can be a
221     forwarding pointer.  Each time it is examined or set,
222     forwarding must be done.
223    */
224   Lisp_Object default_value;
225   Lisp_Object current_value;
226   Lisp_Object current_buffer;
227   Lisp_Object current_alist_element;
228 };
229 DECLARE_LRECORD (symbol_value_buffer_local, struct symbol_value_buffer_local);
230 #define XSYMBOL_VALUE_BUFFER_LOCAL(x) \
231         XRECORD (x, symbol_value_buffer_local, struct symbol_value_buffer_local)
232 #define SYMBOL_VALUE_BUFFER_LOCAL_P(x) RECORDP (x, symbol_value_buffer_local)
233
234 /* 3. symbol-value-lisp-magic */
235
236 enum lisp_magic_handler
237 {
238   MAGIC_HANDLER_GET_VALUE,
239   MAGIC_HANDLER_SET_VALUE,
240   MAGIC_HANDLER_BOUND_PREDICATE,
241   MAGIC_HANDLER_MAKE_UNBOUND,
242   MAGIC_HANDLER_LOCAL_PREDICATE,
243   MAGIC_HANDLER_MAKE_LOCAL,
244   MAGIC_HANDLER_MAX
245 };
246
247 struct symbol_value_lisp_magic
248 {
249   struct symbol_value_magic magic;
250   Lisp_Object handler[MAGIC_HANDLER_MAX];
251   Lisp_Object harg[MAGIC_HANDLER_MAX];
252   Lisp_Object shadowed;
253 };
254 DECLARE_LRECORD (symbol_value_lisp_magic, struct symbol_value_lisp_magic);
255 #define XSYMBOL_VALUE_LISP_MAGIC(x) \
256         XRECORD (x, symbol_value_lisp_magic, struct symbol_value_lisp_magic)
257 #define SYMBOL_VALUE_LISP_MAGIC_P(x) RECORDP (x, symbol_value_lisp_magic)
258
259 /* 4. symbol-value-varalias */
260
261 struct symbol_value_varalias
262 {
263   struct symbol_value_magic magic;
264   Lisp_Object aliasee;
265   Lisp_Object shadowed;
266 };
267 DECLARE_LRECORD (symbol_value_varalias, struct symbol_value_varalias);
268 #define XSYMBOL_VALUE_VARALIAS(x) \
269         XRECORD (x, symbol_value_varalias, struct symbol_value_varalias)
270 #define SYMBOL_VALUE_VARALIAS_P(x) RECORDP (x, symbol_value_varalias)
271 #define symbol_value_varalias_aliasee(m) ((m)->aliasee)
272 #define symbol_value_varalias_shadowed(m) ((m)->shadowed)
273
274 /* DEFSUBR (Fname);
275  is how we define the symbol for function `Fname' at start-up time. */
276 #define DEFSUBR(Fname) defsubr (&S##Fname)
277 void defsubr (struct Lisp_Subr *);
278
279 void defsymbol (Lisp_Object *location, CONST char *name);
280
281 void defkeyword (Lisp_Object *location, CONST char *name);
282
283 void deferror (Lisp_Object *symbol, CONST char *name,
284                CONST char *message, Lisp_Object inherits_from);
285
286 /* Macros we use to define forwarded Lisp variables.
287    These are used in the syms_of_FILENAME functions.  */
288
289 void defvar_mumble (CONST char *names, CONST void *magic, size_t sizeof_magic);
290
291 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
292 # define symbol_value_forward_lheader_initializer { 1, 0, 0 }
293 #else
294 # define symbol_value_forward_lheader_initializer \
295    { lrecord_symbol_value_forward }
296 #endif
297
298 #define DEFVAR_HEADER(lname, c_location, forward_type) \
299         DEFVAR_MAGIC_HEADER (lname, c_location, forward_type, 0)
300
301 #define DEFVAR_MAGIC_HEADER(lname, c_location, forward_type, magicfun) do {     \
302   static CONST struct symbol_value_forward I_hate_C                             \
303    = { { { symbol_value_forward_lheader_initializer,                            \
304            (struct lcrecord_header *) (c_location), 69 },                       \
305          forward_type }, magicfun };                                            \
306   defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C));                        \
307 } while (0)
308
309 #define DEFVAR_HEADER_GCPRO(lname, c_location, symbol_value_type) do {  \
310   DEFVAR_HEADER (lname, c_location, symbol_value_type);                 \
311   staticpro (c_location);                                               \
312 } while (0)
313
314 #define DEFVAR_LISP(lname, c_location)  \
315         DEFVAR_HEADER_GCPRO (lname, c_location, SYMVAL_OBJECT_FORWARD)
316 #define DEFVAR_CONST_LISP(lname, c_location) \
317         DEFVAR_HEADER_GCPRO (lname, c_location, SYMVAL_CONST_OBJECT_FORWARD)
318 #define DEFVAR_SPECIFIER(lname, c_location) \
319         DEFVAR_HEADER_GCPRO (lname, c_location, SYMVAL_CONST_SPECIFIER_FORWARD)
320 #define DEFVAR_INT(lname, c_location) \
321         DEFVAR_HEADER (lname, c_location, SYMVAL_FIXNUM_FORWARD)
322 #define DEFVAR_CONST_INT(lname, c_location) \
323         DEFVAR_HEADER (lname, c_location, SYMVAL_CONST_FIXNUM_FORWARD)
324 #define DEFVAR_BOOL(lname, c_location) \
325         DEFVAR_HEADER (lname, c_location, SYMVAL_BOOLEAN_FORWARD)
326 #define DEFVAR_CONST_BOOL(lname, c_location) \
327         DEFVAR_HEADER (lname, c_location, SYMVAL_CONST_BOOLEAN_FORWARD)
328
329 #define DEFVAR_LISP_MAGIC(lname, c_location, magicfun) do {                \
330  DEFVAR_MAGIC_HEADER (lname, c_location, SYMVAL_OBJECT_FORWARD, magicfun); \
331  staticpro (c_location);                                                   \
332 } while (0)
333 #define DEFVAR_INT_MAGIC(lname, c_location, magicfun) \
334   DEFVAR_MAGIC_HEADER (lname, c_location, SYMVAL_FIXNUM_FORWARD, magicfun);
335 #define DEFVAR_BOOL_MAGIC(lname, c_location, magicfun) \
336   DEFVAR_MAGIC_HEADER (lname, c_location, SYMVAL_BOOLEAN_FORWARD, magicfun);
337
338 #endif /* _XEMACS_SYMEVAL_H_ */