git.chise.org Git - chise/xemacs-chise.git.1/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 "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 struct symbol_value_magic
  74 {
  75   struct lcrecord_header lcheader;
  76   void *value;
  77   enum symbol_value_type type;
  78 };
  79 #define SYMBOL_VALUE_MAGIC_P(x)                                         \
  80 (LRECORDP (x) &&                                                        \
  81  XRECORD_LHEADER (x)->type <= lrecord_type_max_symbol_value_magic)
  82 #define XSYMBOL_VALUE_MAGIC_TYPE(v) \
  83         (((struct symbol_value_magic *) XPNTR (v))->type)
  84 #define XSETSYMBOL_VALUE_MAGIC(s, p) XSETOBJ (s, p)
  85 void print_symbol_value_magic (Lisp_Object, Lisp_Object, int);
  86
  87 /********** The various different symbol-value-magic types ***********/
  88
  89 /* 1. symbol-value-forward */
  90
  91 /* This type of symbol-value-magic is used for variables declared
  92    DEFVAR_LISP, DEFVAR_INT, DEFVAR_BOOL, DEFVAR_BUFFER_LOCAL,
  93    DEFVAR_BUFFER_DEFAULTS, DEFVAR_SPECIFIER, and for Qunbound.
  94
  95    Note that some of these types of variables can be made buffer-local.
  96    Then, the symbol's value field contains a symbol-value-buffer-local,
  97    whose CURRENT-VALUE field then contains a symbol-value-forward.
  98  */
  99
 100 struct symbol_value_forward
 101 {
 102   struct symbol_value_magic magic;
 103
 104   /* `magicfun' is a function controlling the magic behavior of this
 105       forward variable.
 106
 107      SYM is the symbol being operated on (read, set, etc.);
 108
 109      VAL is either the value to set or the value to be returned.
 110
 111      IN_OBJECT is the buffer or console that the value is read in
 112        or set in.  A value of Qnil means that the current buffer
 113        and possibly other buffers are being set. (This value will
 114        never be passed for built-in buffer-local or console-local
 115        variables such as `truncate-lines'.) (Currently, a value of
 116        Qnil is always passed for DEFVAR_INT, DEFVAR_LISP, and
 117        DEFVAR_BOOL variables; the code isn't smart enough to figure
 118        out what buffers besides the current buffer are being
 119        affected.  Because the magic function is called
 120        before the value is changed, it's not that easy
 121        to determine which buffers are getting changed.
 122        #### If this information is important, let me know
 123        and I will look into providing it.) (Remember also
 124        that the only console-local variables currently existing
 125        are built-in ones, because others can't be created.)
 126
 127      FLAGS gives more information about the operation being performed.
 128
 129      The return value indicates what the magic function actually 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   int (*magicfun) (Lisp_Object sym, Lisp_Object *val, Lisp_Object in_object,
 137                    int flags);
 138 };
 139 DECLARE_LRECORD (symbol_value_forward, struct symbol_value_forward);
 140 #define XSYMBOL_VALUE_FORWARD(x) \
 141         XRECORD (x, symbol_value_forward, struct symbol_value_forward)
 142 #define symbol_value_forward_forward(m) ((void *)((m)->magic.value))
 143 #define symbol_value_forward_magicfun(m) ((m)->magicfun)
 144
 145 /* 2. symbol-value-buffer-local */
 146
 147 struct symbol_value_buffer_local
 148 {
 149   struct symbol_value_magic magic;
 150   /* Used in a symbol value cell when the symbol's value is per-buffer.
 151
 152      The type of the symbol-value-magic will be either
 153      SYMVAL_BUFFER_LOCAL (i.e. `make-variable-buffer-local' was called)
 154      or SYMVAL_SOME_BUFFER_LOCAL (i.e. `make-local-variable' was called).
 155      The only difference between the two is that when setting the
 156      former kind of variable, an implicit `make-local-variable' is
 157      called.
 158
 159      A buffer-local variable logically has
 160
 161      -- a default value
 162      -- local values in some buffers
 163
 164      The primary place where the local values are stored is in each
 165      buffer's local_var_alist slot.
 166
 167      In the simplest implementation, all that this structure needs to
 168      keep track of is the default value; to retrieve the value in
 169      a buffer, look in that buffer's local_var_alist, and use the
 170      default value if there is no local value.  To implement
 171      `make-local-variable' in a buffer, look in the buffer's
 172      local_var_alist, and if no element exists for this symbol,
 173      add one, copying the value from the default value.  When setting
 174      the value in a buffer, look in the buffer's local_var_alist, and set
 175      the value in that list if an element exists for this symbol;
 176      otherwise, set the default. (Remember that SYMVAL_BUFFER_LOCAL
 177      variables implicitly call `make-local-variable' first, so when
 178      setting a value, there will always be an entry in the buffer's
 179      local_var_alist to set.)
 180
 181      However, this operation is potentially slow.  To speed it up,
 182      we cache the value in one buffer in this structure.
 183
 184      NOTE: This is *not* a write-through cache.  I.e. when setting
 185      the value in the buffer that is cached, we *only* change the
 186      cache and don't write the value through to either the buffer's
 187      local_var_alist or the default value.  Therefore, when retrieving
 188      a value in a buffer, you must *always* look in the cache to see if
 189      it refers to that buffer.
 190
 191      The cache consists of
 192
 193      -- a buffer, or nil if the cache has not been set up
 194      -- the value in that buffer
 195      -- the element (a cons) from the buffer's local_var_alist, or
 196         nil if there is no local value in the buffer
 197
 198     These slots are called CURRENT-BUFFER, CURRENT-VALUE, and
 199     CURRENT-ALIST-ELEMENT, respectively.
 200
 201     If we want to examine or set the value in BUFFER and CURRENT-BUFFER
 202     equals BUFFER, we just examine or set CURRENT-VALUE.  Otherwise,
 203     we store CURRENT-VALUE value into CURRENT-ALIST-ELEMENT (or maybe
 204     into DEFAULT-VALUE), then find the appropriate alist element for
 205     BUFFER and set up CURRENT-ALIST-ELEMENT.  Then we set CURRENT-VALUE
 206     out of that element (or maybe out of DEFAULT-VALUE), and store
 207     BUFFER into CURRENT-BUFFER.
 208
 209     If we are setting the variable and the current buffer does not have
 210     an alist entry for this variable, an alist entry is created.
 211
 212     Note that CURRENT-BUFFER's local_var_alist value for this variable
 213     might be out-of-date (the correct value is stored in CURRENT-VALUE).
 214     Similarly, if CURRENT-BUFFER sees the default value, then
 215     DEFAULT-VALUE might be out-of-date.
 216
 217     Note that CURRENT-VALUE (but not DEFAULT-VALUE) can be a
 218     forwarding pointer.  Each time it is examined or set,
 219     forwarding must be done.
 220    */
 221   Lisp_Object default_value;
 222   Lisp_Object current_value;
 223   Lisp_Object current_buffer;
 224   Lisp_Object current_alist_element;
 225 };
 226 DECLARE_LRECORD (symbol_value_buffer_local, struct symbol_value_buffer_local);
 227 #define XSYMBOL_VALUE_BUFFER_LOCAL(x) \
 228         XRECORD (x, symbol_value_buffer_local, struct symbol_value_buffer_local)
 229 #define SYMBOL_VALUE_BUFFER_LOCAL_P(x) RECORDP (x, symbol_value_buffer_local)
 230
 231 /* 3. symbol-value-lisp-magic */
 232
 233 enum lisp_magic_handler
 234 {
 235   MAGIC_HANDLER_GET_VALUE,
 236   MAGIC_HANDLER_SET_VALUE,
 237   MAGIC_HANDLER_BOUND_PREDICATE,
 238   MAGIC_HANDLER_MAKE_UNBOUND,
 239   MAGIC_HANDLER_LOCAL_PREDICATE,
 240   MAGIC_HANDLER_MAKE_LOCAL,
 241   MAGIC_HANDLER_MAX
 242 };
 243
 244 struct symbol_value_lisp_magic
 245 {
 246   struct symbol_value_magic magic;
 247   Lisp_Object handler[MAGIC_HANDLER_MAX];
 248   Lisp_Object harg[MAGIC_HANDLER_MAX];
 249   Lisp_Object shadowed;
 250 };
 251 DECLARE_LRECORD (symbol_value_lisp_magic, struct symbol_value_lisp_magic);
 252 #define XSYMBOL_VALUE_LISP_MAGIC(x) \
 253         XRECORD (x, symbol_value_lisp_magic, struct symbol_value_lisp_magic)
 254 #define SYMBOL_VALUE_LISP_MAGIC_P(x) RECORDP (x, symbol_value_lisp_magic)
 255
 256 /* 4. symbol-value-varalias */
 257
 258 struct symbol_value_varalias
 259 {
 260   struct symbol_value_magic magic;
 261   Lisp_Object aliasee;
 262   Lisp_Object shadowed;
 263 };
 264 DECLARE_LRECORD (symbol_value_varalias, struct symbol_value_varalias);
 265 #define XSYMBOL_VALUE_VARALIAS(x) \
 266         XRECORD (x, symbol_value_varalias, struct symbol_value_varalias)
 267 #define SYMBOL_VALUE_VARALIAS_P(x) RECORDP (x, symbol_value_varalias)
 268 #define symbol_value_varalias_aliasee(m) ((m)->aliasee)
 269 #define symbol_value_varalias_shadowed(m) ((m)->shadowed)
 270
 271 /* To define a Lisp primitive function using a C function `Fname', do this:
 272    DEFUN ("name, Fname, ...); // at top level in foo.c
 273    DEFSUBR (Fname);           // in syms_of_foo();
 274 */
 275 void defsubr (Lisp_Subr *);
 276 #define DEFSUBR(Fname) defsubr (&S##Fname)
 277
 278 /* To define a Lisp primitive macro using a C function `Fname', do this:
 279    DEFUN ("name, Fname, ...); // at top level in foo.c
 280    DEFSUBR_MACRO (Fname);     // in syms_of_foo();
 281 */
 282 void defsubr_macro (Lisp_Subr *);
 283 #define DEFSUBR_MACRO(Fname) defsubr_macro (&S##Fname)
 284
 285 void defsymbol_massage_name (Lisp_Object *location, const char *name);
 286 void defsymbol_massage_name_nodump (Lisp_Object *location, const char *name);
 287 void defsymbol_massage_multiword_predicate (Lisp_Object *location,
 288                                             const char *name);
 289 void defsymbol_massage_multiword_predicate_nodump (Lisp_Object *location,
 290                                                    const char *name);
 291 void defsymbol (Lisp_Object *location, const char *name);
 292 void defsymbol_nodump (Lisp_Object *location, const char *name);
 293
 294 #define DEFSYMBOL(name) defsymbol_massage_name (&name, #name)
 295 #define DEFSYMBOL_NO_DUMP(name) defsymbol_massage_name_nodump (&name, #name)
 296 #define DEFSYMBOL_MULTIWORD_PREDICATE(name) \
 297   defsymbol_massage_multiword_predicate (&name, #name)
 298 #define DEFSYMBOL_MULTIWORD_PREDICATE_NO_DUMP(name) \
 299   defsymbol_massage_multiword_predicate_nodump (&name, #name)
 300
 301 void defkeyword (Lisp_Object *location, const char *name);
 302 void defkeyword_massage_name (Lisp_Object *location, const char *name);
 303 #define DEFKEYWORD(name) defkeyword_massage_name (&name, #name)
 304
 305 void deferror (Lisp_Object *symbol, const char *name,
 306                const char *message, Lisp_Object inherits_from);
 307 void deferror_massage_name (Lisp_Object *symbol, const char *name,
 308                             const char *message, Lisp_Object inherits_from);
 309 void deferror_massage_name_and_message (Lisp_Object *symbol, const char *name,
 310                                         Lisp_Object inherits_from);
 311 #define DEFERROR(name, message, inherits_from) \
 312   deferror_massage_name (&name, #name, message, inherits_from)
 313 /* In this case, the error message is the same as the name, modulo some
 314    prettifying */
 315 #define DEFERROR_STANDARD(name, inherits_from) \
 316   deferror_massage_name_and_message (&name, #name, inherits_from)
 317
 318 /* Macros we use to define forwarded Lisp variables.
 319    These are used in the syms_of_FILENAME functions.  */
 320
 321 void defvar_magic (const char *symbol_name, const struct symbol_value_forward *magic);
 322
 323 #define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magicfun) do {       \
 324   static const struct symbol_value_forward I_hate_C =                           \
 325   { /* struct symbol_value_forward */                                           \
 326     { /* struct symbol_value_magic */                                           \
 327       { /* struct lcrecord_header */                                            \
 328         { /* struct lrecord_header */                                           \
 329           lrecord_type_symbol_value_forward, /* lrecord_type_index */           \
 330           1, /* mark bit */                                                     \
 331           1, /* c_readonly bit */                                               \
 332           1  /* lisp_readonly bit */                                            \
 333         },                                                                      \
 334         0, /* next */                                                           \
 335         0, /* uid  */                                                           \
 336         0  /* free */                                                           \
 337       },                                                                        \
 338       c_location,                                                               \
 339       forward_type                                                              \
 340     },                                                                          \
 341     magicfun                                                                    \
 342   };                                                                            \
 343   defvar_magic ((lname), &I_hate_C);                                            \
 344 } while (0)
 345
 346 #define DEFVAR_SYMVAL_FWD_INT(lname, c_location, forward_type, magicfun) do{    \
 347   DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun);                \
 348   dumpopaque (c_location, sizeof(int));                                         \
 349 } while (0)
 350
 351 #define DEFVAR_SYMVAL_FWD_OBJECT(lname, c_location, forward_type, magicfun) do{ \
 352   DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun);                \
 353   staticpro (c_location);                                                       \
 354   if (EQ (*c_location, Qnull_pointer)) *c_location = Qnil;                      \
 355 } while (0)
 356
 357 #define DEFVAR_LISP(lname, c_location) \
 358         DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_OBJECT_FORWARD, 0)
 359 #define DEFVAR_CONST_LISP(lname, c_location) \
 360         DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_CONST_OBJECT_FORWARD, 0)
 361 #define DEFVAR_SPECIFIER(lname, c_location) \
 362         DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_CONST_SPECIFIER_FORWARD, 0)
 363 #define DEFVAR_INT(lname, c_location) \
 364         DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_FIXNUM_FORWARD, 0)
 365 #define DEFVAR_CONST_INT(lname, c_location) \
 366         DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_CONST_FIXNUM_FORWARD, 0)
 367 #define DEFVAR_BOOL(lname, c_location) \
 368         DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_BOOLEAN_FORWARD, 0)
 369 #define DEFVAR_CONST_BOOL(lname, c_location) \
 370         DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_CONST_BOOLEAN_FORWARD, 0)
 371 #define DEFVAR_LISP_MAGIC(lname, c_location, magicfun) \
 372         DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_OBJECT_FORWARD, magicfun)
 373 #define DEFVAR_INT_MAGIC(lname, c_location, magicfun) \
 374         DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_FIXNUM_FORWARD, magicfun)
 375 #define DEFVAR_BOOL_MAGIC(lname, c_location, magicfun) \
 376         DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_BOOLEAN_FORWARD, magicfun)
 377
 378 void flush_all_buffer_local_cache (void);
 379
 380 #endif /* INCLUDED_symeval_h_ */