#include "rangetab.h"
Lisp_Object Qspecifierp;
-Lisp_Object Qprepend, 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;
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_STRUCT_PTR, offsetof (specifier_type_entry, meths), 1,
+ &specifier_methods_description },
{ XD_END }
};
};
static const struct lrecord_description specifier_description[] = {
- { XD_STRUCT_PTR, offsetof (Lisp_Specifier, methods), 1, &specifier_methods_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_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 }
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;
}
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
? 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);
}
Lisp_Object
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));
}
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 ("add-spec-list-to-specifier", Fadd_spec_list_to_specifier, 2, 3, 0, /*
-Add a spec-list (a list of specifications) to SPECIFIER.
-The format of a spec-list is
+Add SPEC-LIST (a list of specifications) to SPECIFIER.
+The format of SPEC-LIST is
((LOCALE (TAG-SET . INSTANTIATOR) ...) ...)
}
}
-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.
*/
Lisp_Object window = Qnil;
Lisp_Object frame = Qnil;
Lisp_Object device = Qnil;
- Lisp_Object tag = Qnil;
- struct device *d;
- Lisp_Specifier *sp;
-
- sp = XSPECIFIER (specifier);
+ Lisp_Object tag = Qnil; /* #### currently unused */
+ Lisp_Specifier *sp = XSPECIFIER (specifier);
/* Attempt to determine buffer, window, frame, and device from the
domain. */
abort ();
if (NILP (buffer) && !NILP (window))
- buffer = XWINDOW (window)->buffer;
+ buffer = WINDOW_BUFFER (XWINDOW (window));
if (NILP (frame) && !NILP (window))
frame = XWINDOW (window)->frame;
if (NILP (device))
/* frame had better exist; if device is undeterminable, something
really went wrong. */
- device = XFRAME (frame)->device;
+ device = FRAME_DEVICE (XFRAME (frame));
/* device had better be determined by now; abort if not. */
- d = XDEVICE (device);
- tag = DEVICE_CLASS (d);
+ tag = DEVICE_CLASS (XDEVICE (device));
depth = make_int (1 + XINT (depth));
if (XINT (depth) > 20)
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
int struct_frame_offset,
void (*value_changed_in_frame)
(Lisp_Object specifier, struct frame *f,
- Lisp_Object oldval))
+ Lisp_Object oldval),
+ int always_recompute)
{
Lisp_Specifier *sp = XSPECIFIER (specifier);
assert (!GHOST_SPECIFIER_P (sp));
sp->caching->value_changed_in_window = value_changed_in_window;
sp->caching->offset_into_struct_frame = struct_frame_offset;
sp->caching->value_changed_in_frame = value_changed_in_frame;
+ sp->caching->always_recompute = always_recompute;
Vcached_specifiers = Fcons (specifier, Vcached_specifiers);
if (BODILY_SPECIFIER_P (sp))
GHOST_SPECIFIER(sp)->caching = sp->caching;
struct window *w)
{
Lisp_Object window;
- Lisp_Object newval, *location;
+ Lisp_Object newval, *location, oldval;
assert (!GHOST_SPECIFIER_P (XSPECIFIER (specifier)));
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))
+ if (!EQ (newval, *location) || XSPECIFIER (specifier)->caching->always_recompute)
{
- Lisp_Object oldval = *location;
+ oldval = *location;
*location = newval;
(XSPECIFIER (specifier)->caching->value_changed_in_window)
(specifier, w, oldval);
struct frame *f)
{
Lisp_Object frame;
- Lisp_Object newval, *location;
+ Lisp_Object newval, *location, oldval;
assert (!GHOST_SPECIFIER_P (XSPECIFIER (specifier)));
method. */
location = (Lisp_Object *)
((char *) f + XSPECIFIER (specifier)->caching->offset_into_struct_frame);
- if (!EQ (newval, *location))
+ if (!EQ (newval, *location) || XSPECIFIER (specifier)->caching->always_recompute)
{
- Lisp_Object oldval = *location;
+ oldval = *location;
*location = newval;
(XSPECIFIER (specifier)->caching->value_changed_in_frame)
(specifier, f, oldval);
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, /*
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);
}
}
{
INIT_LRECORD_IMPLEMENTATION (specifier);
- defsymbol (&Qspecifierp, "specifierp");
+ 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 (&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);
+ dump_add_root_struct_ptr (&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);
}
/* 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);
+ dump_add_weak_object_chain (&Vall_specifiers);
Vuser_defined_tags = Qnil;
staticpro (&Vuser_defined_tags);