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>
* 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>
* 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"))))