#include "opaque.h"
#include "specifier.h"
#include "window.h"
-#include "glyphs.h" /* for DISP_TABLE_SIZE definition */
+#include "chartab.h"
+#include "rangetab.h"
Lisp_Object Qspecifierp;
Lisp_Object Qprepend, Qappend, Qremove_tag_set_prepend, Qremove_tag_set_append;
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 o1, Lisp_Object o2, int depth)
+specifier_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
{
- struct Lisp_Specifier *s1 = XSPECIFIER (o1);
- struct Lisp_Specifier *s2 = XSPECIFIER (o2);
+ Lisp_Specifier *s1 = XSPECIFIER (obj1);
+ Lisp_Specifier *s2 = XSPECIFIER (obj2);
int retval;
Lisp_Object old_inhibit_quit = Vinhibit_quit;
internal_equal (s1->fallback, s2->fallback, depth));
if (retval && HAS_SPECMETH_P (s1, equal))
- retval = SPECMETH (s1, equal, (o1, o2, depth - 1));
+ retval = SPECMETH (s1, equal, (obj1, obj2, depth - 1));
Vinhibit_quit = old_inhibit_quit;
return retval;
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,
+ specifier_description,
sizeof_specifier,
- struct Lisp_Specifier);
+ Lisp_Specifier);
\f
/************************************************************************/
/* Creating specifiers */
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;
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'.
+'face-boolean, 'gutter, 'gutter-size, 'gutter-visible 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', `gutter-specifier-p,
+`gutter-size-specifier-p, `gutter-visible-specifier-p and
+`toolbar-specifier-p'.
*/
(type))
{
/* This cannot GC. */
/* The return value of this function must be GCPRO'd. */
if (NILP (locale))
- locale = list1 (Qall);
+ {
+ return list1 (Qall);
+ }
+ else if (CONSP (locale))
+ {
+ Lisp_Object elt;
+ EXTERNAL_LIST_LOOP_2 (elt, locale)
+ check_valid_locale_or_locale_type (elt);
+ return locale;
+ }
else
{
- Lisp_Object rest;
- if (!CONSP (locale))
- locale = list1 (locale);
- EXTERNAL_LIST_LOOP (rest, locale)
- check_valid_locale_or_locale_type (XCAR (rest));
+ check_valid_locale_or_locale_type (locale);
+ return list1 (locale);
}
- return locale;
}
static enum spec_locale_type
{
/* 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;
CHECK_SPECIFIER (specifier);
check_modifiable_specifier (specifier);
-
+
locale = decode_locale (locale);
check_valid_instantiator (instantiator,
decode_specifier_type
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 ();
specific (buffer) to most general (global). If we find an instance,
return it. Otherwise return Qunbound. */
-#define CHECK_INSTANCE_ENTRY(key, matchspec, type) \
-do { \
- Lisp_Object *__inst_list = \
+#define CHECK_INSTANCE_ENTRY(key, matchspec, type) do { \
+ Lisp_Object *CIE_inst_list = \
specifier_get_inst_list (specifier, key, type); \
- if (__inst_list) \
+ if (CIE_inst_list) \
{ \
- Lisp_Object __val__ = \
+ Lisp_Object CIE_val = \
specifier_instance_from_inst_list (specifier, matchspec, \
- domain, *__inst_list, \
+ domain, *CIE_inst_list, \
errb, no_quit, depth); \
- if (!UNBOUNDP (__val__)) \
- return __val__; \
+ if (!UNBOUNDP (CIE_val)) \
+ return CIE_val; \
} \
} while (0)
Lisp_Object device = Qnil;
Lisp_Object tag = Qnil;
struct device *d;
- struct Lisp_Specifier *sp;
+ Lisp_Specifier *sp;
sp = XSPECIFIER (specifier);
goto do_fallback;
}
-try_again:
+ 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. */
then you're fucked, so you better not do this. */
specifier = sp->fallback;
sp = XSPECIFIER (specifier);
- goto try_again;
+ goto retry;
}
assert (CONSP (sp->fallback));
(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;
(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;
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)) \
+ || RANGE_TABLEP (instantiator))
+
static void
display_table_validate (Lisp_Object instantiator)
{
- if (!NILP(instantiator) &&
- (!VECTORP (instantiator) ||
- XVECTOR_LENGTH (instantiator) != DISP_TABLE_SIZE))
- dead_wrong_type_argument (display_table_specifier_methods->predicate_symbol,
- instantiator);
+ if (NILP (instantiator))
+ /* OK */
+ ;
+ else if (CONSP (instantiator))
+ {
+ Lisp_Object tail;
+ EXTERNAL_LIST_LOOP (tail, instantiator)
+ {
+ Lisp_Object car = XCAR (tail);
+ if (!VALID_SINGLE_DISPTABLE_INSTANTIATOR_P (car))
+ goto lose;
+ }
+ }
+ else
+ {
+ if (!VALID_SINGLE_DISPTABLE_INSTANTIATOR_P (instantiator))
+ {
+ lose:
+ dead_wrong_type_argument (display_table_specifier_methods->predicate_symbol,
+ instantiator);
+ }
+ }
}
DEFUN ("display-table-specifier-p", Fdisplay_table_specifier_p, 1, 1, 0, /*
void
syms_of_specifier (void)
{
+ INIT_LRECORD_IMPLEMENTATION (specifier);
+
defsymbol (&Qspecifierp, "specifierp");
defsymbol (&Qconsole_type, "console-type");
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);
}
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;
staticpro (&Vcached_specifiers);
/* Do NOT mark through this, or specifiers will never be GC'd.
- This is the same deal as for weak hashtables. */
+ 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