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