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
   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
 103   /* `magicfun' is a function controlling the magic behavior of this
 104       forward variable.
 105
 106      SYM is the symbol being operated on (read, set, etc.);
 107
 108      VAL is either the value to set or the value to be returned.
 109
 110      IN_OBJECT is the buffer or console that the value is read in
 111        or set in.  A value of Qnil means that the current buffer
 112        and possibly other buffers are being set. (This value will
 113        never be passed for built-in buffer-local or console-local
 114        variables such as `truncate-lines'.) (Currently, a value of
 115        Qnil is always passed for DEFVAR_INT, DEFVAR_LISP, and
 116        DEFVAR_BOOL variables; the code isn't smart enough to figure
 117        out what buffers besides the current buffer are being
 118        affected.  Because the magic function is called
 119        before the value is changed, it's not that easy
 120        to determine which buffers are getting changed.
 121        #### If this information is important, let me know
 122        and I will look into providing it.) (Remember also
 123        that the only console-local variables currently existing
 124        are built-in ones, because others can't be created.)
 125
 126      FLAGS gives more information about the operation being performed.
 127
 128      The return value indicates what the magic function actually did.
 129
 130      Currently FLAGS and the return value are not used.  This
 131      function is only called when the value of a forward variable
 132      is about to be changed.  Note that this can occur explicitly
 133      through a call to `set', `setq', `set-default', or `setq-default',
 134      or implicitly by the current buffer being changed.  */
 135   int (*magicfun) (Lisp_Object sym, Lisp_Object *val, Lisp_Object in_object,
 136                    int flags);
 137 };
 138 DECLARE_LRECORD (symbol_value_forward, struct symbol_value_forward);
 139 #define XSYMBOL_VALUE_FORWARD(x) \
 140         XRECORD (x, symbol_value_forward, struct symbol_value_forward)
 141 #define symbol_value_forward_forward(m) ((void *)((m)->magic.lcheader.next))
 142 #define symbol_value_forward_magicfun(m) ((m)->magicfun)
 143
 144 /* 2. symbol-value-buffer-local */
 145
 146 struct symbol_value_buffer_local
 147 {
 148   struct symbol_value_magic magic;
 149   /* Used in a symbol value cell when the symbol's value is per-buffer.
 150
 151      The type of the symbol-value-magic will be either
 152      SYMVAL_BUFFER_LOCAL (i.e. `make-variable-buffer-local' was called)
 153      or SYMVAL_SOME_BUFFER_LOCAL (i.e. `make-local-variable' was called).
 154      The only difference between the two is that when setting the
 155      former kind of variable, an implicit `make-local-variable' is
 156      called.
 157
 158      A buffer-local variable logically has
 159
 160      -- a default value
 161      -- local values in some buffers
 162
 163      The primary place where the local values are stored is in each
 164      buffer's local_var_alist slot.
 165
 166      In the simplest implementation, all that this structure needs to
 167      keep track of is the default value; to retrieve the value in
 168      a buffer, look in that buffer's local_var_alist, and use the
 169      default value if there is no local value.  To implement
 170      `make-local-variable' in a buffer, look in the buffer's
 171      local_var_alist, and if no element exists for this symbol,
 172      add one, copying the value from the default value.  When setting
 173      the value in a buffer, look in the buffer's local_var_alist, and set
 174      the value in that list if an element exists for this symbol;
 175      otherwise, set the default. (Remember that SYMVAL_BUFFER_LOCAL
 176      variables implicitly call `make-local-variable' first, so when
 177      setting a value, there will always be an entry in the buffer's
 178      local_var_alist to set.)
 179
 180      However, this operation is potentially slow.  To speed it up,
 181      we cache the value in one buffer in this structure.
 182
 183      NOTE: This is *not* a write-through cache.  I.e. when setting
 184      the value in the buffer that is cached, we *only* change the
 185      cache and don't write the value through to either the buffer's
 186      local_var_alist or the default value.  Therefore, when retrieving
 187      a value in a buffer, you must *always* look in the cache to see if
 188      it refers to that buffer.
 189
 190      The cache consists of
 191
 192      -- a buffer, or nil if the cache has not been set up
 193      -- the value in that buffer
 194      -- the element (a cons) from the buffer's local_var_alist, or
 195         nil if there is no local value in the buffer
 196
 197     These slots are called CURRENT-BUFFER, CURRENT-VALUE, and
 198     CURRENT-ALIST-ELEMENT, respectively.
 199
 200     If we want to examine or set the value in BUFFER and CURRENT-BUFFER
 201     equals BUFFER, we just examine or set CURRENT-VALUE.  Otherwise,
 202     we store CURRENT-VALUE value into CURRENT-ALIST-ELEMENT (or maybe
 203     into DEFAULT-VALUE), then find the appropriate alist element for
 204     BUFFER and set up CURRENT-ALIST-ELEMENT.  Then we set CURRENT-VALUE
 205     out of that element (or maybe out of DEFAULT-VALUE), and store
 206     BUFFER into CURRENT-BUFFER.
 207
 208     If we are setting the variable and the current buffer does not have
 209     an alist entry for this variable, an alist entry is created.
 210
 211     Note that CURRENT-BUFFER's local_var_alist value for this variable
 212     might be out-of-date (the correct value is stored in CURRENT-VALUE).
 213     Similarly, if CURRENT-BUFFER sees the default value, then
 214     DEFAULT-VALUE might be out-of-date.
 215
 216     Note that CURRENT-VALUE (but not DEFAULT-VALUE) can be a
 217     forwarding pointer.  Each time it is examined or set,
 218     forwarding must be done.
 219    */
 220   Lisp_Object default_value;
 221   Lisp_Object current_value;
 222   Lisp_Object current_buffer;
 223   Lisp_Object current_alist_element;
 224 };
 225 DECLARE_LRECORD (symbol_value_buffer_local, struct symbol_value_buffer_local);
 226 #define XSYMBOL_VALUE_BUFFER_LOCAL(x) \
 227         XRECORD (x, symbol_value_buffer_local, struct symbol_value_buffer_local)
 228 #define SYMBOL_VALUE_BUFFER_LOCAL_P(x) RECORDP (x, symbol_value_buffer_local)
 229
 230 /* 3. symbol-value-lisp-magic */
 231
 232 enum lisp_magic_handler
 233 {
 234   MAGIC_HANDLER_GET_VALUE,
 235   MAGIC_HANDLER_SET_VALUE,
 236   MAGIC_HANDLER_BOUND_PREDICATE,
 237   MAGIC_HANDLER_MAKE_UNBOUND,
 238   MAGIC_HANDLER_LOCAL_PREDICATE,
 239   MAGIC_HANDLER_MAKE_LOCAL,
 240   MAGIC_HANDLER_MAX
 241 };
 242
 243 struct symbol_value_lisp_magic
 244 {
 245   struct symbol_value_magic magic;
 246   Lisp_Object handler[MAGIC_HANDLER_MAX];
 247   Lisp_Object harg[MAGIC_HANDLER_MAX];
 248   Lisp_Object shadowed;
 249 };
 250 DECLARE_LRECORD (symbol_value_lisp_magic, struct symbol_value_lisp_magic);
 251 #define XSYMBOL_VALUE_LISP_MAGIC(x) \
 252         XRECORD (x, symbol_value_lisp_magic, struct symbol_value_lisp_magic)
 253 #define SYMBOL_VALUE_LISP_MAGIC_P(x) RECORDP (x, symbol_value_lisp_magic)
 254
 255 /* 4. symbol-value-varalias */
 256
 257 struct symbol_value_varalias
 258 {
 259   struct symbol_value_magic magic;
 260   Lisp_Object aliasee;
 261   Lisp_Object shadowed;
 262 };
 263 DECLARE_LRECORD (symbol_value_varalias, struct symbol_value_varalias);
 264 #define XSYMBOL_VALUE_VARALIAS(x) \
 265         XRECORD (x, symbol_value_varalias, struct symbol_value_varalias)
 266 #define SYMBOL_VALUE_VARALIAS_P(x) RECORDP (x, symbol_value_varalias)
 267 #define symbol_value_varalias_aliasee(m) ((m)->aliasee)
 268 #define symbol_value_varalias_shadowed(m) ((m)->shadowed)
 269
 270 /* To define a Lisp primitive function using a C function `Fname', do this:
 271    DEFUN ("name, Fname, ...); // at top level in foo.c
 272    DEFSUBR (Fname);           // in syms_of_foo();
 273 */
 274 void defsubr (Lisp_Subr *);
 275 #define DEFSUBR(Fname) defsubr (&S##Fname)
 276
 277 /* To define a Lisp primitive macro using a C function `Fname', do this:
 278    DEFUN ("name, Fname, ...); // at top level in foo.c
 279    DEFSUBR_MACRO (Fname);     // in syms_of_foo();
 280 */
 281 void defsubr_macro (Lisp_Subr *);
 282 #define DEFSUBR_MACRO(Fname) defsubr_macro (&S##Fname)
 283
 284 void defsymbol (Lisp_Object *location, CONST char *name);
 285
 286 void defkeyword (Lisp_Object *location, CONST char *name);
 287
 288 void deferror (Lisp_Object *symbol, CONST char *name,
 289                CONST char *message, Lisp_Object inherits_from);
 290
 291 /* Macros we use to define forwarded Lisp variables.
 292    These are used in the syms_of_FILENAME functions.  */
 293
 294 void defvar_magic (CONST char *symbol_name, CONST struct symbol_value_forward *magic);
 295
 296 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
 297 # define symbol_value_forward_lheader_initializer { 1, 0, 0 }
 298 #else
 299 # define symbol_value_forward_lheader_initializer \
 300    { lrecord_symbol_value_forward }
 301 #endif
 302
 303 #define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magicfun) do {       \
 304   static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C                \
 305    = { { { symbol_value_forward_lheader_initializer,                            \
 306            (struct lcrecord_header *) (c_location), 69 },                       \
 307          forward_type }, magicfun };                                            \
 308   defvar_magic ((lname), &I_hate_C);                                            \
 309 } while (0)
 310
 311 #define DEFVAR_SYMVAL_FWD_OBJECT(lname, c_location, forward_type, magicfun) do{ \
 312   DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun);                \
 313   staticpro (c_location);                                                       \
 314   if (EQ (*c_location, Qnull_pointer)) *c_location = Qnil;                      \
 315 } while (0)
 316
 317 #define DEFVAR_LISP(lname, c_location) \
 318         DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_OBJECT_FORWARD, 0)
 319 #define DEFVAR_CONST_LISP(lname, c_location) \
 320         DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_CONST_OBJECT_FORWARD, 0)
 321 #define DEFVAR_SPECIFIER(lname, c_location) \
 322         DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_CONST_SPECIFIER_FORWARD, 0)
 323 #define DEFVAR_INT(lname, c_location) \
 324         DEFVAR_SYMVAL_FWD (lname, c_location, SYMVAL_FIXNUM_FORWARD, 0)
 325 #define DEFVAR_CONST_INT(lname, c_location) \
 326         DEFVAR_SYMVAL_FWD (lname, c_location, SYMVAL_CONST_FIXNUM_FORWARD, 0)
 327 #define DEFVAR_BOOL(lname, c_location) \
 328         DEFVAR_SYMVAL_FWD (lname, c_location, SYMVAL_BOOLEAN_FORWARD, 0)
 329 #define DEFVAR_CONST_BOOL(lname, c_location) \
 330         DEFVAR_SYMVAL_FWD (lname, c_location, SYMVAL_CONST_BOOLEAN_FORWARD, 0)
 331 #define DEFVAR_LISP_MAGIC(lname, c_location, magicfun) \
 332         DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_OBJECT_FORWARD, magicfun);
 333 #define DEFVAR_INT_MAGIC(lname, c_location, magicfun) \
 334         DEFVAR_SYMVAL_FWD (lname, c_location, SYMVAL_FIXNUM_FORWARD, magicfun);
 335 #define DEFVAR_BOOL_MAGIC(lname, c_location, magicfun) \
 336         DEFVAR_SYMVAL_FWD (lname, c_location, SYMVAL_BOOLEAN_FORWARD, magicfun);
 337
 338 #endif /* _XEMACS_SYMEVAL_H_ */