#include "rangetab.h"
Lisp_Object Qspecifierp;
-Lisp_Object Qprepend, Qappend, Qremove_tag_set_prepend, Qremove_tag_set_append;
-Lisp_Object Qremove_locale, Qremove_locale_type, Qremove_all;
-Lisp_Object Qfallback;
-
-/* Qinteger, Qboolean, Qgeneric defined in general.c. */
-Lisp_Object Qnatnum;
+Lisp_Object Qremove_tag_set_prepend, Qremove_tag_set_append;
+Lisp_Object Qremove_locale, Qremove_locale_type;
Lisp_Object Qconsole_type, Qdevice_class;
+Lisp_Object Qspecifier_syntax_error;
+Lisp_Object Qspecifier_argument_error;
+Lisp_Object Qspecifier_change_error;
+
static Lisp_Object Vuser_defined_tags;
typedef struct specifier_type_entry specifier_type_entry;
Dynarr_declare (specifier_type_entry);
} specifier_type_entry_dynarr;
-specifier_type_entry_dynarr *the_specifier_type_entry_dynarr;
+static specifier_type_entry_dynarr *the_specifier_type_entry_dynarr;
+
+static const struct lrecord_description ste_description_1[] = {
+ { XD_LISP_OBJECT, offsetof (specifier_type_entry, symbol) },
+ { XD_STRUCT_PTR, offsetof (specifier_type_entry, meths), 1,
+ &specifier_methods_description },
+ { XD_END }
+};
+
+static const struct struct_description ste_description = {
+ sizeof (specifier_type_entry),
+ ste_description_1
+};
+
+static const struct lrecord_description sted_description_1[] = {
+ XD_DYNARR_DESC (specifier_type_entry_dynarr, &ste_description),
+ { XD_END }
+};
+
+static const struct struct_description sted_description = {
+ sizeof (specifier_type_entry_dynarr),
+ sted_description_1
+};
static Lisp_Object Vspecifier_type_list;
!NILP (rest);
rest = XSPECIFIER (rest)->next_specifier)
{
- struct Lisp_Specifier *sp = XSPECIFIER (rest);
+ Lisp_Specifier *sp = XSPECIFIER (rest);
/* This effectively changes the specifier specs.
However, there's no need to call
recompute_cached_specifier_everywhere() or the
!NILP (rest);
rest = XSPECIFIER (rest)->next_specifier)
{
- struct Lisp_Specifier *sp = XSPECIFIER (rest);
+ Lisp_Specifier *sp = XSPECIFIER (rest);
/* Make sure we're actually going to be changing something.
Fremove_specifier() always calls
}
static Lisp_Object
-mark_specifier (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_specifier (Lisp_Object obj)
{
- struct Lisp_Specifier *specifier = XSPECIFIER (obj);
+ Lisp_Specifier *specifier = XSPECIFIER (obj);
- markobj (specifier->global_specs);
- markobj (specifier->device_specs);
- markobj (specifier->frame_specs);
- markobj (specifier->window_specs);
- markobj (specifier->buffer_specs);
- markobj (specifier->magic_parent);
- markobj (specifier->fallback);
+ mark_object (specifier->global_specs);
+ mark_object (specifier->device_specs);
+ mark_object (specifier->frame_specs);
+ mark_object (specifier->window_specs);
+ mark_object (specifier->buffer_specs);
+ mark_object (specifier->magic_parent);
+ mark_object (specifier->fallback);
if (!GHOST_SPECIFIER_P (XSPECIFIER (obj)))
- MAYBE_SPECMETH (specifier, mark, (obj, markobj));
+ MAYBE_SPECMETH (specifier, mark, (obj));
return Qnil;
}
*/
void
-prune_specifiers (int (*obj_marked_p) (Lisp_Object))
+prune_specifiers (void)
{
Lisp_Object rest, prev = Qnil;
for (rest = Vall_specifiers;
- !GC_NILP (rest);
+ !NILP (rest);
rest = XSPECIFIER (rest)->next_specifier)
{
- if (! obj_marked_p (rest))
+ if (! marked_p (rest))
{
- struct Lisp_Specifier* sp = XSPECIFIER (rest);
+ Lisp_Specifier* sp = XSPECIFIER (rest);
/* A bit of assertion that we're removing both parts of the
magic one altogether */
- assert (!GC_MAGIC_SPECIFIER_P(sp)
- || (GC_BODILY_SPECIFIER_P(sp) && obj_marked_p (sp->fallback))
- || (GC_GHOST_SPECIFIER_P(sp) && obj_marked_p (sp->magic_parent)));
+ assert (!MAGIC_SPECIFIER_P(sp)
+ || (BODILY_SPECIFIER_P(sp) && marked_p (sp->fallback))
+ || (GHOST_SPECIFIER_P(sp) && marked_p (sp->magic_parent)));
/* This specifier is garbage. Remove it from the list. */
- if (GC_NILP (prev))
+ if (NILP (prev))
Vall_specifiers = sp->next_specifier;
else
XSPECIFIER (prev)->next_specifier = sp->next_specifier;
static void
print_specifier (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
{
- struct Lisp_Specifier *sp = XSPECIFIER (obj);
+ Lisp_Specifier *sp = XSPECIFIER (obj);
char buf[100];
int count = specpdl_depth ();
Lisp_Object the_specs;
static void
finalize_specifier (void *header, int for_disksave)
{
- struct Lisp_Specifier *sp = (struct Lisp_Specifier *) header;
+ Lisp_Specifier *sp = (Lisp_Specifier *) header;
/* don't be snafued by the disksave finalization. */
- if (!for_disksave && !GC_GHOST_SPECIFIER_P(sp) && sp->caching)
+ if (!for_disksave && !GHOST_SPECIFIER_P(sp) && sp->caching)
{
xfree (sp->caching);
sp->caching = 0;
static int
specifier_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
{
- struct Lisp_Specifier *s1 = XSPECIFIER (obj1);
- struct Lisp_Specifier *s2 = XSPECIFIER (obj2);
+ Lisp_Specifier *s1 = XSPECIFIER (obj1);
+ Lisp_Specifier *s2 = XSPECIFIER (obj2);
int retval;
Lisp_Object old_inhibit_quit = Vinhibit_quit;
static unsigned long
specifier_hash (Lisp_Object obj, int depth)
{
- struct Lisp_Specifier *s = XSPECIFIER (obj);
+ Lisp_Specifier *s = XSPECIFIER (obj);
/* specifier hashing is a bit problematic because there are so
many places where data can be stored. We pick what are perhaps
}
static size_t
-sizeof_specifier (CONST void *header)
+sizeof_specifier (const void *header)
{
- if (GHOST_SPECIFIER_P ((struct Lisp_Specifier *) header))
- return sizeof (struct Lisp_Specifier);
+ if (GHOST_SPECIFIER_P ((Lisp_Specifier *) header))
+ return offsetof (Lisp_Specifier, data);
else
{
- CONST struct Lisp_Specifier *p = (CONST struct Lisp_Specifier *) header;
- return sizeof (*p) + p->methods->extra_data_size - 1;
+ const Lisp_Specifier *p = (const Lisp_Specifier *) header;
+ return offsetof (Lisp_Specifier, data) + p->methods->extra_data_size;
}
}
+static const struct lrecord_description specifier_methods_description_1[] = {
+ { XD_LISP_OBJECT, offsetof (struct specifier_methods, predicate_symbol) },
+ { XD_END }
+};
+
+const struct struct_description specifier_methods_description = {
+ sizeof (struct specifier_methods),
+ specifier_methods_description_1
+};
+
+static const struct lrecord_description specifier_caching_description_1[] = {
+ { XD_END }
+};
+
+static const struct struct_description specifier_caching_description = {
+ sizeof (struct specifier_caching),
+ specifier_caching_description_1
+};
+
+static const struct lrecord_description specifier_description[] = {
+ { XD_STRUCT_PTR, offsetof (Lisp_Specifier, methods), 1,
+ &specifier_methods_description },
+ { XD_LO_LINK, offsetof (Lisp_Specifier, next_specifier) },
+ { XD_LISP_OBJECT, offsetof (Lisp_Specifier, global_specs) },
+ { XD_LISP_OBJECT, offsetof (Lisp_Specifier, device_specs) },
+ { XD_LISP_OBJECT, offsetof (Lisp_Specifier, frame_specs) },
+ { XD_LISP_OBJECT, offsetof (Lisp_Specifier, window_specs) },
+ { XD_LISP_OBJECT, offsetof (Lisp_Specifier, buffer_specs) },
+ { XD_STRUCT_PTR, offsetof (Lisp_Specifier, caching), 1,
+ &specifier_caching_description },
+ { XD_LISP_OBJECT, offsetof (Lisp_Specifier, magic_parent) },
+ { XD_LISP_OBJECT, offsetof (Lisp_Specifier, fallback) },
+ { XD_SPECIFIER_END }
+};
+
+const struct lrecord_description specifier_empty_extra_description[] = {
+ { XD_END }
+};
+
DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("specifier", specifier,
mark_specifier, print_specifier,
finalize_specifier,
- specifier_equal, specifier_hash, 0,
+ specifier_equal, specifier_hash,
+ specifier_description,
sizeof_specifier,
- struct Lisp_Specifier);
+ Lisp_Specifier);
\f
/************************************************************************/
/* Creating specifiers */
return Dynarr_at (the_specifier_type_entry_dynarr, i).meths;
}
- maybe_signal_simple_error ("Invalid specifier type", type,
- Qspecifier, errb);
+ maybe_signal_type_error (Qspecifier_argument_error, "Invalid specifier type",
+ type, Qspecifier, errb);
return 0;
}
size_t data_size, int call_create_meth)
{
Lisp_Object specifier;
- struct Lisp_Specifier *sp = (struct Lisp_Specifier *)
- alloc_lcrecord (sizeof (struct Lisp_Specifier) +
- data_size - 1, &lrecord_specifier);
+ Lisp_Specifier *sp = (Lisp_Specifier *)
+ alloc_lcrecord (offsetof (Lisp_Specifier, data) + data_size,
+ &lrecord_specifier);
sp->methods = spec_meths;
sp->global_specs = Qnil;
A specifier is an object that can be used to keep track of a property
whose value can be per-buffer, per-window, per-frame, or per-device,
-and can further be restricted to a particular console-type or device-class.
-Specifiers are used, for example, for the various built-in properties of a
-face; this allows a face to have different values in different frames,
-buffers, etc. For more information, see `specifier-instance',
+and can further be restricted to a particular console-type or
+device-class. Specifiers are used, for example, for the various
+built-in properties of a face; this allows a face to have different
+values in different frames, buffers, etc.
+
+When speaking of the value of a specifier, it is important to
+distinguish between the *setting* of a specifier, called an
+\"instantiator\", and the *actual value*, called an \"instance\". You
+put various possible instantiators (i.e. settings) into a specifier
+and associate them with particular locales (buffer, window, frame,
+device, global), and then the instance (i.e. actual value) is
+retrieved in a specific domain (window, frame, device) by looking
+through the possible instantiators (i.e. settings). This process is
+called \"instantiation\".
+
+To put settings into a specifier, use `set-specifier', or the
+lower-level functions `add-spec-to-specifier' and
+`add-spec-list-to-specifier'. You can also temporarily bind a setting
+to a specifier using `let-specifier'. To retrieve settings, use
+`specifier-specs', or its lower-level counterpart
+`specifier-spec-list'. To determine the actual value, use
+`specifier-instance'.
+
+For more information, see `set-specifier', `specifier-instance',
`specifier-specs', and `add-spec-to-specifier'; or, for a detailed
-description of specifiers, including how they are instantiated over a
-particular domain (i.e. how their value in that domain is determined),
-see the chapter on specifiers in the XEmacs Lisp Reference Manual.
+description of specifiers, including how exactly the instantiation
+process works, see the chapter on specifiers in the XEmacs Lisp
+Reference Manual.
TYPE specifies the particular type of specifier, and should be one of
-the symbols 'generic, 'integer, 'boolean, 'color, 'font, 'image,
-'face-boolean, or 'toolbar.
-
-For more information on particular types of specifiers, see the functions
-`generic-specifier-p', `integer-specifier-p', `boolean-specifier-p',
-`color-specifier-p', `font-specifier-p', `image-specifier-p',
-`face-boolean-specifier-p', and `toolbar-specifier-p'.
+the symbols 'generic, 'integer, 'natnum, 'boolean, 'color, 'font,
+'image, 'face-boolean, 'display-table, 'gutter, 'gutter-size,
+'gutter-visible or 'toolbar.
+
+For more information on particular types of specifiers, see the
+functions `make-generic-specifier', `make-integer-specifier',
+`make-natnum-specifier', `make-boolean-specifier',
+`make-color-specifier', `make-font-specifier', `make-image-specifier',
+`make-face-boolean-specifier', `make-gutter-size-specifier',
+`make-gutter-visible-specifier', `default-toolbar', `default-gutter',
+and `current-display-table'.
*/
(type))
{
/* This function can GC */
- struct specifier_methods *meths = decode_specifier_type (type,
- ERROR_ME);
+ struct specifier_methods *meths = decode_specifier_type (type, ERROR_ME);
return make_specifier (meths);
}
DEFUN ("valid-specifier-domain-p", Fvalid_specifier_domain_p, 1, 1, 0, /*
Return t if DOMAIN is a valid specifier domain.
A domain is used to instance a specifier (i.e. determine the specifier's
-value in that domain). Valid domains are windows, frames, and devices.
-\(nil is not valid.)
+value in that domain). Valid domains are image instances, windows, frames,
+and devices. \(nil is not valid.) image instances are pseudo-domains since
+instantiation will actually occur in the window the image instance itself is
+instantiated in.
*/
(domain))
{
/* This cannot GC. */
return ((DEVICEP (domain) && DEVICE_LIVE_P (XDEVICE (domain))) ||
(FRAMEP (domain) && FRAME_LIVE_P (XFRAME (domain))) ||
- (WINDOWP (domain) && WINDOW_LIVE_P (XWINDOW (domain))))
+ (WINDOWP (domain) && WINDOW_LIVE_P (XWINDOW (domain))) ||
+ /* #### get image instances out of domains! */
+ IMAGE_INSTANCEP (domain))
? Qt : Qnil;
}
-DEFUN ("valid-specifier-locale-type-p", Fvalid_specifier_locale_type_p, 1, 1, 0, /*
+DEFUN ("valid-specifier-locale-type-p", Fvalid_specifier_locale_type_p, 1, 1, 0,
+ /*
Given a specifier LOCALE-TYPE, return non-nil if it is valid.
Valid locale types are 'global, 'device, 'frame, 'window, and 'buffer.
\(Note, however, that in functions that accept either a locale or a locale
!NILP (Fvalid_specifier_locale_p (locale)) ||
!NILP (Fvalid_specifier_locale_type_p (locale)))
return;
- signal_simple_error ("Invalid specifier locale or locale type", locale);
+ signal_type_error (Qspecifier_argument_error,
+ "Invalid specifier locale or locale type", locale);
}
DEFUN ("specifier-locale-type-from-locale", Fspecifier_locale_type_from_locale,
{
/* This cannot GC. */
if (NILP (Fvalid_specifier_locale_p (locale)))
- signal_simple_error ("Invalid specifier locale", locale);
+ signal_type_error (Qspecifier_argument_error, "Invalid specifier locale",
+ locale);
if (DEVICEP (locale)) return Qdevice;
if (FRAMEP (locale)) return Qframe;
if (WINDOWP (locale)) return Qwindow;
else if (!NILP (Fvalid_specifier_locale_p (locale)))
return locale;
else
- signal_simple_error ("Invalid specifier locale", locale);
+ signal_type_error (Qspecifier_argument_error, "Invalid specifier locale",
+ locale);
return Qnil;
}
if (EQ (locale_type, Qwindow)) return LOCALE_WINDOW;
if (EQ (locale_type, Qbuffer)) return LOCALE_BUFFER;
- signal_simple_error ("Invalid specifier locale type", locale_type);
+ signal_type_error (Qspecifier_argument_error, "Invalid specifier locale type",
+ locale_type);
return LOCALE_GLOBAL; /* not reached */
}
}
else if (CONSP (locale))
{
- Lisp_Object elt;
EXTERNAL_LIST_LOOP_2 (elt, locale)
check_valid_locale_or_locale_type (elt);
return locale;
check_valid_domain (Lisp_Object domain)
{
if (NILP (Fvalid_specifier_domain_p (domain)))
- signal_simple_error ("Invalid specifier domain", domain);
+ signal_type_error (Qspecifier_argument_error, "Invalid specifier domain",
+ domain);
}
-static Lisp_Object
+Lisp_Object
decode_domain (Lisp_Object domain)
{
if (NILP (domain))
if (!NILP (Fvalid_specifier_tag_p (tag_set)))
return list1 (tag_set);
if (NILP (Fvalid_specifier_tag_set_p (tag_set)))
- signal_simple_error ("Invalid specifier tag-set", tag_set);
+ signal_type_error (Qspecifier_argument_error, "Invalid specifier tag-set",
+ tag_set);
return tag_set;
}
(tag_set))
{
if (NILP (Fvalid_specifier_tag_set_p (tag_set)))
- signal_simple_error ("Invalid tag set", tag_set);
+ signal_type_error (Qspecifier_argument_error, "Invalid tag set", tag_set);
return canonicalize_tag_set (tag_set);
}
return 1;
}
-DEFUN ("device-matches-specifier-tag-set-p", Fdevice_matches_specifier_tag_set_p, 2, 2, 0, /*
+DEFUN ("device-matches-specifier-tag-set-p",
+ Fdevice_matches_specifier_tag_set_p, 2, 2, 0, /*
Return non-nil if DEVICE matches specifier tag set TAG-SET.
This means that DEVICE matches each tag in the tag set. (Every
tag recognized by XEmacs has a predicate associated with it that
CHECK_LIVE_DEVICE (device);
if (NILP (Fvalid_specifier_tag_set_p (tag_set)))
- signal_simple_error ("Invalid tag set", tag_set);
+ signal_type_error (Qspecifier_argument_error, "Invalid tag set", tag_set);
return device_matches_specifier_tag_set_p (device, tag_set) ? Qt : Qnil;
}
CHECK_SYMBOL (tag);
if (valid_device_class_p (tag) ||
valid_console_type_p (tag))
- signal_simple_error ("Cannot redefine built-in specifier tags", tag);
+ signal_type_error (Qspecifier_change_error,
+ "Cannot redefine built-in specifier tags", tag);
/* Try to prevent common instantiators and locales from being
redefined, to reduce ambiguity */
if (NILP (tag) || EQ (tag, Qt) || EQ (tag, Qall) || EQ (tag, Qglobal))
- signal_simple_error ("Cannot define nil, t, 'all, or 'global",
- tag);
+ signal_type_error (Qspecifier_change_error, "Cannot define nil, t, 'all, or 'global",
+ tag);
assoc = assq_no_quit (tag, Vuser_defined_tags);
if (NILP (assoc))
{
}
}
-DEFUN ("device-matching-specifier-tag-list", Fdevice_matching_specifier_tag_list,
+DEFUN ("device-matching-specifier-tag-list",
+ Fdevice_matching_specifier_tag_list,
0, 1, 0, /*
Return a list of all specifier tags matching DEVICE.
DEVICE defaults to the selected device if omitted.
CHECK_SYMBOL (tag);
if (NILP (Fvalid_specifier_tag_p (tag)))
- signal_simple_error ("Invalid specifier tag", tag);
+ signal_type_error (Qspecifier_argument_error, "Invalid specifier tag",
+ tag);
/* Make up some predicates for the built-in types */
if (!CONSP (rest))
{
- maybe_signal_simple_error ("Invalid instantiator list", inst_list,
+ maybe_signal_type_error (Qspecifier_syntax_error,
+ "Invalid instantiator list", inst_list,
Qspecifier, errb);
return Qnil;
}
if (!CONSP (inst_pair = XCAR (rest)))
{
- maybe_signal_simple_error ("Invalid instantiator pair", inst_pair,
+ maybe_signal_type_error (Qspecifier_syntax_error,
+ "Invalid instantiator pair", inst_pair,
Qspecifier, errb);
return Qnil;
}
if (NILP (Fvalid_specifier_tag_set_p (tag_set = XCAR (inst_pair))))
{
- maybe_signal_simple_error ("Invalid specifier tag", tag_set,
+ maybe_signal_type_error (Qspecifier_syntax_error,
+ "Invalid specifier tag", tag_set,
Qspecifier, errb);
return Qnil;
}
Lisp_Object spec, locale;
if (!CONSP (rest) || !CONSP (spec = XCAR (rest)))
{
- maybe_signal_simple_error ("Invalid specification list", spec_list,
+ maybe_signal_type_error (Qspecifier_syntax_error,
+ "Invalid specification list", spec_list,
Qspecifier, errb);
return Qnil;
}
if (NILP (Fvalid_specifier_locale_p (locale = XCAR (spec))))
{
- maybe_signal_simple_error ("Invalid specifier locale", locale,
+ maybe_signal_type_error (Qspecifier_syntax_error,
+ "Invalid specifier locale", locale,
Qspecifier, errb);
return Qnil;
}
if (EQ (Qremove_all, how_to_add))
return SPEC_REMOVE_ALL;
- signal_simple_error ("Invalid `how-to-add' flag", how_to_add);
+ signal_type_error (Qspecifier_argument_error, "Invalid `how-to-add' flag",
+ how_to_add);
return SPEC_PREPEND; /* not reached */
}
{
if (NILP (Vunlock_ghost_specifiers)
&& GHOST_SPECIFIER_P (XSPECIFIER (spec)))
- signal_simple_error ("Attempt to modify read-only specifier",
+ signal_type_error (Qspecifier_change_error,
+ "Attempt to modify read-only specifier",
list1 (spec));
}
{
/* The return value of this function must be GCPRO'd. */
Lisp_Object rest, list_to_build_up = Qnil;
- struct Lisp_Specifier *sp = XSPECIFIER (specifier);
+ Lisp_Specifier *sp = XSPECIFIER (specifier);
struct gcpro gcpro1;
GCPRO1 (list_to_build_up);
LIST_LOOP (rest, inst_list)
{
Lisp_Object tag_set = XCAR (XCAR (rest));
- Lisp_Object instantiator = Fcopy_tree (XCDR (XCAR (rest)), Qt);
Lisp_Object sub_inst_list = Qnil;
+ Lisp_Object instantiator;
struct gcpro ngcpro1, ngcpro2;
+ if (HAS_SPECMETH_P (sp, copy_instantiator))
+ instantiator = SPECMETH (sp, copy_instantiator,
+ (XCDR (XCAR (rest))));
+ else
+ instantiator = Fcopy_tree (XCDR (XCAR (rest)), Qt);
+
NGCPRO2 (instantiator, sub_inst_list);
/* call the will-add method; it may GC */
sub_inst_list = HAS_SPECMETH_P (sp, going_to_add) ?
specifier_add_spec (Lisp_Object specifier, Lisp_Object locale,
Lisp_Object inst_list, enum spec_add_meth add_meth)
{
- struct Lisp_Specifier *sp = XSPECIFIER (specifier);
+ Lisp_Specifier *sp = XSPECIFIER (specifier);
enum spec_locale_type type = locale_type_from_locale (locale);
Lisp_Object *orig_inst_list, tem;
Lisp_Object list_to_build_up = Qnil;
else if (add_meth == SPEC_APPEND)
tem = nconc2 (*orig_inst_list, list_to_build_up);
else
- abort ();
+ {
+ abort ();
+ tem = Qnil;
+ }
*orig_inst_list = tem;
}
}
-DEFUN ("check-valid-specifier-matchspec", Fcheck_valid_specifier_matchspec, 2, 2, 0, /*
+DEFUN ("check-valid-specifier-matchspec", Fcheck_valid_specifier_matchspec, 2,
+ 2, 0, /*
Signal an error if MATCHSPEC is invalid for SPECIFIER-TYPE.
See `specifier-matching-instance' for a description of matchspecs.
*/
void
set_specifier_fallback (Lisp_Object specifier, Lisp_Object fallback)
{
- struct Lisp_Specifier *sp = XSPECIFIER (specifier);
+ Lisp_Specifier *sp = XSPECIFIER (specifier);
assert (SPECIFIERP (fallback) ||
!NILP (Fvalid_inst_list_p (fallback, Fspecifier_type (specifier))));
if (SPECIFIERP (fallback))
Lisp_Object depth)
{
/* This function can GC */
- struct Lisp_Specifier *sp;
+ Lisp_Specifier *sp;
Lisp_Object device;
Lisp_Object rest;
int count = specpdl_depth ();
GCPRO2 (specifier, inst_list);
sp = XSPECIFIER (specifier);
- device = DFW_DEVICE (domain);
+ device = DOMAIN_DEVICE (domain);
if (no_quit)
/* The instantiate method is allowed to call eval. Since it
Lisp_Object device = Qnil;
Lisp_Object tag = Qnil;
struct device *d;
- struct Lisp_Specifier *sp;
+ Lisp_Specifier *sp;
sp = XSPECIFIER (specifier);
/* Attempt to determine buffer, window, frame, and device from the
domain. */
- if (WINDOWP (domain))
+ /* #### get image instances out of domains! */
+ if (IMAGE_INSTANCEP (domain))
+ window = DOMAIN_WINDOW (domain);
+ else if (WINDOWP (domain))
window = domain;
else if (FRAMEP (domain))
frame = domain;
else if (DEVICEP (domain))
device = domain;
else
- /* #### dmoore - dammit, this should just signal an error or something
- shouldn't it?
- #### No. Errors are handled in Lisp primitives implementation.
+ /* dmoore writes: [dammit, this should just signal an error or something
+ shouldn't it?]
+
+ No. Errors are handled in Lisp primitives implementation.
Invalid domain is a design error here - kkm. */
abort ();
goto do_fallback;
}
-retry:
+ retry:
/* First see if we can generate one from the window specifiers. */
if (!NILP (window))
CHECK_INSTANCE_ENTRY (window, matchspec, LOCALE_WINDOW);
/* Last and least try the global specifiers. */
CHECK_INSTANCE_ENTRY (Qglobal, matchspec, LOCALE_GLOBAL);
-do_fallback:
+ do_fallback:
/* We're out of specifiers and we still haven't generated an
instance. At least try the fallback ... If this fails,
then we just return Qunbound. */
(specifier, domain, inst_list, default_))
{
Lisp_Object val = Qunbound;
- struct Lisp_Specifier *sp = XSPECIFIER (specifier);
+ Lisp_Specifier *sp = XSPECIFIER (specifier);
struct gcpro gcpro1;
Lisp_Object built_up_list = Qnil;
return UNBOUNDP (val) ? default_ : val;
}
-DEFUN ("specifier-matching-instance-from-inst-list", Fspecifier_matching_instance_from_inst_list,
+DEFUN ("specifier-matching-instance-from-inst-list",
+ Fspecifier_matching_instance_from_inst_list,
4, 5, 0, /*
Attempt to convert a particular inst-list into an instance.
This attempts to instantiate INST-LIST in the given DOMAIN
(specifier, matchspec, domain, inst_list, default_))
{
Lisp_Object val = Qunbound;
- struct Lisp_Specifier *sp = XSPECIFIER (specifier);
+ Lisp_Specifier *sp = XSPECIFIER (specifier);
struct gcpro gcpro1;
Lisp_Object built_up_list = Qnil;
(Lisp_Object specifier, struct frame *f,
Lisp_Object oldval))
{
- struct Lisp_Specifier *sp = XSPECIFIER (specifier);
+ Lisp_Specifier *sp = XSPECIFIER (specifier);
assert (!GHOST_SPECIFIER_P (sp));
if (!sp->caching)
method. */
location = (Lisp_Object *)
((char *) w + XSPECIFIER (specifier)->caching->offset_into_struct_window);
+ /* #### What's the point of this check, other than to optimize image
+ instance instantiation? Unless you specify a caching instantiate
+ method the instantiation that specifier_instance will do will
+ always create a new copy. Thus EQ will always fail. Unfortunately
+ calling equal is no good either as this doesn't take into account
+ things attached to the specifier - for instance strings on
+ extents. --andyp */
if (!EQ (newval, *location))
{
Lisp_Object oldval = *location;
What really needs to be done is to write a function
`make-specifier-type' that creates new specifier types.
- #### I'll look into this for 19.14.
- */
+
+ #### [I'll look into this for 19.14.] Well, sometime. (Currently
+ May 2000, 21.2 is in development. 19.14 was released in June 1996.) */
"A generic specifier is a generalized kind of specifier with user-defined\n"
"semantics. The instantiator can be any kind of Lisp object, and the\n"
DEFUN ("generic-specifier-p", Fgeneric_specifier_p, 1, 1, 0, /*
Return non-nil if OBJECT is a generic specifier.
-A generic specifier allows any kind of Lisp object as an instantiator,
-and returns back the Lisp object unchanged when it is instantiated.
+See `make-generic-specifier' for a description of possible generic
+instantiators.
*/
(object))
{
DEFUN ("integer-specifier-p", Finteger_specifier_p, 1, 1, 0, /*
Return non-nil if OBJECT is an integer specifier.
+
+See `make-integer-specifier' for a description of possible integer
+instantiators.
*/
(object))
{
DEFUN ("natnum-specifier-p", Fnatnum_specifier_p, 1, 1, 0, /*
Return non-nil if OBJECT is a natnum (non-negative-integer) specifier.
+
+See `make-natnum-specifier' for a description of possible natnum
+instantiators.
*/
(object))
{
boolean_validate (Lisp_Object instantiator)
{
if (!EQ (instantiator, Qt) && !EQ (instantiator, Qnil))
- signal_simple_error ("Must be t or nil", instantiator);
+ signal_type_error (Qspecifier_argument_error, "Must be t or nil",
+ instantiator);
}
DEFUN ("boolean-specifier-p", Fboolean_specifier_p, 1, 1, 0, /*
Return non-nil if OBJECT is a boolean specifier.
+
+See `make-boolean-specifier' for a description of possible boolean
+instantiators.
*/
(object))
{
DEFINE_SPECIFIER_TYPE (display_table);
-#define VALID_SINGLE_DISPTABLE_INSTANTIATOR_P(instantiator) \
- (VECTORP (instantiator) \
- || (CHAR_TABLEP (instantiator) \
- && (XCHAR_TABLE_TYPE (instantiator) == CHAR_TABLE_TYPE_CHAR \
- || XCHAR_TABLE_TYPE (instantiator) == CHAR_TABLE_TYPE_GENERIC)) \
+#define VALID_SINGLE_DISPTABLE_INSTANTIATOR_P(instantiator) \
+ (VECTORP (instantiator) \
+ || (CHAR_TABLEP (instantiator) \
+ && (XCHAR_TABLE_TYPE (instantiator) == CHAR_TABLE_TYPE_CHAR \
+ || XCHAR_TABLE_TYPE (instantiator) == CHAR_TABLE_TYPE_GENERIC)) \
|| RANGE_TABLEP (instantiator))
static void
if (!VALID_SINGLE_DISPTABLE_INSTANTIATOR_P (instantiator))
{
lose:
- dead_wrong_type_argument (display_table_specifier_methods->predicate_symbol,
+ dead_wrong_type_argument
+ (display_table_specifier_methods->predicate_symbol,
instantiator);
}
}
DEFUN ("display-table-specifier-p", Fdisplay_table_specifier_p, 1, 1, 0, /*
Return non-nil if OBJECT is a display-table specifier.
+
+See `current-display-table' for a description of possible display-table
+instantiators.
*/
(object))
{
void
syms_of_specifier (void)
{
- defsymbol (&Qspecifierp, "specifierp");
+ INIT_LRECORD_IMPLEMENTATION (specifier);
+
+ DEFSYMBOL (Qspecifierp);
- defsymbol (&Qconsole_type, "console-type");
- defsymbol (&Qdevice_class, "device-class");
+ DEFSYMBOL (Qconsole_type);
+ DEFSYMBOL (Qdevice_class);
- /* Qinteger, Qboolean, Qgeneric defined in general.c */
- defsymbol (&Qnatnum, "natnum");
+ /* specifier types defined in general.c. */
DEFSUBR (Fvalid_specifier_type_p);
DEFSUBR (Fspecifier_type_list);
/* locales are defined in general.c. */
- defsymbol (&Qprepend, "prepend");
- defsymbol (&Qappend, "append");
- defsymbol (&Qremove_tag_set_prepend, "remove-tag-set-prepend");
- defsymbol (&Qremove_tag_set_append, "remove-tag-set-append");
- defsymbol (&Qremove_locale, "remove-locale");
- defsymbol (&Qremove_locale_type, "remove-locale-type");
- defsymbol (&Qremove_all, "remove-all");
+ /* some how-to-add flags in general.c. */
+ DEFSYMBOL (Qremove_tag_set_prepend);
+ DEFSYMBOL (Qremove_tag_set_append);
+ DEFSYMBOL (Qremove_locale);
+ DEFSYMBOL (Qremove_locale_type);
- defsymbol (&Qfallback, "fallback");
+ DEFERROR_STANDARD (Qspecifier_syntax_error, Qsyntax_error);
+ DEFERROR_STANDARD (Qspecifier_argument_error, Qinvalid_argument);
+ DEFERROR_STANDARD (Qspecifier_change_error, Qinvalid_change);
}
void
specifier_type_create (void)
{
the_specifier_type_entry_dynarr = Dynarr_new (specifier_type_entry);
+ dumpstruct (&the_specifier_type_entry_dynarr, &sted_description);
Vspecifier_type_list = Qnil;
staticpro (&Vspecifier_type_list);
SPECIFIER_HAS_METHOD (boolean, validate);
- INITIALIZE_SPECIFIER_TYPE (display_table, "display-table", "display-table-p");
+ INITIALIZE_SPECIFIER_TYPE (display_table, "display-table",
+ "display-table-p");
SPECIFIER_HAS_METHOD (display_table, validate);
}
void
+reinit_specifier_type_create (void)
+{
+ REINITIALIZE_SPECIFIER_TYPE (generic);
+ REINITIALIZE_SPECIFIER_TYPE (integer);
+ REINITIALIZE_SPECIFIER_TYPE (natnum);
+ REINITIALIZE_SPECIFIER_TYPE (boolean);
+ REINITIALIZE_SPECIFIER_TYPE (display_table);
+}
+
+void
vars_of_specifier (void)
{
Vcached_specifiers = Qnil;
/* Do NOT mark through this, or specifiers will never be GC'd.
This is the same deal as for weak hash tables. */
Vall_specifiers = Qnil;
+ pdump_wire_list (&Vall_specifiers);
Vuser_defined_tags = Qnil;
staticpro (&Vuser_defined_tags);
projects / chise / xemacs-chise.git.1 / blobdiff