X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fspecifier.c;h=18ba86d6457cd01796c42b5e14b8b37bdcf06be9;hb=b1e7e6391df535161c6761582e929e80cea67672;hp=5338b03d40ff5b69c05ed79ec63fdb057a90c998;hpb=76759ab036458c54499a454399e19602b8ae6ce3;p=chise%2Fxemacs-chise.git.1 diff --git a/src/specifier.c b/src/specifier.c index 5338b03..18ba86d 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; @@ -68,7 +68,8 @@ 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_STRUCT_PTR, offsetof (specifier_type_entry, meths), 1, + &specifier_methods_description }, { XD_END } }; @@ -353,16 +354,21 @@ specifier_hash (Lisp_Object obj, int depth) 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[] = { @@ -385,14 +391,16 @@ static const struct struct_description specifier_caching_description = { }; 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 } @@ -425,8 +433,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; } @@ -473,8 +481,7 @@ make_specifier_internal (struct specifier_methods *spec_meths, { 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; @@ -546,7 +553,7 @@ 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 @@ -646,7 +653,8 @@ instantiated in. ? 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 @@ -670,7 +678,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, @@ -681,7 +690,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; @@ -699,7 +709,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; } @@ -714,7 +725,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 */ } @@ -729,7 +741,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; @@ -751,7 +762,8 @@ 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); } Lisp_Object @@ -827,7 +839,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; } @@ -890,7 +903,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); } @@ -920,7 +933,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 @@ -931,7 +945,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; } @@ -954,12 +968,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)) { @@ -1032,7 +1047,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. @@ -1088,7 +1104,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 */ @@ -1215,19 +1232,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; } @@ -1270,13 +1290,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; } @@ -1326,7 +1348,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 */ } @@ -1350,7 +1373,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)); } @@ -1762,7 +1786,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; @@ -1963,8 +1990,8 @@ with the function `specifier-spec-list' or `specifier-specs'. } 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) ...) ...) @@ -2370,7 +2397,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. */ @@ -2532,11 +2560,8 @@ specifier_instance (Lisp_Object specifier, Lisp_Object matchspec, 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. */ @@ -2558,17 +2583,16 @@ specifier_instance (Lisp_Object specifier, Lisp_Object matchspec, 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) @@ -2758,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 @@ -2811,7 +2836,8 @@ set_specifier_caching (Lisp_Object specifier, int struct_window_offset, 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)); @@ -2822,6 +2848,7 @@ set_specifier_caching (Lisp_Object specifier, int struct_window_offset, 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; @@ -2833,7 +2860,7 @@ recompute_one_cached_specifier_in_window (Lisp_Object specifier, struct window *w) { Lisp_Object window; - Lisp_Object newval, *location; + Lisp_Object newval, *location, oldval; assert (!GHOST_SPECIFIER_P (XSPECIFIER (specifier))); @@ -2854,9 +2881,9 @@ recompute_one_cached_specifier_in_window (Lisp_Object 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); @@ -2868,7 +2895,7 @@ recompute_one_cached_specifier_in_frame (Lisp_Object specifier, struct frame *f) { Lisp_Object frame; - Lisp_Object newval, *location; + Lisp_Object newval, *location, oldval; assert (!GHOST_SPECIFIER_P (XSPECIFIER (specifier))); @@ -2882,9 +2909,9 @@ recompute_one_cached_specifier_in_frame (Lisp_Object 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); @@ -3092,7 +3119,8 @@ 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, /* @@ -3140,7 +3168,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); } } @@ -3167,13 +3196,12 @@ syms_of_specifier (void) { 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); @@ -3228,22 +3256,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); + dump_add_root_struct_ptr (&the_specifier_type_entry_dynarr, &sted_description); Vspecifier_type_list = Qnil; staticpro (&Vspecifier_type_list); @@ -3262,7 +3290,8 @@ 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); } @@ -3286,7 +3315,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); + dump_add_weak_object_chain (&Vall_specifiers); Vuser_defined_tags = Qnil; staticpro (&Vuser_defined_tags);