git.chise.org Git - chise/xemacs-chise.git-/blob - 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    Copyright (C) 2000 Ben Wing.
   4
   5 This file is part of XEmacs.
   6
   7 XEmacs is free software; you can redistribute it and/or modify it
   8 under the terms of the GNU General Public License as published by the
   9 Free Software Foundation; either version 2, or (at your option) any
  10 later version.
  11
  12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with XEmacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 /* Synched up with: Not in FSF. */
  23
  24 /* Fsymbol_value checks whether XSYMBOL (sym)->value is one of these,
  25  *  and does weird magic stuff if so */
  26
  27 #ifndef INCLUDED_symeval_h_
  28 #define INCLUDED_symeval_h_
  29
  30 enum symbol_value_type
  31 {
  32   /* The following tags use the 'symbol_value_forward' structure
  33      and are strictly for variables DEFVARed on the C level. */
  34   SYMVAL_FIXNUM_FORWARD,        /* Forward C "Fixnum", really "EMACS_INT" */
  35   SYMVAL_CONST_FIXNUM_FORWARD,  /* Same, but can't be set */
  36   SYMVAL_BOOLEAN_FORWARD,       /* Forward C boolean ("int") */
  37   SYMVAL_CONST_BOOLEAN_FORWARD, /* Same, but can't be set */
  38   SYMVAL_OBJECT_FORWARD,        /* Forward C Lisp_Object */
  39   SYMVAL_CONST_OBJECT_FORWARD,  /* Same, but can't be set */
  40   SYMVAL_CONST_SPECIFIER_FORWARD, /* Same, can't be set, but gives a
  41                                      different message when attempting to
  42                                      set that says "use set-specifier" */
  43   SYMVAL_DEFAULT_BUFFER_FORWARD, /* Forward Lisp_Object into Vbuffer_defaults */
  44   SYMVAL_CURRENT_BUFFER_FORWARD, /* Forward Lisp_Object into current_buffer */
  45   SYMVAL_CONST_CURRENT_BUFFER_FORWARD, /* Forward Lisp_Object into
  46                                           current_buffer, can't be set */
  47   SYMVAL_DEFAULT_CONSOLE_FORWARD, /* Forward Lisp_Object into
  48                                      Vconsole_defaults */
  49   SYMVAL_SELECTED_CONSOLE_FORWARD, /* Forward Lisp_Object into
  50                                       Vselected_console */
  51   SYMVAL_CONST_SELECTED_CONSOLE_FORWARD, /* Forward Lisp_Object into
  52                                             Vselected_console,
  53                                             can't be set */
  54   SYMVAL_UNBOUND_MARKER,        /* Only Qunbound actually has this tag */
  55
  56   /* The following tags use the 'symbol_value_buffer_local' structure */
  57   SYMVAL_BUFFER_LOCAL,          /* make-variable-buffer-local */
  58   SYMVAL_SOME_BUFFER_LOCAL,     /* make-local-variable */
  59
  60   /* The following tag uses the 'symbol_value_lisp_magic' structure */
  61   SYMVAL_LISP_MAGIC,            /* Forward to lisp callbacks */
  62
  63   /* The following tag uses the 'symbol_value_varalias' structure */
  64   SYMVAL_VARALIAS               /* defvaralias */
  65
  66 #if 0
  67   /* NYI */
  68   SYMVAL_CONSTANT_SYMBOL,       /* Self-evaluating symbol */
  69   /* NYI */
  70 #endif
  71 };
  72
  73 /* Underlying C type used to implement DEFVAR_INT */
  74 typedef EMACS_INT Fixnum;
  75
  76 struct symbol_value_magic
  77 {
  78   struct lcrecord_header lcheader;
  79   void *value;
  80   enum symbol_value_type type;
  81 };
  82 #define SYMBOL_VALUE_MAGIC_P(x)                                         \
  83 (LRECORDP (x) &&                                                        \
  84  XRECORD_LHEADER (x)->type <= lrecord_type_max_symbol_value_magic)
  85 #define XSYMBOL_VALUE_MAGIC_TYPE(v) \
  86         (((struct symbol_value_magic *) XPNTR (v))->type)
  87 #define XSETSYMBOL_VALUE_MAGIC(s, p) XSETOBJ (s, p)
  88 void print_symbol_value_magic (Lisp_Object, Lisp_Object, int);
  89
  90 /********** The various different symbol-value-magic types ***********/
  91
  92 /* 1. symbol-value-forward */
  93
  94 /* This type of symbol-value-magic is used for variables declared
  95    DEFVAR_LISP, DEFVAR_INT, DEFVAR_BOOL, DEFVAR_BUFFER_LOCAL,
  96    DEFVAR_BUFFER_DEFAULTS, DEFVAR_SPECIFIER, and for Qunbound.
  97
  98    Note that some of these types of variables can be made buffer-local.
  99    Then, the symbol's value field contains a symbol-value-buffer-local,
 100    whose CURRENT-VALUE field then contains a symbol-value-forward.
 101  */
 102
 103 struct symbol_value_forward
 104 {
 105   struct symbol_value_magic magic;
 106
 107   /* `magicfun' is a function controlling the magic behavior of this
 108       forward variable.
 109
 110      SYM is the symbol being operated on (read, set, etc.);
 111
 112      VAL is either the value to set or the value to be returned.
 113
 114      IN_OBJECT is the buffer or console that the value is read in
 115        or set in.  A value of Qnil means that the current buffer
 116        and possibly other buffers are being set. (This value will
 117        never be passed for built-in buffer-local or console-local
 118        variables such as `truncate-lines'.) (Currently, a value of
 119        Qnil is always passed for DEFVAR_INT, DEFVAR_LISP, and
 120        DEFVAR_BOOL variables; the code isn't smart enough to figure
 121        out what buffers besides the current buffer are being
 122        affected.  Because the magic function is called
 123        before the value is changed, it's not that easy
 124        to determine which buffers are getting changed.
 125        #### If this information is important, let me know
 126        and I will look into providing it.) (Remember also
 127        that the only console-local variables currently existing
 128        are built-in ones, because others can't be created.)
 129
 130      FLAGS gives more information about the operation being performed.
 131
 132      The return value indicates what the magic function actually did.
 133
 134      Currently FLAGS and the return value are not used.  This
 135      function is only called when the value of a forward variable
 136      is about to be changed.  Note that this can occur explicitly
 137      through a call to `set', `setq', `set-default', or `setq-default',
 138      or implicitly by the current buffer being changed.  */
 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.value))
 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 /* To define a Lisp primitive function using a C function `Fname', do this:
 275    DEFUN ("name, Fname, ...); // at top level in foo.c
 276    DEFSUBR (Fname);           // in syms_of_foo();
 277 */
 278 void defsubr (Lisp_Subr *);
 279 #define DEFSUBR(Fname) defsubr (&S##Fname)
 280
 281 /* To define a Lisp primitive macro using a C function `Fname', do this:
 282    DEFUN ("name, Fname, ...); // at top level in foo.c
 283    DEFSUBR_MACRO (Fname);     // in syms_of_foo();
 284 */
 285 void defsubr_macro (Lisp_Subr *);
 286 #define DEFSUBR_MACRO(Fname) defsubr_macro (&S##Fname)
 287
 288 void defsymbol_massage_name (Lisp_Object *location, const char *name);
 289 void defsymbol_massage_name_nodump (Lisp_Object *location, const char *name);
 290 void defsymbol_massage_multiword_predicate (Lisp_Object *location,
 291                                             const char *name);
 292 void defsymbol_massage_multiword_predicate_nodump (Lisp_Object *location,
 293                                                    const char *name);
 294 void defsymbol (Lisp_Object *location, const char *name);
 295 void defsymbol_nodump (Lisp_Object *location, const char *name);
 296
 297 #define DEFSYMBOL(name) defsymbol_massage_name (&name, #name)
 298 #define DEFSYMBOL_NO_DUMP(name) defsymbol_massage_name_nodump (&name, #name)
 299 #define DEFSYMBOL_MULTIWORD_PREDICATE(name) \
 300   defsymbol_massage_multiword_predicate (&name, #name)
 301 #define DEFSYMBOL_MULTIWORD_PREDICATE_NO_DUMP(name) \
 302   defsymbol_massage_multiword_predicate_nodump (&name, #name)
 303
 304 void defkeyword (Lisp_Object *location, const char *name);
 305 void defkeyword_massage_name (Lisp_Object *location, const char *name);
 306 #define DEFKEYWORD(name) defkeyword_massage_name (&name, #name)
 307
 308 void deferror (Lisp_Object *symbol, const char *name,
 309                const char *message, Lisp_Object inherits_from);
 310 void deferror_massage_name (Lisp_Object *symbol, const char *name,
 311                             const char *message, Lisp_Object inherits_from);
 312 void deferror_massage_name_and_message (Lisp_Object *symbol, const char *name,
 313                                         Lisp_Object inherits_from);
 314 #define DEFERROR(name, message, inherits_from) \
 315   deferror_massage_name (&name, #name, message, inherits_from)
 316 /* In this case, the error message is the same as the name, modulo some
 317    prettifying */
 318 #define DEFERROR_STANDARD(name, inherits_from) \
 319   deferror_massage_name_and_message (&name, #name, inherits_from)
 320
 321 /* Macros we use to define forwarded Lisp variables.
 322    These are used in the syms_of_FILENAME functions.  */
 323
 324 void defvar_magic (const char *symbol_name, const struct symbol_value_forward *magic);
 325
 326 #define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magicfun) do {       \
 327   static const struct symbol_value_forward I_hate_C =                           \
 328   { /* struct symbol_value_forward */                                           \
 329     { /* struct symbol_value_magic */                                           \
 330       { /* struct lcrecord_header */                                            \
 331         { /* struct lrecord_header */                                           \
 332           lrecord_type_symbol_value_forward, /* lrecord_type_index */           \
 333           1, /* mark bit */                                                     \
 334           1, /* c_readonly bit */                                               \
 335           1  /* lisp_readonly bit */                                            \
 336         },                                                                      \
 337         0, /* next */                                                           \
 338         0, /* uid  */                                                           \
 339         0  /* free */                                                           \
 340       },                                                                        \
 341       c_location,                                                               \
 342       forward_type                                                              \
 343     },                                                                          \
 344     magicfun                                                                    \
 345   };                                                                            \
 346   defvar_magic ((lname), &I_hate_C);                                            \
 347 } while (0)
 348
 349 #define DEFVAR_SYMVAL_FWD_INT(lname, c_location, forward_type, magicfun) do{    \
 350   DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun);                \
 351   dump_add_opaque_int (c_location);                                             \
 352 } while (0)
 353
 354 #define DEFVAR_SYMVAL_FWD_FIXNUM(lname, c_location, forward_type, magicfun) do{ \
 355   DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun);                \
 356   dump_add_opaque_fixnum (c_location);                                          \
 357 } while (0)
 358
 359 #define DEFVAR_SYMVAL_FWD_OBJECT(lname, c_location, forward_type, magicfun) do{ \
 360   DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun);                \
 361   {                                                                             \
 362     Lisp_Object *DSF_location = c_location; /* Type check */                    \
 363     staticpro (DSF_location);                                                   \
 364     if (EQ (*DSF_location, Qnull_pointer)) *DSF_location = Qnil;                \
 365   }                                                                             \
 366 } while (0)
 367
 368 #define DEFVAR_LISP(lname, c_location) \
 369         DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_OBJECT_FORWARD, 0)
 370 #define DEFVAR_CONST_LISP(lname, c_location) \
 371         DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_CONST_OBJECT_FORWARD, 0)
 372 #define DEFVAR_SPECIFIER(lname, c_location) \
 373         DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_CONST_SPECIFIER_FORWARD, 0)
 374 #define DEFVAR_INT(lname, c_location) \
 375         DEFVAR_SYMVAL_FWD_FIXNUM (lname, c_location, SYMVAL_FIXNUM_FORWARD, 0)
 376 #define DEFVAR_CONST_INT(lname, c_location) \
 377         DEFVAR_SYMVAL_FWD_FIXNUM (lname, c_location, SYMVAL_CONST_FIXNUM_FORWARD, 0)
 378 #define DEFVAR_BOOL(lname, c_location) \
 379         DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_BOOLEAN_FORWARD, 0)
 380 #define DEFVAR_CONST_BOOL(lname, c_location) \
 381         DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_CONST_BOOLEAN_FORWARD, 0)
 382 #define DEFVAR_LISP_MAGIC(lname, c_location, magicfun) \
 383         DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_OBJECT_FORWARD, magicfun)
 384 #define DEFVAR_INT_MAGIC(lname, c_location, magicfun) \
 385         DEFVAR_SYMVAL_FWD_FIXNUM (lname, c_location, SYMVAL_FIXNUM_FORWARD, magicfun)
 386 #define DEFVAR_BOOL_MAGIC(lname, c_location, magicfun) \
 387         DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_BOOLEAN_FORWARD, magicfun)
 388
 389 void flush_all_buffer_local_cache (void);
 390
 391 #endif /* INCLUDED_symeval_h_ */