git.chise.org Git - chise/xemacs-chise.git.1/blob - src/specifier.h

   1 /* Generic specifier list implementation
   2    Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
   3    Copyright (C) 1995 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 #ifndef _XEMACS_SPECIFIER_H_
  25 #define _XEMACS_SPECIFIER_H_
  26
  27 /*
  28   MAGIC SPECIFIERS
  29   ================
  30
  31   Magic specifiers are used to provide fallback values for window
  32   system provided specifications, reflecting user preferences on the
  33   window system, such as default fonts, colors, scrollbar thickness
  34   etc.
  35
  36   A magic specifier consists of two specifier objects. The first one
  37   behaves like a normal specifier in all senses. The second one, a
  38   ghost specifier, is a fallback value for the first one, and contains
  39   values provided by window system, resources etc. which reflect
  40   default settings for values being specified.
  41
  42   A magic specifier has an "ultimate" fallback value, as any usual
  43   specifier does. This value, an inst-list, is stored in the fallback
  44   slot of the ghost specifier object.
  45
  46   Ghost specifiers have the following properties:
  47   - Have back pointers to their parent specifiers.
  48   - Do not have instance data. Instead, they share parent's instance
  49     data.
  50   - Have the same methods structure pointer.
  51   - Share parent's caching scheme.
  52   - Store fallback value instead of their parents.
  53
  54   Ghost specifiers normally are not modifiable at the lisp level, and
  55   only used to supply fallback instance values. They are accessible
  56   via (specifier-fallback), but are read-only.  Although, under
  57   certain rare conditions, modification of ghost objects is allowed.
  58   This behavior is controlled by the global variable
  59   Vunlock_ghost_specifiers. It is not exposed to lisp, and is set
  60   during calls to lisp functions which initialize global, device and
  61   frame defaults, such as
  62   init-{global,frame,device}-{faces,toolbars,etc}.
  63
  64   Thus, values supplied by resources or other means of a window system
  65   stored in externally unmodifiable ghost objects. Regular lisp code
  66   may thus freely modify the normal part of a magic specifier, and
  67   removing a specification for a particular domain causes the
  68   specification to consider ghost-provided fallback values, or its own
  69   fallback value.
  70
  71   Rules of conduct for magic specifiers
  72   -------------------------------------
  73   1. recompute_*() functions always operate on the whole specifier
  74      when passed only a ghost object, by substituting it with their
  75      parent bodily object.
  76   2. All specifier methods, except for instantiate method, are passed
  77      the bodily object of the magic specifier. Instantiate method is
  78      passed the specifier being instantiated.
  79   3. Only bodily objects are passed to set_specifier_caching function,
  80      and only these may be cached.
  81   4. All specifiers are added to Vall_specifiers list, both bodily and
  82      ghost. The pair of objects is always removed from the list at the
  83      same time.
  84 */
  85
  86 extern const struct struct_description specifier_methods_description;
  87
  88 struct specifier_methods
  89 {
  90   CONST char *name;
  91   Lisp_Object predicate_symbol;
  92
  93   /* Implementation specific methods: */
  94
  95   /* Create method: Initialize specifier data. Optional. */
  96   void (*create_method) (Lisp_Object specifier);
  97
  98   /* Mark method: Mark any lisp object within specifier data
  99      structure. Not required if no specifier data are Lisp_Objects. */
 100   void (*mark_method) (Lisp_Object specifier);
 101
 102   /* Equal method: Compare two specifiers. This is called after
 103      ensuring that the two specifiers are of the same type, and have
 104      the same specs.  Quit is inhibited during the call so it is safe
 105      to call internal_equal().
 106
 107      If this function is not present, specifiers considered equal when
 108      the above conditions are met, i.e. as if the method returned
 109      non-zero. */
 110   int (*equal_method) (Lisp_Object sp1, Lisp_Object sp2, int depth);
 111
 112   /* Hash method: Hash specifier instance data. This has to hash only
 113     data structure of the specifier, as specs are hashed by the core
 114     code.
 115
 116      If this function is not present, hashing behaves as if it
 117      returned zero. */
 118   unsigned long (*hash_method) (Lisp_Object specifier, int depth);
 119
 120   /* Validate method: Given an instantiator, verify that it's
 121      valid for this specifier type.  If not, signal an error.
 122
 123      If this function is not present, all instantiators are considered
 124      valid. */
 125   void (*validate_method) (Lisp_Object instantiator);
 126
 127
 128   /* Copy method: Given an instantiator, copy the bits that we need to
 129      for this specifier type.
 130
 131      If this function is not present, then Fcopy_tree is used. */
 132   Lisp_Object (*copy_instantiator_method) (Lisp_Object instantiator);
 133
 134   /* Validate-matchspec method: Given a matchspec, verify that it's
 135      valid for this specifier type.  If not, signal an error.
 136
 137      If this function is not present, *no* matchspecs are considered
 138      valid.  Note that this differs from validate_method(). */
 139   void (*validate_matchspec_method) (Lisp_Object matchspec);
 140
 141   /* Instantiate method: Return SPECIFIER instance in DOMAIN,
 142      specified by INSTANTIATOR.  MATCHSPEC specifies an additional
 143      constraints on the instance value (see the docstring for
 144      Fspecifier_matching_instance function). MATCHSPEC is passed
 145      Qunbound when no matching constraints are imposed. The method is
 146      called via call_with_suspended_errors(), so allowed to eval
 147      safely.
 148
 149      DEPTH is a lisp integer denoting current depth of instantiation
 150      calls. This parameter should be passed as the initial depth value
 151      to functions which also instantiate specifiers (of which I can
 152      name specifier_instance) to avoid creating "external"
 153      specification loops.
 154
 155      This method must presume that both INSTANTIATOR and MATCSPEC are
 156      already validated by the corresponding validate_* methods, and
 157      may abort if they are invalid.
 158
 159      Return value is an instance, which is returned immediately to the
 160      caller, or Qunbound to continue instantiation lookup chain.
 161
 162      If this function is not present, INSTANTIATOR is used as the
 163      specifier instance.  This is the usual case for "simple"
 164      specifiers, like integer and boolean. */
 165   Lisp_Object (*instantiate_method) (Lisp_Object specifier,
 166                                      Lisp_Object matchspec,
 167                                      Lisp_Object domain,
 168                                      Lisp_Object instantiator,
 169                                      Lisp_Object depth);
 170
 171   /* Going-to-add method: Called when an instantiator is about
 172      to be added to a specifier.  This function can specify
 173      that different instantiators should be used instead by
 174      returning an inst-list (possibly containing zero elements).
 175      If the instantiator is fine as-is, return Qt.  The
 176      instantiator has been copied with copy-tree, so feel
 177      free to reuse parts of it to create a new instantiator.
 178      The tag-set, however, is not copied and is not canonicalized
 179      (that will be done on the result of this function). */
 180   Lisp_Object (*going_to_add_method) (Lisp_Object specifier,
 181                                       Lisp_Object locale,
 182                                       Lisp_Object tag_set,
 183                                       Lisp_Object instantiator);
 184
 185   /* After-change method: Called when the SPECIFIER has just been
 186      changed in LOCALE.  The method is called upon:
 187      * Removing and adding specs to/from the specifier;
 188      * Changing the specifier fallback.
 189
 190      #### The method may have called more than once per each specifier
 191      change.
 192
 193      #### Do not still know if this can safely eval. */
 194   void (*after_change_method) (Lisp_Object specifier,
 195                                Lisp_Object locale);
 196
 197   const struct lrecord_description *extra_description;
 198   int extra_data_size;
 199 };
 200
 201 struct Lisp_Specifier
 202 {
 203   struct lcrecord_header header;
 204   struct specifier_methods *methods;
 205
 206   /* we keep a chained list of all current specifiers, for GC cleanup
 207      purposes.  Do NOT mark through this, or specifiers will never
 208      be GC'd. */
 209   Lisp_Object next_specifier;
 210
 211   /* This is a straight list of instantiators. */
 212   Lisp_Object global_specs;
 213
 214   /* These are all assoc lists where the key is the type of object the
 215      list represents (buffer, window, etc.) and the associated list is
 216      the actual list of instantiators. */
 217   Lisp_Object device_specs;
 218   Lisp_Object frame_specs;
 219   /* window_specs is actually a key-assoc weak list.  See specifier.c
 220      for an explanation of why (it boils down to the fact that
 221      dead windows can become live again through window configurations).
 222      */
 223   Lisp_Object window_specs;
 224   Lisp_Object buffer_specs;
 225
 226   struct specifier_caching *caching;
 227
 228   /* This can be either nil, for a plain, non-magic specifier object,
 229      t for the normal part of the magic specifier, or #<specifier> for
 230      the ghost part of the magic specifier, a pointer to its parent
 231      object */
 232   Lisp_Object magic_parent;
 233
 234   /* Fallback value. For magic specifiers, it is a pointer to the ghost. */
 235   Lisp_Object fallback;
 236
 237   /* type-specific extra data attached to a specifier */
 238   char data[1];
 239 };
 240
 241 DECLARE_LRECORD (specifier, struct Lisp_Specifier);
 242 #define XSPECIFIER(x) XRECORD (x, specifier, struct Lisp_Specifier)
 243 #define XSETSPECIFIER(x, p) XSETRECORD (x, p, specifier)
 244 #define SPECIFIERP(x) RECORDP (x, specifier)
 245 #define CHECK_SPECIFIER(x) CHECK_RECORD (x, specifier)
 246 #define CONCHECK_SPECIFIER(x) CONCHECK_RECORD (x, specifier)
 247
 248 /***** Calling a specifier method *****/
 249
 250 #define RAW_SPECMETH(sp, m) ((sp)->methods->m##_method)
 251 #define HAS_SPECMETH_P(sp, m) (!!RAW_SPECMETH (sp, m))
 252 #define SPECMETH(sp, m, args) (((sp)->methods->m##_method) args)
 253
 254 /* Call a void-returning specifier method, if it exists.  */
 255 #define MAYBE_SPECMETH(sp, m, args) do {                \
 256   struct Lisp_Specifier *maybe_specmeth_sp = (sp);      \
 257   if (HAS_SPECMETH_P (maybe_specmeth_sp, m))            \
 258     SPECMETH (maybe_specmeth_sp, m, args);              \
 259 } while (0)
 260
 261 /***** Defining new specifier types *****/
 262
 263 #define specifier_data_offset (offsetof(struct Lisp_Specifier, data))
 264 extern const struct lrecord_description specifier_empty_extra_description[];
 265
 266 #ifdef ERROR_CHECK_TYPECHECK
 267 #define DECLARE_SPECIFIER_TYPE(type)                                    \
 268 extern struct specifier_methods * type##_specifier_methods;             \
 269 INLINE struct type##_specifier *                                        \
 270 error_check_##type##_specifier_data (struct Lisp_Specifier *sp);        \
 271 INLINE struct type##_specifier *                                        \
 272 error_check_##type##_specifier_data (struct Lisp_Specifier *sp)         \
 273 {                                                                       \
 274   if (SPECIFIERP (sp->magic_parent))                                    \
 275     {                                                                   \
 276       assert (SPECIFIER_TYPE_P (sp, type));                             \
 277       sp = XSPECIFIER (sp->magic_parent);                               \
 278     }                                                                   \
 279   else                                                                  \
 280     assert (NILP (sp->magic_parent) || EQ (sp->magic_parent, Qt));      \
 281   assert (SPECIFIER_TYPE_P (sp, type));                                 \
 282   return (struct type##_specifier *) sp->data;                          \
 283 }                                                                       \
 284 DECLARE_NOTHING
 285 #else
 286 #define DECLARE_SPECIFIER_TYPE(type)                            \
 287 extern struct specifier_methods * type##_specifier_methods
 288 #endif /* ERROR_CHECK_TYPECHECK */
 289
 290 #define DEFINE_SPECIFIER_TYPE(type)                     \
 291 struct specifier_methods * type##_specifier_methods
 292
 293 #define INITIALIZE_SPECIFIER_TYPE(type, obj_name, pred_sym) do {        \
 294   type##_specifier_methods = xnew_and_zero (struct specifier_methods);  \
 295   type##_specifier_methods->name = obj_name;                            \
 296   type##_specifier_methods->extra_description =                         \
 297     specifier_empty_extra_description;                                  \
 298   defsymbol_nodump (&type##_specifier_methods->predicate_symbol, pred_sym);     \
 299   add_entry_to_specifier_type_list (Q##type, type##_specifier_methods); \
 300   dumpstruct (&type##_specifier_methods, &specifier_methods_description); \
 301 } while (0)
 302
 303 #define REINITIALIZE_SPECIFIER_TYPE(type) do {  \
 304   staticpro_nodump (&type##_specifier_methods->predicate_symbol);       \
 305 } while (0)
 306
 307 #define INITIALIZE_SPECIFIER_TYPE_WITH_DATA(type, obj_name, pred_sym)   \
 308 do {                                                                    \
 309   INITIALIZE_SPECIFIER_TYPE (type, obj_name, pred_sym);                 \
 310   type##_specifier_methods->extra_data_size =                           \
 311     sizeof (struct type##_specifier);                                   \
 312   type##_specifier_methods->extra_description =                         \
 313     type##_specifier_description;                                       \
 314 } while (0)
 315
 316 /* Declare that specifier-type TYPE has method METH; used in
 317    initialization routines */
 318 #define SPECIFIER_HAS_METHOD(type, meth) \
 319   (type##_specifier_methods->meth##_method = type##_##meth)
 320
 321 /***** Macros for accessing specifier types *****/
 322
 323 #define SPECIFIER_TYPE_P(sp, type) \
 324   ((sp)->methods == type##_specifier_methods)
 325
 326 /* Any of the two of the magic spec */
 327 #define MAGIC_SPECIFIER_P(sp) (!NILP((sp)->magic_parent))
 328 /* Normal part of the magic specifier */
 329 #define BODILY_SPECIFIER_P(sp) EQ ((sp)->magic_parent, Qt)
 330 /* Ghost part of the magic specifier */
 331 #define GHOST_SPECIFIER_P(sp) SPECIFIERP((sp)->magic_parent)
 332
 333 #define GHOST_SPECIFIER(sp) XSPECIFIER ((sp)->fallback)
 334
 335 #ifdef ERROR_CHECK_TYPECHECK
 336 # define SPECIFIER_TYPE_DATA(sp, type) \
 337    error_check_##type##_specifier_data (sp)
 338 #else
 339 # define SPECIFIER_TYPE_DATA(sp, type)          \
 340   ((struct type##_specifier *)                  \
 341     (GHOST_SPECIFIER_P(sp)                      \
 342      ? XSPECIFIER((sp)->magic_parent)->data     \
 343      : (sp)->data))
 344 #endif
 345
 346 /* #### Need to create ERROR_CHECKING versions of these. */
 347
 348 #define XSPECIFIER_TYPE(x, type) XSPECIFIER (x)
 349 #define XSETSPECIFIER_TYPE(x, p, type) XSETSPECIFIER (x, p)
 350 #define SPECIFIER_TYPEP(x, type)                                \
 351   (SPECIFIERP (x) && SPECIFIER_TYPE_P (XSPECIFIER (x), type))
 352 #define CHECK_SPECIFIER_TYPE(x, type) do {              \
 353   CHECK_SPECIFIER (x);                                  \
 354   if (!SPECIFIER_TYPE_P (XSPECIFIER (x), type))         \
 355     dead_wrong_type_argument                            \
 356       (type##_specifier_methods->predicate_symbol, x);  \
 357 } while (0)
 358 #define CONCHECK_SPECIFIER_TYPE(x, type) do {           \
 359   CONCHECK_SPECIFIER (x);                               \
 360   if (!(SPECIFIER_TYPEP (x, type)))                     \
 361     x = wrong_type_argument                             \
 362       (type##_specifier_methods->predicate_symbol, x);  \
 363 } while (0)
 364
 365 /***** Miscellaneous structures *****/
 366
 367 enum spec_locale_type
 368 {
 369   LOCALE_GLOBAL,
 370   LOCALE_DEVICE,
 371   LOCALE_FRAME,
 372   LOCALE_WINDOW,
 373   LOCALE_BUFFER
 374 };
 375
 376 enum spec_add_meth
 377 {
 378   SPEC_PREPEND,
 379   SPEC_APPEND,
 380   SPEC_REMOVE_TAG_SET_PREPEND,
 381   SPEC_REMOVE_TAG_SET_APPEND,
 382   SPEC_REMOVE_LOCALE,
 383   SPEC_REMOVE_LOCALE_TYPE,
 384   SPEC_REMOVE_ALL
 385 };
 386
 387 struct specifier_caching
 388 {
 389   int offset_into_struct_window;
 390   void (*value_changed_in_window) (Lisp_Object specifier, struct window *w,
 391                                    Lisp_Object oldval);
 392   int offset_into_struct_frame;
 393   void (*value_changed_in_frame) (Lisp_Object specifier, struct frame *f,
 394                                   Lisp_Object oldval);
 395 };
 396
 397 EXFUN (Fcopy_specifier, 6);
 398 EXFUN (Fmake_specifier, 1);
 399 EXFUN (Fset_specifier_dirty_flag, 1);
 400 EXFUN (Fspecifier_instance, 4);
 401 EXFUN (Fvalid_specifier_locale_p, 1);
 402
 403 extern Lisp_Object Qfallback, Qnatnum;
 404
 405 Lisp_Object make_magic_specifier (Lisp_Object type);
 406 Lisp_Object decode_locale_list (Lisp_Object locale);
 407 extern enum spec_add_meth
 408 decode_how_to_add_specification (Lisp_Object how_to_add);
 409 Lisp_Object decode_specifier_tag_set (Lisp_Object tag_set);
 410
 411 void add_entry_to_specifier_type_list (Lisp_Object symbol,
 412                                        struct specifier_methods *meths);
 413 void set_specifier_caching (Lisp_Object specifier,
 414                             int struct_window_offset,
 415                             void (*value_changed_in_window)
 416                             (Lisp_Object specifier, struct window *w,
 417                              Lisp_Object oldval),
 418                             int struct_frame_offset,
 419                             void (*value_changed_in_frame)
 420                             (Lisp_Object specifier, struct frame *f,
 421                              Lisp_Object oldval));
 422 void set_specifier_fallback (Lisp_Object specifier,
 423                              Lisp_Object fallback);
 424 void recompute_all_cached_specifiers_in_window (struct window *w);
 425 void recompute_all_cached_specifiers_in_frame (struct frame *f);
 426
 427 /* Counterparts of Fadd_spec_to_specifier and Fremove_specifier, which
 428    operate directly on ghost objects given a magic specifier. */
 429 void add_spec_to_ghost_specifier (Lisp_Object specifier, Lisp_Object instantiator,
 430                                   Lisp_Object locale, Lisp_Object tag_set,
 431                                   Lisp_Object how_to_add);
 432 void remove_ghost_specifier (Lisp_Object specifier, Lisp_Object locale,
 433                              Lisp_Object tag_set, Lisp_Object exact_p);
 434
 435 int unlock_ghost_specifiers_protected (void);
 436
 437 void cleanup_specifiers (void);
 438 void prune_specifiers (void);
 439 void setup_device_initial_specifier_tags (struct device *d);
 440 void kill_specifier_buffer_locals (Lisp_Object buffer);
 441
 442 DECLARE_SPECIFIER_TYPE (generic);
 443 #define XGENERIC_SPECIFIER(x) XSPECIFIER_TYPE (x, generic)
 444 #define XSETGENERIC_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, generic)
 445 #define GENERIC_SPECIFIERP(x) SPECIFIER_TYPEP (x, generic)
 446 #define CHECK_GENERIC_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, generic)
 447 #define CONCHECK_GENERIC_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, generic)
 448
 449 DECLARE_SPECIFIER_TYPE (integer);
 450 #define XINTEGER_SPECIFIER(x) XSPECIFIER_TYPE (x, integer)
 451 #define XSETINTEGER_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, integer)
 452 #define INTEGER_SPECIFIERP(x) SPECIFIER_TYPEP (x, integer)
 453 #define CHECK_INTEGER_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, integer)
 454 #define CONCHECK_INTEGER_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, integer)
 455
 456 DECLARE_SPECIFIER_TYPE (natnum);
 457 #define XNATNUM_SPECIFIER(x) XSPECIFIER_TYPE (x, natnum)
 458 #define XSETNATNUM_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, natnum)
 459 #define NATNUM_SPECIFIERP(x) SPECIFIER_TYPEP (x, natnum)
 460 #define CHECK_NATNUM_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, natnum)
 461 #define CONCHECK_NATNUM_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, natnum)
 462
 463 DECLARE_SPECIFIER_TYPE (boolean);
 464 #define XBOOLEAN_SPECIFIER(x) XSPECIFIER_TYPE (x, boolean)
 465 #define XSETBOOLEAN_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, boolean)
 466 #define BOOLEAN_SPECIFIERP(x) SPECIFIER_TYPEP (x, boolean)
 467 #define CHECK_BOOLEAN_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, boolean)
 468 #define CONCHECK_BOOLEAN_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, boolean)
 469
 470 DECLARE_SPECIFIER_TYPE (display_table);
 471 #define XDISPLAYTABLE_SPECIFIER(x) XSPECIFIER_TYPE (x, display_table)
 472 #define XSETDISPLAYTABLE_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, display_table)
 473 #define DISPLAYTABLE_SPECIFIERP(x) SPECIFIER_TYPEP (x, display_table)
 474 #define CHECK_DISPLAYTABLE_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, display_table)
 475 #define CONCHECK_DISPLAYTABLE_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, display_table)
 476
 477 #endif /* _XEMACS_SPECIFIER_H_ */