[PATCH] Magic specifiers reworked

I have modified the behavior of magic specifiers as Ben suggested. As before, there are only 2 magic specifiers: scrollbar-{height,width}. Kirill ChangeLog entry for src/ 1998-05-01 Kirill M. Katsnelson <kkm(a)kis.ru&gt; * specifier.h: Corrected documentation on magic specifiers. Documented DEPTH parameter to instantiate_method. Renamed reveal->unlock_ghost_specifiers_protected(). * specifier.c: Removed the reveal mechanism and made ghost specifiers read-only, so they are accessible as fallbacks of magic specifier, but aren't modifiable unless C code enables so. (specifier_equal): Compare specifier fallbacks as well. * scrollbar.c (init_frame_scrollbars): (init_device_scrollbars): (init_global_scrollbars): Renamed reveal->unlock_ghost_specifiers_protected(). ChangeLog entry for lisp/ 1998-05-01 Kirill M. Katsnelson <kkm(a)kis.ru&gt; * x-scrollbar.el (x-init-scrollbar-from-resources): Stuff resource-provided values into ghost specs for scrollbar-height and scrollbar-width. Index: src/specifier.h =================================================================== RCS file: /var/cvsroot/ntxemacs/src/specifier.h,v retrieving revision 1.3 diff --unified=2 -r1.3 specifier.h --- src/specifier.h 1998/04/20 06:31:35 1.3 +++ src/specifier.h 1998/05/01 09:58:58 ＠＠ -36,5 +36,11 ＠＠ A magic specifier consists of two specifier objects. The first one behaves like a normal specifier in all sences. The second one, a - ghost specifier, is a fallback value for the first one. + ghost specifier, is a fallback value for the first one, and contains + values provided by window system, resources etc. which reflect + default settings for values being specified. + + A magic specifier has an "ultimate" fallback value, as any usual + specifier does. This value, an inst-list, is stored in the fallback + slot of the ghost specifier object. Ghost specifiers have the following properties: ＠＠ -44,13 +50,14 ＠＠ - Have the same methods structure pointer. - Share parent's caching scheme. - - Store fallback value instead of their parent. + - Store fallback value instead of their parents. Ghost specifiers normally are not modifiable at the lisp level, and - only used to supply fallback instance values. Although, under - certain rare conditions, all functions that modify specifiers - operate on ghost objects. This behavior is controlled by the global - variable Vreveal_ghoste_specifiers. It is not exposed to lisp, and - is set during calls to lisp functions which initialize global, - device and frame defaults, such as + only used to supply fallback instance values. They are accessible + via (specifier-fallback), but are read-only. Although, under + certain rare conditions, modification of ghost objects is allowed. + This behavior is controlled by the global variable + Vunlock_ghost_specifiers. It is not exposed to lisp, and is set + during calls to lisp functions which initialize global, device and + frame defaults, such as init-{global,frame,device}-{faces,toolbars,etc}. ＠＠ -64,21 +71,13 ＠＠ Rules of conduct for magic specifiers ------------------------------------- - 1. All functions exposed to lisp operate on a ghost specifier when - Vreveal_ghoste_specifiers is non-nil. This includes both - modifying and non-modifying functions, such as - Fspecifier_instance, for symmetry and consistency. - 2. These functions deal with the above condition internally, passing - mangled specifier pointer to internal functions. The internal - functions always work on a specifier passed, and do not regard - the value of Vreveal_ghoste_specifiers. - 3. recompute_*() functions always operate on the whole specifier + 1. recompute_*() functions always operate on the whole specifier when passed only a ghost object, by substituting it with their parent bodily object. - 4. All specifier methods, except for instantiate method, are passed + 2. All specifier methods, except for instantiate method, are passed the bodily object of the magic specifier. Instantiate method is passed the specifier being instantiated. - 5. Only bodily objects are passed to set_specifier_caching function, + 3. Only bodily objects are passed to set_specifier_caching function, and only these may be cached. - 6. All specifiers are added to Vall_specifiers list, both bodily and + 4. All specifiers are added to Vall_specifiers list, both bodily and ghost. The pair of objects is always removed from the list at the same time. ＠＠ -140,5 +139,8 ＠＠ DEPTH is a lisp integer denoting current depth of instantiation - calls. #### WTF a method can do with this? + calls. This parameter should be passed as the initial depth value + to functions which also instantiate specifiers (of which I can + name specifier_instance) to avoid creating "external" + specification loops. This method must presume that both INSTANTIATOR and MATCSPEC are ＠＠ -413,6 +415,6 ＠＠ void recompute_all_cached_specifiers_in_frame (struct frame *f); -/* Counterparts of Fadd_spec_to_specifier and Fremove_specifier, - which operate directly on ghost objects */ +/* Counterparts of Fadd_spec_to_specifier and Fremove_specifier, which + operate directly on ghost objects given a magic specifier. */ void add_spec_to_ghost_specifier (Lisp_Object specifier, Lisp_Object instantiator, Lisp_Object locale, Lisp_Object tag_set, ＠＠ -421,5 +423,5 ＠＠ Lisp_Object tag_set, Lisp_Object exact_p); -int reveal_ghost_specifiers_protected (void); +int unlock_ghost_specifiers_protected (void); void cleanup_specifiers (void); Index: src/specifier.c =================================================================== RCS file: /var/cvsroot/ntxemacs/src/specifier.c,v retrieving revision 1.3 diff --unified=2 -r1.3 specifier.c --- src/specifier.c 1998/04/20 06:31:33 1.3 +++ src/specifier.c 1998/05/01 10:03:05 ＠＠ -25,5 +25,7 ＠＠ /* Design by Ben Wing; Original version by Chuck Thompson; - rewritten by Ben Wing */ + rewritten by Ben Wing; + Magic specifiers by Kirill Katsnelson; +*/ #include <config.h> ＠＠ -70,5 +72,5 ＠＠ static Lisp_Object Vall_specifiers; -static Lisp_Object Vreveal_ghoste_specifiers; +static Lisp_Object Vunlock_ghost_specifiers; /* #### The purpose of this is to check for inheritance loops ＠＠ -304,6 +306,6 ＠＠ internal_equal (s1->frame_specs, s2->frame_specs, depth) && internal_equal (s1->window_specs, s2->window_specs, depth) && - internal_equal (s1->buffer_specs, s2->buffer_specs, depth)); - /* #### Why do not compare fallbacks here? */ + internal_equal (s1->buffer_specs, s2->buffer_specs, depth) && + internal_equal (s1->fallback, s2->fallback, depth)); if (retval && HAS_SPECMETH_P (s1, equal)) ＠＠ -1238,5 +1240,5 ＠＠ } -/* Given a specifier object SPEC, return its bodily specifier for a +/* Given a specifier object SPEC, return bodily specifier if SPEC is a ghost specifier, otherwise return the object itself */ ＠＠ -1248,34 +1250,33 ＠＠ } -/* Given a specifier object SPEC, return a specifier to be operated on - by external lisp function. This is a ghost specifier for a magic - specifier when and only when Vreveal_ghoste_specifiers is non-nil, - otherwise SPEC itself. +/* Signal error if (specifier SPEC is read-only. + Read only are ghost specifiers unless Vunlock_ghost_specifiers is + non-nil. All other specifiers are read-write. */ -static Lisp_Object -maybe_ghost_specifier (Lisp_Object spec) +static void +check_modifiable_specifier (Lisp_Object spec) { - return (!NILP (Vreveal_ghoste_specifiers) - && BODILY_SPECIFIER_P (XSPECIFIER (spec)) - ? XSPECIFIER(spec)->fallback : spec); + if (NILP (Vunlock_ghost_specifiers) + && GHOST_SPECIFIER_P (XSPECIFIER (spec))) + signal_simple_error ("Attempt to modify read-only specifier", + list1 (spec)); } /* Helper function which unwind protects the value of - Vreveal_ghoste_specifiers, then sets it to non-nil value */ - + Vunlock_ghost_specifiers, then sets it to non-nil value */ static Lisp_Object -restore_reveal_value (Lisp_Object val) +restore_unlock_value (Lisp_Object val) { - Vreveal_ghoste_specifiers = val; + Vunlock_ghost_specifiers = val; return val; } int -reveal_ghost_specifiers_protected (void) +unlock_ghost_specifiers_protected (void) { int depth = specpdl_depth (); - record_unwind_protect (restore_reveal_value, - Vreveal_ghoste_specifiers); - Vreveal_ghoste_specifiers = Qt; + record_unwind_protect (restore_unlock_value, + Vunlock_ghost_specifiers); + Vunlock_ghost_specifiers = Qt; return depth; } ＠＠ -1845,4 +1846,6 ＠＠ CHECK_SPECIFIER (specifier); + check_modifiable_specifier (specifier); + locale = decode_locale (locale); check_valid_instantiator (instantiator, ＠＠ -1857,6 +1860,5 ＠＠ inst_list = list1 (Fcons (tag_set, instantiator)); GCPRO1 (inst_list); - specifier_add_spec (maybe_ghost_specifier (specifier), - locale, inst_list, add_meth); + specifier_add_spec (specifier, locale, inst_list, add_meth); recompute_cached_specifier_everywhere (specifier); RETURN_UNGCPRO (Qnil); ＠＠ -1896,4 +1898,6 ＠＠ CHECK_SPECIFIER (specifier); + check_modifiable_specifier (specifier); + check_valid_spec_list (spec_list, decode_specifier_type ＠＠ -1909,6 +1913,5 ＠＠ Lisp_Object inst_list = XCDR (specification); - specifier_add_spec (maybe_ghost_specifier (specifier), - locale, inst_list, add_meth); + specifier_add_spec (specifier, locale, inst_list, add_meth); } recompute_cached_specifier_everywhere (specifier); ＠＠ -1921,7 +1924,7 ＠＠ Lisp_Object how_to_add) { - int depth = reveal_ghost_specifiers_protected (); - Fadd_spec_to_specifier (specifier, instantiator, locale, - tag_set, how_to_add); + int depth = unlock_ghost_specifiers_protected (); + Fadd_spec_to_specifier (XSPECIFIER(specifier)->fallback, + instantiator, locale, tag_set, how_to_add); unbind_to (depth, Qnil); } ＠＠ -2014,6 +2017,5 ＠＠ cl.head = cl.tail = Qnil; GCPRO2 (cl.head, cl.tail); - map_specifier (maybe_ghost_specifier (specifier), - locale, specifier_spec_list_mapfun, + map_specifier (specifier, locale, specifier_spec_list_mapfun, tag_set, exact_p, &cl); UNGCPRO; ＠＠ -2059,9 +2061,7 ＠＠ tag_set = canonicalize_tag_set (tag_set); RETURN_UNGCPRO - (specifier_get_external_inst_list (maybe_ghost_specifier (specifier), - locale, + (specifier_get_external_inst_list (specifier, locale, locale_type_from_locale (locale), - tag_set, !NILP (exact_p), - 1, 1)); + tag_set, !NILP (exact_p), 1, 1)); } else ＠＠ -2110,6 +2110,8 ＠＠ { CHECK_SPECIFIER (specifier); - map_specifier (maybe_ghost_specifier (specifier), locale, - remove_specifier_mapfun, tag_set, exact_p, 0); + check_modifiable_specifier (specifier); + + map_specifier (specifier, locale, remove_specifier_mapfun, + tag_set, exact_p, 0); recompute_cached_specifier_everywhere (specifier); return Qnil; ＠＠ -2120,6 +2122,7 ＠＠ Lisp_Object tag_set, Lisp_Object exact_p) { - int depth = reveal_ghost_specifiers_protected (); - Fremove_specifier (specifier, locale, tag_set, exact_p); + int depth = unlock_ghost_specifiers_protected (); + Fremove_specifier (XSPECIFIER(specifier)->fallback, + locale, tag_set, exact_p); unbind_to (depth, Qnil); } ＠＠ -2203,4 +2206,5 ＠＠ { CHECK_SPECIFIER (dest); + check_modifiable_specifier (dest); if (XSPECIFIER (dest)->methods != XSPECIFIER (specifier)->methods) error ("Specifiers not of same type"); ＠＠ -2209,6 +2213,6 ＠＠ cl.dest = dest; GCPRO1 (dest); - map_specifier (maybe_ghost_specifier (specifier), locale, - copy_specifier_mapfun, tag_set, exact_p, &cl); + map_specifier (specifier, locale, copy_specifier_mapfun, + tag_set, exact_p, &cl); UNGCPRO; recompute_cached_specifier_everywhere (dest); ＠＠ -2448,5 +2452,7 ＠＠ else /* #### dmoore - dammit, this should just signal an error or something - shouldn't it? */ + shouldn't it? + #### No. Errors are handled in Lisp primitives implementation. + Invalid domain is a design error here - kkm. */ abort (); ＠＠ -2582,6 +2588,5 ＠＠ domain = decode_domain (domain); - instance = specifier_instance (maybe_ghost_specifier (specifier), - Qunbound, domain, ERROR_ME, 0, + instance = specifier_instance (specifier, Qunbound, domain, ERROR_ME, 0, !NILP (no_fallback), Qzero); return UNBOUNDP (instance) ? default_ : instance; ＠＠ -2620,6 +2625,5 ＠＠ domain = decode_domain (domain); - instance = specifier_instance (maybe_ghost_specifier (specifier), - matchspec, domain, ERROR_ME, + instance = specifier_instance (specifier, matchspec, domain, ERROR_ME, 0, !NILP (no_fallback), Qzero); return UNBOUNDP (instance) ? default_ : instance; ＠＠ -2645,10 +2649,9 ＠＠ check_valid_inst_list (inst_list, sp->methods, ERROR_ME); GCPRO1 (built_up_list); - built_up_list = build_up_processed_list (maybe_ghost_specifier (specifier), - domain, inst_list); + built_up_list = build_up_processed_list (specifier, domain, inst_list); if (!NILP (built_up_list)) - val = specifier_instance_from_inst_list (maybe_ghost_specifier (specifier), - Qunbound, domain, built_up_list, - ERROR_ME, 0, Qzero); + val = specifier_instance_from_inst_list (specifier, Qunbound, domain, + built_up_list, ERROR_ME, + 0, Qzero); UNGCPRO; return UNBOUNDP (val) ? default_ : val; ＠＠ -2680,10 +2683,9 ＠＠ check_valid_inst_list (inst_list, sp->methods, ERROR_ME); GCPRO1 (built_up_list); - built_up_list = build_up_processed_list (maybe_ghost_specifier (specifier), - domain, inst_list); + built_up_list = build_up_processed_list (specifier, domain, inst_list); if (!NILP (built_up_list)) - val = specifier_instance_from_inst_list (maybe_ghost_specifier (specifier), - matchspec, domain, built_up_list, - ERROR_ME, 0, Qzero); + val = specifier_instance_from_inst_list (specifier, matchspec, domain, + built_up_list, ERROR_ME, + 0, Qzero); UNGCPRO; return UNBOUNDP (val) ? default_ : val; ＠＠ -3131,5 +3133,5 ＠＠ staticpro (&Vuser_defined_tags); - Vreveal_ghoste_specifiers = Qnil; - staticpro (&Vreveal_ghoste_specifiers); + Vunlock_ghost_specifiers = Qnil; + staticpro (&Vunlock_ghost_specifiers); } Index: src/scrollbar.c =================================================================== RCS file: /var/cvsroot/ntxemacs/src/scrollbar.c,v retrieving revision 1.1.1.3 diff --unified=2 -r1.1.1.3 scrollbar.c --- src/scrollbar.c 1998/04/19 02:07:28 1.1.1.3 +++ src/scrollbar.c 1998/05/01 09:59:06 ＠＠ -542,5 +542,5 ＠＠ if (HAS_DEVMETH_P (d, create_scrollbar_instance)) { - int depth = reveal_ghost_specifiers_protected (); + int depth = unlock_ghost_specifiers_protected (); Lisp_Object frame; XSETFRAME (frame, f); ＠＠ -557,5 +557,5 ＠＠ if (HAS_DEVMETH_P (d, create_scrollbar_instance)) { - int depth = reveal_ghost_specifiers_protected (); + int depth = unlock_ghost_specifiers_protected (); Lisp_Object device; XSETDEVICE (device, d); ＠＠ -572,5 +572,5 ＠＠ if (HAS_DEVMETH_P (d, create_scrollbar_instance)) { - int depth = reveal_ghost_specifiers_protected (); + int depth = unlock_ghost_specifiers_protected (); call_critical_lisp_code (d, Qinit_scrollbar_from_resources, Index: lisp/x-scrollbar.el =================================================================== RCS file: /var/cvsroot/ntxemacs/lisp/x-scrollbar.el,v retrieving revision 1.1.1.1 diff --unified=2 -r1.1.1.1 x-scrollbar.el --- lisp/x-scrollbar.el 1997/12/28 17:14:33 1.1.1.1 +++ lisp/x-scrollbar.el 1998/05/01 09:49:43 ＠＠ -36,5 +36,5 ＠＠ (defun x-init-scrollbar-from-resources (locale) (x-init-specifier-from-resources - scrollbar-width 'natnum locale + (specifier-fallback scrollbar-width) 'natnum locale '("scrollBarWidth" . "ScrollBarWidth") ;; The name strings are wrong, but the scrollbar name is ＠＠ -53,10 +53,10 ＠＠ (if (featurep 'athena-scrollbars) (x-init-specifier-from-resources - scrollbar-width 'natnum locale + (specifier-fallback scrollbar-width) 'natnum locale '("scrollbar.width" . "ScrollBar.Width"))) ;; lather, rinse, repeat. (x-init-specifier-from-resources - scrollbar-height 'natnum locale + (specifier-fallback scrollbar-height) 'natnum locale '("scrollBarHeight" . "ScrollBarHeight") ;; The name strings are wrong, but the scrollbar name is ＠＠ -75,5 +75,5 ＠＠ (if (featurep 'athena-scrollbars) (x-init-specifier-from-resources - scrollbar-height 'natnum locale + (specifier-fallback scrollbar-height) 'natnum locale '("scrollbar.height" . "ScrollBar.Height"))))