1 /* Generic specifier list implementation
2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
3 Copyright (C) 1995 Ben Wing
5 This file is part of SXEmacs
7 SXEmacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 SXEmacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
21 /* Synched up with: Not in FSF. */
23 #ifndef INCLUDED_specifier_h_
24 #define INCLUDED_specifier_h_
30 Magic specifiers are used to provide fallback values for window
31 system provided specifications, reflecting user preferences on the
32 window system, such as default fonts, colors, scrollbar thickness
35 A magic specifier consists of two specifier objects. The first one
36 behaves like a normal specifier in all senses. The second one, a
37 ghost specifier, is a fallback value for the first one, and contains
38 values provided by window system, resources etc. which reflect
39 default settings for values being specified.
41 A magic specifier has an "ultimate" fallback value, as any usual
42 specifier does. This value, an inst-list, is stored in the fallback
43 slot of the ghost specifier object.
45 Ghost specifiers have the following properties:
46 - Have back pointers to their parent specifiers.
47 - Do not have instance data. Instead, they share parent's instance
49 - Have the same methods structure pointer.
50 - Share parent's caching scheme.
51 - Store fallback value instead of their parents.
53 Ghost specifiers normally are not modifiable at the lisp level, and
54 only used to supply fallback instance values. They are accessible
55 via (specifier-fallback), but are read-only. Although, under
56 certain rare conditions, modification of ghost objects is allowed.
57 This behavior is controlled by the global variable
58 Vunlock_ghost_specifiers. It is not exposed to lisp, and is set
59 during calls to lisp functions which initialize global, device and
60 frame defaults, such as
61 init-{global,frame,device}-{faces,toolbars,etc}.
63 Thus, values supplied by resources or other means of a window system
64 stored in externally unmodifiable ghost objects. Regular lisp code
65 may thus freely modify the normal part of a magic specifier, and
66 removing a specification for a particular domain causes the
67 specification to consider ghost-provided fallback values, or its own
70 Rules of conduct for magic specifiers
71 -------------------------------------
72 1. recompute_*() functions always operate on the whole specifier
73 when passed only a ghost object, by substituting it with their
75 2. All specifier methods, except for instantiate method, are passed
76 the bodily object of the magic specifier. Instantiate method is
77 passed the specifier being instantiated.
78 3. Only bodily objects are passed to set_specifier_caching function,
79 and only these may be cached.
80 4. All specifiers are added to Vall_specifiers list, both bodily and
81 ghost. The pair of objects is always removed from the list at the
85 extern const struct struct_description specifier_methods_description;
87 struct specifier_methods {
89 Lisp_Object predicate_symbol;
91 /* Implementation specific methods: */
93 /* Create method: Initialize specifier data. Optional. */
94 void (*create_method) (Lisp_Object specifier);
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);
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().
105 If this function is not present, specifiers considered equal when
106 the above conditions are met, i.e. as if the method returned
108 int (*equal_method) (Lisp_Object sp1, Lisp_Object sp2, int depth);
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
114 If this function is not present, hashing behaves as if it
116 unsigned long (*hash_method) (Lisp_Object specifier, int depth);
118 /* Validate method: Given an instantiator, verify that it's
119 valid for this specifier type. If not, signal an error.
121 If this function is not present, all instantiators are considered
123 void (*validate_method) (Lisp_Object instantiator);
125 /* Copy method: Given an instantiator, copy the bits that we need to
126 for this specifier type.
128 If this function is not present, then Fcopy_tree is used. */
129 Lisp_Object(*copy_instantiator_method) (Lisp_Object instantiator);
131 /* Validate-matchspec method: Given a matchspec, verify that it's
132 valid for this specifier type. If not, signal an error.
134 If this function is not present, *no* matchspecs are considered
135 valid. Note that this differs from validate_method(). */
136 void (*validate_matchspec_method) (Lisp_Object matchspec);
138 /* Instantiate method: Return SPECIFIER instance in DOMAIN,
139 specified by INSTANTIATOR. MATCHSPEC specifies an additional
140 constraints on the instance value (see the docstring for
141 Fspecifier_matching_instance function). MATCHSPEC is passed
142 Qunbound when no matching constraints are imposed. The method is
143 called via call_with_suspended_errors(), so allowed to eval
146 DEPTH is a lisp integer denoting current depth of instantiation
147 calls. This parameter should be passed as the initial depth value
148 to functions which also instantiate specifiers (of which I can
149 name specifier_instance) to avoid creating "external"
152 This method must presume that both INSTANTIATOR and MATCHSPEC are
153 already validated by the corresponding validate_* methods, and
154 may abort if they are invalid.
156 Return value is an instance, which is returned immediately to the
157 caller, or Qunbound to continue instantiation lookup chain.
159 If this function is not present, INSTANTIATOR is used as the
160 specifier instance. This is the usual case for "simple"
161 specifiers, like integer and boolean. */
162 Lisp_Object(*instantiate_method) (Lisp_Object specifier,
163 Lisp_Object matchspec,
165 Lisp_Object instantiator,
168 /* Going-to-add method: Called when an instantiator is about
169 to be added to a specifier. This function can specify
170 that different instantiators should be used instead by
171 returning an inst-list (possibly containing zero elements).
172 If the instantiator is fine as-is, return Qt. The
173 instantiator has been copied with copy-tree, so feel
174 free to reuse parts of it to create a new instantiator.
175 The tag-set, however, is not copied and is not canonicalized
176 (that will be done on the result of this function). */
177 Lisp_Object(*going_to_add_method) (Lisp_Object specifier,
180 Lisp_Object instantiator);
182 /* After-change method: Called when the SPECIFIER has just been
183 changed in LOCALE. The method is called upon:
184 * Removing and adding specs to/from the specifier;
185 * Changing the specifier fallback.
187 #### The method may have called more than once per each specifier
190 #### Do not still know if this can safely eval. */
191 void (*after_change_method) (Lisp_Object specifier, Lisp_Object locale);
193 const struct lrecord_description *extra_description;
197 struct Lisp_Specifier {
198 struct lcrecord_header header;
199 struct specifier_methods *methods;
201 /* we keep a chained list of all current specifiers, for GC cleanup
202 purposes. Do NOT mark through this, or specifiers will never
204 Lisp_Object next_specifier;
206 /* This is a straight list of instantiators. */
207 Lisp_Object global_specs;
209 /* These are all assoc lists where the key is the type of object the
210 list represents (buffer, window, etc.) and the associated list is
211 the actual list of instantiators. */
212 Lisp_Object device_specs;
213 Lisp_Object frame_specs;
214 /* window_specs is actually a key-assoc weak list. See specifier.c
215 for an explanation of why (it boils down to the fact that
216 dead windows can become live again through window configurations).
218 Lisp_Object window_specs;
219 Lisp_Object buffer_specs;
221 struct specifier_caching *caching;
223 /* This can be either nil, for a plain, non-magic specifier object,
224 t for the normal part of the magic specifier, or #<specifier> for
225 the ghost part of the magic specifier, a pointer to its parent
227 Lisp_Object magic_parent;
229 /* Fallback value. For magic specifiers, it is a pointer to the ghost. */
230 Lisp_Object fallback;
232 /* type-specific extra data attached to a specifier */
235 typedef struct Lisp_Specifier Lisp_Specifier;
237 DECLARE_LRECORD(specifier, Lisp_Specifier);
238 #define XSPECIFIER(x) XRECORD (x, specifier, Lisp_Specifier)
239 #define XSETSPECIFIER(x, p) XSETRECORD (x, p, specifier)
240 #define SPECIFIERP(x) RECORDP (x, specifier)
241 #define CHECK_SPECIFIER(x) CHECK_RECORD (x, specifier)
242 #define CONCHECK_SPECIFIER(x) CONCHECK_RECORD (x, specifier)
244 /***** Calling a specifier method *****/
246 #define RAW_SPECMETH(sp, m) ((sp)->methods->m##_method)
247 #define HAS_SPECMETH_P(sp, m) (!!RAW_SPECMETH (sp, m))
248 #define SPECMETH(sp, m, args) (((sp)->methods->m##_method) args)
250 /* Call a void-returning specifier method, if it exists. */
251 #define MAYBE_SPECMETH(sp, m, args) do { \
252 Lisp_Specifier *maybe_specmeth_sp = (sp); \
253 if (HAS_SPECMETH_P (maybe_specmeth_sp, m)) \
254 SPECMETH (maybe_specmeth_sp, m, args); \
257 /***** Defining new specifier types *****/
259 #define specifier_data_offset offsetof (Lisp_Specifier, data)
260 extern const struct lrecord_description specifier_empty_extra_description[];
262 #ifdef ERROR_CHECK_TYPECHECK
263 #define DECLARE_SPECIFIER_TYPE(type) \
264 extern struct specifier_methods * type##_specifier_methods; \
265 extern_inline struct type##_specifier * \
266 error_check_##type##_specifier_data (Lisp_Specifier *sp); \
267 extern_inline struct type##_specifier * \
268 error_check_##type##_specifier_data (Lisp_Specifier *sp) \
270 if (SPECIFIERP (sp->magic_parent)) \
272 assert (SPECIFIER_TYPE_P (sp, type)); \
273 sp = XSPECIFIER (sp->magic_parent); \
276 assert (NILP (sp->magic_parent) || EQ (sp->magic_parent, Qt)); \
277 assert (SPECIFIER_TYPE_P (sp, type)); \
278 return (struct type##_specifier *) sp->data; \
280 extern_inline Lisp_Specifier * \
281 error_check_##type##_specifier_type (Lisp_Object obj); \
282 extern_inline Lisp_Specifier * \
283 error_check_##type##_specifier_type (Lisp_Object obj) \
285 Lisp_Specifier *sp = XSPECIFIER (obj); \
286 assert (SPECIFIER_TYPE_P (sp, type)); \
291 #define DECLARE_SPECIFIER_TYPE(type) \
292 extern struct specifier_methods * type##_specifier_methods
293 #endif /* ERROR_CHECK_TYPECHECK */
295 #define DEFINE_SPECIFIER_TYPE(type) \
296 struct specifier_methods * type##_specifier_methods
298 #define INITIALIZE_SPECIFIER_TYPE(type, obj_name, pred_sym) do { \
299 type##_specifier_methods = xnew_and_zero (struct specifier_methods); \
300 type##_specifier_methods->name = obj_name; \
301 type##_specifier_methods->extra_description = \
302 specifier_empty_extra_description; \
303 defsymbol_nodump (&type##_specifier_methods->predicate_symbol, pred_sym); \
304 add_entry_to_specifier_type_list (Q##type, type##_specifier_methods); \
305 dump_add_root_struct_ptr (&type##_specifier_methods, \
306 &specifier_methods_description); \
309 #define REINITIALIZE_SPECIFIER_TYPE(type) do { \
310 staticpro_nodump (&type##_specifier_methods->predicate_symbol); \
313 #define INITIALIZE_SPECIFIER_TYPE_WITH_DATA(type, obj_name, pred_sym) \
315 INITIALIZE_SPECIFIER_TYPE (type, obj_name, pred_sym); \
316 type##_specifier_methods->extra_data_size = \
317 sizeof (struct type##_specifier); \
318 type##_specifier_methods->extra_description = \
319 type##_specifier_description; \
322 /* Declare that specifier-type TYPE has method METH; used in
323 initialization routines */
324 #define SPECIFIER_HAS_METHOD(type, meth) \
325 (type##_specifier_methods->meth##_method = type##_##meth)
327 /***** Macros for accessing specifier types *****/
329 #define SPECIFIER_TYPE_P(sp, type) \
330 ((sp)->methods == type##_specifier_methods)
332 /* Any of the two of the magic spec */
333 #define MAGIC_SPECIFIER_P(sp) (!NILP((sp)->magic_parent))
334 /* Normal part of the magic specifier */
335 #define BODILY_SPECIFIER_P(sp) EQ ((sp)->magic_parent, Qt)
336 /* Ghost part of the magic specifier */
337 #define GHOST_SPECIFIER_P(sp) SPECIFIERP((sp)->magic_parent)
339 #define GHOST_SPECIFIER(sp) XSPECIFIER ((sp)->fallback)
341 #ifdef ERROR_CHECK_TYPECHECK
342 # define SPECIFIER_TYPE_DATA(sp, type) \
343 error_check_##type##_specifier_data (sp)
345 # define SPECIFIER_TYPE_DATA(sp, type) \
346 ((struct type##_specifier *) \
347 (GHOST_SPECIFIER_P(sp) \
348 ? XSPECIFIER((sp)->magic_parent)->data \
352 #ifdef ERROR_CHECK_TYPECHECK
353 # define XSPECIFIER_TYPE(x, type) \
354 error_check_##type##_specifier_type (x)
355 # define XSETSPECIFIER_TYPE(x, p, type) do \
357 XSETSPECIFIER (x, p); \
358 assert (SPECIFIER_TYPEP (XSPECIFIER(x), type)); \
361 # define XSPECIFIER_TYPE(x, type) XSPECIFIER (x)
362 # define XSETSPECIFIER_TYPE(x, p, type) XSETSPECIFIER (x, p)
363 #endif /* ERROR_CHECK_TYPE_CHECK */
365 #define SPECIFIER_TYPEP(x, type) \
366 (SPECIFIERP (x) && SPECIFIER_TYPE_P (XSPECIFIER (x), type))
367 #define CHECK_SPECIFIER_TYPE(x, type) do { \
368 CHECK_SPECIFIER (x); \
369 if (!SPECIFIER_TYPE_P (XSPECIFIER (x), type)) \
370 dead_wrong_type_argument \
371 (type##_specifier_methods->predicate_symbol, x); \
373 #define CONCHECK_SPECIFIER_TYPE(x, type) do { \
374 CONCHECK_SPECIFIER (x); \
375 if (!(SPECIFIER_TYPEP (x, type))) \
376 x = wrong_type_argument \
377 (type##_specifier_methods->predicate_symbol, x); \
380 /***** Miscellaneous structures *****/
382 enum spec_locale_type {
393 SPEC_REMOVE_TAG_SET_PREPEND,
394 SPEC_REMOVE_TAG_SET_APPEND,
396 SPEC_REMOVE_LOCALE_TYPE,
400 struct specifier_caching {
401 int offset_into_struct_window;
402 void (*value_changed_in_window) (Lisp_Object specifier,
403 struct window * w, Lisp_Object oldval);
404 int offset_into_struct_frame;
405 void (*value_changed_in_frame) (Lisp_Object specifier, struct frame * f,
407 int always_recompute;
410 /* #### get image instances out of domains! */
412 /* #### I think the following should abort() rather than return nil
413 when an invalid domain is given; much more likely we'll catch design
414 errors early. --ben */
416 /* This turns out to be used heavily so we make it a macro to make it
417 inline. Also, the majority of the time the object will turn out to
418 be a window so we move it from being checked last to being checked
420 #define DOMAIN_DEVICE(obj) \
421 (WINDOWP (obj) ? WINDOW_DEVICE (XWINDOW (obj)) \
422 : (FRAMEP (obj) ? FRAME_DEVICE (XFRAME (obj)) \
423 : (DEVICEP (obj) ? obj \
424 : (IMAGE_INSTANCEP (obj) ? image_instance_device (obj) \
427 #define DOMAIN_FRAME(obj) \
428 (WINDOWP (obj) ? WINDOW_FRAME (XWINDOW (obj)) \
429 : (FRAMEP (obj) ? obj \
430 : (IMAGE_INSTANCEP (obj) ? image_instance_frame (obj) \
433 #define DOMAIN_WINDOW(obj) \
434 (WINDOWP (obj) ? obj \
435 : (IMAGE_INSTANCEP (obj) ? image_instance_window (obj) \
438 #define DOMAIN_LIVE_P(obj) \
439 (WINDOWP (obj) ? WINDOW_LIVE_P (XWINDOW (obj)) \
440 : (FRAMEP (obj) ? FRAME_LIVE_P (XFRAME (obj)) \
441 : (DEVICEP (obj) ? DEVICE_LIVE_P (XDEVICE (obj)) \
442 : (IMAGE_INSTANCEP (obj) ? image_instance_live_p (obj) \
445 #define DOMAIN_XDEVICE(obj) \
446 (XDEVICE (DOMAIN_DEVICE (obj)))
447 #define DOMAIN_XFRAME(obj) \
448 (XFRAME (DOMAIN_FRAME (obj)))
449 #define DOMAIN_XWINDOW(obj) \
450 (XWINDOW (DOMAIN_WINDOW (obj)))
452 EXFUN(Fcopy_specifier, 6);
453 EXFUN(Fmake_specifier, 1);
454 EXFUN(Fset_specifier_dirty_flag, 1);
455 EXFUN(Fspecifier_instance, 4);
456 EXFUN(Fvalid_specifier_locale_p, 1);
458 extern Lisp_Object Qfallback, Qnatnum;
460 Lisp_Object make_magic_specifier(Lisp_Object type);
461 Lisp_Object decode_locale_list(Lisp_Object locale);
462 extern enum spec_add_meth
463 decode_how_to_add_specification(Lisp_Object how_to_add);
464 Lisp_Object decode_specifier_tag_set(Lisp_Object tag_set);
465 Lisp_Object decode_domain(Lisp_Object domain);
467 void add_entry_to_specifier_type_list(Lisp_Object symbol,
468 struct specifier_methods *meths);
469 void set_specifier_caching(Lisp_Object specifier,
470 int struct_window_offset,
471 void (*value_changed_in_window)
472 (Lisp_Object specifier, struct window * w,
474 int struct_frame_offset,
475 void (*value_changed_in_frame)
476 (Lisp_Object specifier, struct frame * f,
477 Lisp_Object oldval), int always_recompute);
478 void set_specifier_fallback(Lisp_Object specifier, Lisp_Object fallback);
479 void recompute_all_cached_specifiers_in_window(struct window *w);
480 void recompute_all_cached_specifiers_in_frame(struct frame *f);
482 /* Counterparts of Fadd_spec_to_specifier and Fremove_specifier, which
483 operate directly on ghost objects given a magic specifier. */
484 void add_spec_to_ghost_specifier(Lisp_Object specifier,
485 Lisp_Object instantiator, Lisp_Object locale,
486 Lisp_Object tag_set, Lisp_Object how_to_add);
487 void remove_ghost_specifier(Lisp_Object specifier, Lisp_Object locale,
488 Lisp_Object tag_set, Lisp_Object exact_p);
490 int unlock_ghost_specifiers_protected(void);
492 void cleanup_specifiers(void);
493 void prune_specifiers(void);
494 void setup_device_initial_specifier_tags(struct device *d);
495 void kill_specifier_buffer_locals(Lisp_Object buffer);
497 DECLARE_SPECIFIER_TYPE(generic);
498 #define XGENERIC_SPECIFIER(x) XSPECIFIER_TYPE (x, generic)
499 #define XSETGENERIC_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, generic)
500 #define GENERIC_SPECIFIERP(x) SPECIFIER_TYPEP (x, generic)
501 #define CHECK_GENERIC_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, generic)
502 #define CONCHECK_GENERIC_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, generic)
504 DECLARE_SPECIFIER_TYPE(integer);
505 #define XINTEGER_SPECIFIER(x) XSPECIFIER_TYPE (x, integer)
506 #define XSETINTEGER_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, integer)
507 #define INTEGER_SPECIFIERP(x) SPECIFIER_TYPEP (x, integer)
508 #define CHECK_INTEGER_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, integer)
509 #define CONCHECK_INTEGER_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, integer)
511 DECLARE_SPECIFIER_TYPE(natnum);
512 #define XNATNUM_SPECIFIER(x) XSPECIFIER_TYPE (x, natnum)
513 #define XSETNATNUM_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, natnum)
514 #define NATNUM_SPECIFIERP(x) SPECIFIER_TYPEP (x, natnum)
515 #define CHECK_NATNUM_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, natnum)
516 #define CONCHECK_NATNUM_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, natnum)
518 DECLARE_SPECIFIER_TYPE(boolean);
519 #define XBOOLEAN_SPECIFIER(x) XSPECIFIER_TYPE (x, boolean)
520 #define XSETBOOLEAN_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, boolean)
521 #define BOOLEAN_SPECIFIERP(x) SPECIFIER_TYPEP (x, boolean)
522 #define CHECK_BOOLEAN_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, boolean)
523 #define CONCHECK_BOOLEAN_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, boolean)
525 DECLARE_SPECIFIER_TYPE(display_table);
526 #define XDISPLAYTABLE_SPECIFIER(x) XSPECIFIER_TYPE (x, display_table)
527 #define XSETDISPLAYTABLE_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, display_table)
528 #define DISPLAYTABLE_SPECIFIERP(x) SPECIFIER_TYPEP (x, display_table)
529 #define CHECK_DISPLAYTABLE_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, display_table)
530 #define CONCHECK_DISPLAYTABLE_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, display_table)
532 #endif /* INCLUDED_specifier_h_ */