X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Fspecifier.c;h=7fa2e3a6f02db189eafdee77be2a832202571180;hp=d1da5f5ac1724c872e3f238bf93fb53aa8c256d5;hb=59eec5f21669e81977b5b1fe9bf717cab49cf7fb;hpb=976b002b16336930724ae22476014583ad022e7d diff --git a/src/specifier.c b/src/specifier.c index d1da5f5..7fa2e3a 100644 --- a/src/specifier.c +++ b/src/specifier.c @@ -41,15 +41,15 @@ Boston, MA 02111-1307, USA. */ #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; @@ -64,7 +64,29 @@ typedef struct 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; @@ -141,7 +163,7 @@ cleanup_specifiers (void) !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 @@ -168,7 +190,7 @@ kill_specifier_buffer_locals (Lisp_Object buffer) !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 @@ -180,19 +202,19 @@ kill_specifier_buffer_locals (Lisp_Object buffer) } 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; } @@ -216,24 +238,24 @@ mark_specifier (Lisp_Object obj, void (*markobj) (Lisp_Object)) */ 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; @@ -246,7 +268,7 @@ prune_specifiers (int (*obj_marked_p) (Lisp_Object)) 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; @@ -278,9 +300,9 @@ print_specifier (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 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; @@ -290,8 +312,8 @@ finalize_specifier (void *header, int for_disksave) 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; @@ -319,7 +341,7 @@ specifier_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 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 @@ -333,23 +355,63 @@ specifier_hash (Lisp_Object obj, int depth) } 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); /************************************************************************/ /* Creating specifiers */ @@ -366,8 +428,8 @@ decode_specifier_type (Lisp_Object type, Error_behavior errb) 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; } @@ -413,9 +475,9 @@ make_specifier_internal (struct specifier_methods *spec_meths, 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; @@ -473,29 +535,52 @@ Return a new specifier object of type TYPE. 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); } @@ -548,19 +633,24 @@ Valid locales are devices, frames, windows, buffers, and 'global. 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 @@ -584,7 +674,8 @@ check_valid_locale_or_locale_type (Lisp_Object 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, @@ -595,7 +686,8 @@ Given a specifier LOCALE, return its type. { /* 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; @@ -613,7 +705,8 @@ decode_locale (Lisp_Object locale) 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; } @@ -628,7 +721,8 @@ decode_locale_type (Lisp_Object locale_type) 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 */ } @@ -643,7 +737,6 @@ decode_locale_list (Lisp_Object locale) } else if (CONSP (locale)) { - Lisp_Object elt; EXTERNAL_LIST_LOOP_2 (elt, locale) check_valid_locale_or_locale_type (elt); return locale; @@ -665,10 +758,11 @@ static void 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)) @@ -741,7 +835,8 @@ decode_specifier_tag_set (Lisp_Object tag_set) 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; } @@ -804,7 +899,7 @@ sorting by symbol name and removing duplicates.) (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); } @@ -834,7 +929,8 @@ device_matches_specifier_tag_set_p (Lisp_Object device, Lisp_Object 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 @@ -845,7 +941,7 @@ specifies which devices match it.) 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; } @@ -868,12 +964,13 @@ and classes) or the symbols nil, t, 'all, or 'global. 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)) { @@ -946,7 +1043,8 @@ setup_device_initial_specifier_tags (struct device *d) } } -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. @@ -1002,7 +1100,8 @@ Return the predicate for the given specifier tag. 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 */ @@ -1129,19 +1228,22 @@ check_valid_inst_list (Lisp_Object inst_list, struct specifier_methods *meths, 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; } @@ -1184,13 +1286,15 @@ check_valid_spec_list (Lisp_Object spec_list, struct specifier_methods *meths, 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; } @@ -1240,7 +1344,8 @@ decode_how_to_add_specification (Lisp_Object how_to_add) 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 */ } @@ -1264,7 +1369,8 @@ check_modifiable_specifier (Lisp_Object spec) { 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)); } @@ -1587,17 +1693,23 @@ build_up_processed_list (Lisp_Object specifier, Lisp_Object locale, { /* 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) ? @@ -1638,7 +1750,7 @@ static void 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; @@ -1670,7 +1782,10 @@ specifier_add_spec (Lisp_Object specifier, Lisp_Object locale, else if (add_meth == SPEC_APPEND) tem = nconc2 (*orig_inst_list, list_to_build_up); else - abort (); + { + abort (); + tem = Qnil; + } *orig_inst_list = tem; @@ -2278,7 +2393,8 @@ check_valid_specifier_matchspec (Lisp_Object matchspec, } } -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. */ @@ -2309,7 +2425,7 @@ 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)) @@ -2359,7 +2475,7 @@ specifier_instance_from_inst_list (Lisp_Object specifier, Lisp_Object depth) { /* This function can GC */ - struct Lisp_Specifier *sp; + Lisp_Specifier *sp; Lisp_Object device; Lisp_Object rest; int count = specpdl_depth (); @@ -2368,7 +2484,7 @@ specifier_instance_from_inst_list (Lisp_Object specifier, 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 @@ -2442,22 +2558,26 @@ specifier_instance (Lisp_Object specifier, Lisp_Object matchspec, 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 (); @@ -2485,7 +2605,7 @@ specifier_instance (Lisp_Object specifier, Lisp_Object matchspec, 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); @@ -2504,7 +2624,7 @@ retry: /* 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. */ @@ -2645,7 +2765,7 @@ you should not use this function; use `specifier-instance' instead. (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; @@ -2662,7 +2782,8 @@ you should not use this function; use `specifier-instance' instead. 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 @@ -2677,7 +2798,7 @@ works. (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; @@ -2717,7 +2838,7 @@ set_specifier_caching (Lisp_Object specifier, int struct_window_offset, (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) @@ -2751,6 +2872,13 @@ recompute_one_cached_specifier_in_window (Lisp_Object specifier, 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; @@ -2885,8 +3013,9 @@ DEFINE_SPECIFIER_TYPE (generic); 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" @@ -2923,8 +3052,8 @@ DEFINE_SPECIFIER_TYPE (generic); 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)) { @@ -2946,6 +3075,9 @@ integer_validate (Lisp_Object instantiator) 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)) { @@ -2966,6 +3098,9 @@ natnum_validate (Lisp_Object instantiator) 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)) { @@ -2982,11 +3117,15 @@ static void 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)) { @@ -2999,11 +3138,11 @@ Return non-nil if OBJECT is a boolean specifier. 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 @@ -3027,7 +3166,8 @@ display_table_validate (Lisp_Object instantiator) 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); } } @@ -3035,6 +3175,9 @@ display_table_validate (Lisp_Object 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)) { @@ -3049,13 +3192,14 @@ Return non-nil if OBJECT is a display-table specifier. 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); @@ -3110,21 +3254,22 @@ syms_of_specifier (void) /* 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); @@ -3143,12 +3288,23 @@ specifier_type_create (void) 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; @@ -3157,6 +3313,7 @@ vars_of_specifier (void) /* 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);