#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;
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 }
};
internal_hash (s->buffer_specs, depth + 1));
}
+inline static size_t
+aligned_sizeof_specifier (size_t specifier_type_specific_size)
+{
+ return ALIGN_SIZE (offsetof (Lisp_Specifier, data)
+ + specifier_type_specific_size,
+ ALIGNOF (max_align_t));
+}
+
static size_t
sizeof_specifier (const void *header)
{
- if (GHOST_SPECIFIER_P ((Lisp_Specifier *) header))
- return offsetof (Lisp_Specifier, data);
- else
- {
- const Lisp_Specifier *p = (const Lisp_Specifier *) header;
- return offsetof (Lisp_Specifier, data) + p->methods->extra_data_size;
- }
+ const Lisp_Specifier *p = (const Lisp_Specifier *) header;
+ return aligned_sizeof_specifier (GHOST_SPECIFIER_P (p)
+ ? 0
+ : p->methods->extra_data_size);
}
static const struct lrecord_description specifier_methods_description_1[] = {
};
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;
}
DEFUN ("valid-specifier-type-p", Fvalid_specifier_type_p, 1, 1, 0, /*
Given a SPECIFIER-TYPE, return non-nil if it is valid.
-Valid types are 'generic, 'integer, boolean, 'color, 'font, 'image,
+Valid types are 'generic, 'integer, 'boolean, 'color, 'font, 'image,
'face-boolean, and 'toolbar.
*/
(specifier_type))
{
Lisp_Object specifier;
Lisp_Specifier *sp = (Lisp_Specifier *)
- alloc_lcrecord (offsetof (Lisp_Specifier, data) + data_size,
- &lrecord_specifier);
+ alloc_lcrecord (aligned_sizeof_specifier (data_size), &lrecord_specifier);
sp->methods = spec_meths;
sp->global_specs = Qnil;
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.
*/
/* The instantiate method is allowed to call eval. Since it
is quite common for this function to get called from somewhere in
redisplay we need to make sure that quits are ignored. Otherwise
- Fsignal will abort. */
+ Fsignal will ABORT. */
specbind (Qinhibit_quit, Qt);
LIST_LOOP (rest, inst_list)
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. */
No. Errors are handled in Lisp primitives implementation.
Invalid domain is a design error here - kkm. */
- abort ();
+ 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);
+ /* device had better be determined by now; ABORT if not. */
+ 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 (&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);
+ 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);
projects / chise / xemacs-chise.git.1 / blobdiff