Mercurial > hg > xemacs-beta
comparison src/specifier.c @ 185:3d6bfa290dbd r20-3b19
Import from CVS: tag r20-3b19
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:55:28 +0200 |
parents | 2d532a89d707 |
children | c5d627a313b1 |
comparison
equal
deleted
inserted
replaced
184:bcd2674570bf | 185:3d6bfa290dbd |
---|---|
50 Lisp_Object Vuser_defined_tags; | 50 Lisp_Object Vuser_defined_tags; |
51 | 51 |
52 MAC_DEFINE (struct Lisp_Specifier *, MTspecmeth_or_given) | 52 MAC_DEFINE (struct Lisp_Specifier *, MTspecmeth_or_given) |
53 MAC_DEFINE (struct Lisp_Specifier *, MTspecifier_data) | 53 MAC_DEFINE (struct Lisp_Specifier *, MTspecifier_data) |
54 | 54 |
55 typedef struct specifier_type_entry specifier_type_entry; | |
55 struct specifier_type_entry | 56 struct specifier_type_entry |
56 { | 57 { |
57 Lisp_Object symbol; | 58 Lisp_Object symbol; |
58 struct specifier_methods *meths; | 59 struct specifier_methods *meths; |
59 }; | 60 }; |
60 | 61 |
61 typedef struct specifier_type_entry_dynarr_type | 62 typedef struct |
62 { | 63 { |
63 Dynarr_declare (struct specifier_type_entry); | 64 Dynarr_declare (specifier_type_entry); |
64 } specifier_type_entry_dynarr; | 65 } specifier_type_entry_dynarr; |
65 | 66 |
66 specifier_type_entry_dynarr *the_specifier_type_entry_dynarr; | 67 specifier_type_entry_dynarr *the_specifier_type_entry_dynarr; |
67 | 68 |
68 Lisp_Object Vspecifier_type_list; | 69 Lisp_Object Vspecifier_type_list; |
74 /* #### The purpose of this is to check for inheritance loops | 75 /* #### The purpose of this is to check for inheritance loops |
75 in specifiers that can inherit from other specifiers, but it's | 76 in specifiers that can inherit from other specifiers, but it's |
76 not yet implemented. | 77 not yet implemented. |
77 | 78 |
78 #### Look into this for 19.14. */ | 79 #### Look into this for 19.14. */ |
79 lisp_dynarr current_specifiers; | 80 Lisp_Object_dynarr current_specifiers; |
80 | 81 |
81 static void recompute_cached_specifier_everywhere (Lisp_Object specifier); | 82 static void recompute_cached_specifier_everywhere (Lisp_Object specifier); |
82 | 83 |
83 | 84 |
84 /************************************************************************/ | 85 /************************************************************************/ |
399 } | 400 } |
400 | 401 |
401 static Lisp_Object | 402 static Lisp_Object |
402 make_specifier (struct specifier_methods *spec_meths) | 403 make_specifier (struct specifier_methods *spec_meths) |
403 { | 404 { |
404 struct Lisp_Specifier *sp; | |
405 Lisp_Object specifier = Qnil; | 405 Lisp_Object specifier = Qnil; |
406 struct gcpro gcpro1; | 406 struct gcpro gcpro1; |
407 | 407 struct Lisp_Specifier *sp = (struct Lisp_Specifier *) |
408 sp = alloc_lcrecord (sizeof (struct Lisp_Specifier) + | 408 alloc_lcrecord (sizeof (struct Lisp_Specifier) + |
409 spec_meths->extra_data_size - 1, lrecord_specifier); | 409 spec_meths->extra_data_size - 1, lrecord_specifier); |
410 | 410 |
411 sp->methods = spec_meths; | 411 sp->methods = spec_meths; |
412 sp->global_specs = Qnil; | 412 sp->global_specs = Qnil; |
413 sp->device_specs = Qnil; | 413 sp->device_specs = Qnil; |
414 sp->frame_specs = Qnil; | 414 sp->frame_specs = Qnil; |
670 added by a particular package so that they can be later removed. | 670 added by a particular package so that they can be later removed. |
671 | 671 |
672 A specifier tag set consists of a list of zero of more specifier tags, | 672 A specifier tag set consists of a list of zero of more specifier tags, |
673 each of which is a symbol that is recognized by XEmacs as a tag. | 673 each of which is a symbol that is recognized by XEmacs as a tag. |
674 (The valid device types and device classes are always tags, as are | 674 (The valid device types and device classes are always tags, as are |
675 any tags defined by `define-specifier-tag'.) It is called a \"tag set\" | 675 any tags defined by `define-specifier-tag'.) It is called a "tag set" |
676 (as opposed to a list) because the order of the tags or the number of | 676 (as opposed to a list) because the order of the tags or the number of |
677 times a particular tag occurs does not matter. | 677 times a particular tag occurs does not matter. |
678 | 678 |
679 Each tag has a predicate associated with it, which specifies whether | 679 Each tag has a predicate associated with it, which specifies whether |
680 that tag applies to a particular device. The tags which are device types | 680 that tag applies to a particular device. The tags which are device types |
725 | 725 |
726 if (len == 0 || len == 1) | 726 if (len == 0 || len == 1) |
727 /* most common case */ | 727 /* most common case */ |
728 return tag_set; | 728 return tag_set; |
729 | 729 |
730 tags = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); | 730 tags = alloca_array (Lisp_Object, len); |
731 | 731 |
732 i = 0; | 732 i = 0; |
733 LIST_LOOP (rest, tag_set) | 733 LIST_LOOP (rest, tag_set) |
734 tags[i++] = XCAR (rest); | 734 tags[i++] = XCAR (rest); |
735 | 735 |
1183 } | 1183 } |
1184 | 1184 |
1185 enum spec_add_meth | 1185 enum spec_add_meth |
1186 decode_how_to_add_specification (Lisp_Object how_to_add) | 1186 decode_how_to_add_specification (Lisp_Object how_to_add) |
1187 { | 1187 { |
1188 enum spec_add_meth add_meth = 0; | |
1189 | |
1190 if (NILP (how_to_add) || EQ (Qremove_tag_set_prepend, how_to_add)) | 1188 if (NILP (how_to_add) || EQ (Qremove_tag_set_prepend, how_to_add)) |
1191 add_meth = SPEC_REMOVE_TAG_SET_PREPEND; | 1189 return SPEC_REMOVE_TAG_SET_PREPEND; |
1192 else if (EQ (Qremove_tag_set_append, how_to_add)) | 1190 if (EQ (Qremove_tag_set_append, how_to_add)) |
1193 add_meth = SPEC_REMOVE_TAG_SET_APPEND; | 1191 return SPEC_REMOVE_TAG_SET_APPEND; |
1194 else if (EQ (Qappend, how_to_add)) | 1192 if (EQ (Qappend, how_to_add)) |
1195 add_meth = SPEC_APPEND; | 1193 return SPEC_APPEND; |
1196 else if (EQ (Qprepend, how_to_add)) | 1194 if (EQ (Qprepend, how_to_add)) |
1197 add_meth = SPEC_PREPEND; | 1195 return SPEC_PREPEND; |
1198 else if (EQ (Qremove_locale, how_to_add)) | 1196 if (EQ (Qremove_locale, how_to_add)) |
1199 add_meth = SPEC_REMOVE_LOCALE; | 1197 return SPEC_REMOVE_LOCALE; |
1200 else if (EQ (Qremove_locale_type, how_to_add)) | 1198 if (EQ (Qremove_locale_type, how_to_add)) |
1201 add_meth = SPEC_REMOVE_LOCALE_TYPE; | 1199 return SPEC_REMOVE_LOCALE_TYPE; |
1202 else if (EQ (Qremove_all, how_to_add)) | 1200 if (EQ (Qremove_all, how_to_add)) |
1203 add_meth = SPEC_REMOVE_ALL; | 1201 return SPEC_REMOVE_ALL; |
1204 else | 1202 |
1205 signal_simple_error ("Invalid `how-to-add' flag", how_to_add); | 1203 signal_simple_error ("Invalid `how-to-add' flag", how_to_add); |
1206 return add_meth; | 1204 |
1205 return SPEC_PREPEND; /* not reached */ | |
1207 } | 1206 } |
1208 | 1207 |
1209 /* This gets hit so much that the function call overhead had a | 1208 /* This gets hit so much that the function call overhead had a |
1210 measurable impact (according to Quantify). #### We should figure | 1209 measurable impact (according to Quantify). #### We should figure |
1211 out the frequency with which this is called with the various types | 1210 out the frequency with which this is called with the various types |
1212 and reorder the check accordingly. */ | 1211 and reorder the check accordingly. */ |
1213 #define SPECIFIER_GET_SPEC_LIST(specifier, type) \ | 1212 #define SPECIFIER_GET_SPEC_LIST(specifier, type) \ |
1214 (type == LOCALE_GLOBAL \ | 1213 (type == LOCALE_GLOBAL ? &(XSPECIFIER (specifier)->global_specs) : \ |
1215 ? &(XSPECIFIER (specifier)->global_specs) \ | 1214 type == LOCALE_DEVICE ? &(XSPECIFIER (specifier)->device_specs) : \ |
1216 : (type == LOCALE_DEVICE \ | 1215 type == LOCALE_FRAME ? &(XSPECIFIER (specifier)->frame_specs) : \ |
1217 ? &(XSPECIFIER (specifier)->device_specs) \ | 1216 type == LOCALE_WINDOW ? &(XWEAK_LIST_LIST \ |
1218 : (type == LOCALE_FRAME \ | 1217 (XSPECIFIER (specifier)->window_specs)) : \ |
1219 ? &(XSPECIFIER (specifier)->frame_specs) \ | 1218 type == LOCALE_BUFFER ? &(XSPECIFIER (specifier)->buffer_specs) : \ |
1220 : (type == LOCALE_WINDOW \ | 1219 0) |
1221 ? &(XWEAK_LIST_LIST (XSPECIFIER (specifier)->window_specs)) \ | |
1222 : (type == LOCALE_BUFFER \ | |
1223 ? &(XSPECIFIER (specifier)->buffer_specs) \ | |
1224 : 0))))) | |
1225 | 1220 |
1226 static Lisp_Object * | 1221 static Lisp_Object * |
1227 specifier_get_inst_list (Lisp_Object specifier, Lisp_Object locale, | 1222 specifier_get_inst_list (Lisp_Object specifier, Lisp_Object locale, |
1228 enum spec_locale_type type) | 1223 enum spec_locale_type type) |
1229 { | 1224 { |
1744 'append Add to the end of the current list of | 1739 'append Add to the end of the current list of |
1745 instantiators for LOCALE. | 1740 instantiators for LOCALE. |
1746 'remove-tag-set-prepend (this is the default) | 1741 'remove-tag-set-prepend (this is the default) |
1747 Remove any existing instantiators whose tag set is | 1742 Remove any existing instantiators whose tag set is |
1748 the same as TAG-SET; then put the new instantiator | 1743 the same as TAG-SET; then put the new instantiator |
1749 at the beginning of the current list. (\"Same tag | 1744 at the beginning of the current list. ("Same tag |
1750 set\" means that they contain the same elements. | 1745 set" means that they contain the same elements. |
1751 The order may be different.) | 1746 The order may be different.) |
1752 'remove-tag-set-append | 1747 'remove-tag-set-append |
1753 Remove any existing instantiators whose tag set is | 1748 Remove any existing instantiators whose tag set is |
1754 the same as TAG-SET; then put the new instantiator | 1749 the same as TAG-SET; then put the new instantiator |
1755 at the end of the current list. | 1750 at the end of the current list. |
1936 | 1931 |
1937 DEFUN ("specifier-specs", Fspecifier_specs, 1, 4, 0, /* | 1932 DEFUN ("specifier-specs", Fspecifier_specs, 1, 4, 0, /* |
1938 Return the specification(s) for SPECIFIER in LOCALE. | 1933 Return the specification(s) for SPECIFIER in LOCALE. |
1939 | 1934 |
1940 If LOCALE is a single locale or is a list of one element containing a | 1935 If LOCALE is a single locale or is a list of one element containing a |
1941 single locale, then a \"short form\" of the instantiators for that locale | 1936 single locale, then a "short form" of the instantiators for that locale |
1942 will be returned. Otherwise, this function is identical to | 1937 will be returned. Otherwise, this function is identical to |
1943 `specifier-spec-list'. | 1938 `specifier-spec-list'. |
1944 | 1939 |
1945 The \"short form\" is designed for readability and not for ease of use | 1940 The "short form" is designed for readability and not for ease of use |
1946 in Lisp programs, and is as follows: | 1941 in Lisp programs, and is as follows: |
1947 | 1942 |
1948 1. If there is only one instantiator, then an inst-pair (i.e. cons of | 1943 1. If there is only one instantiator, then an inst-pair (i.e. cons of |
1949 tag and instantiator) will be returned; otherwise a list of | 1944 tag and instantiator) will be returned; otherwise a list of |
1950 inst-pairs will be returned. | 1945 inst-pairs will be returned. |
2434 as a locale (e.g. a buffer) are not valid as a domain because they do not | 2429 as a locale (e.g. a buffer) are not valid as a domain because they do not |
2435 provide enough information to identify a particular device (see | 2430 provide enough information to identify a particular device (see |
2436 `valid-specifier-domain-p'). DOMAIN defaults to the selected window | 2431 `valid-specifier-domain-p'). DOMAIN defaults to the selected window |
2437 if omitted. | 2432 if omitted. |
2438 | 2433 |
2439 \"Instantiating\" a specifier in a particular domain means determining | 2434 "Instantiating" a specifier in a particular domain means determining |
2440 the specifier's \"value\" in that domain. This is accomplished by | 2435 the specifier's "value" in that domain. This is accomplished by |
2441 searching through the specifications in the specifier that correspond | 2436 searching through the specifications in the specifier that correspond |
2442 to all locales that can be derived from the given domain, from specific | 2437 to all locales that can be derived from the given domain, from specific |
2443 to general. In most cases, the domain is an Emacs window. In that case | 2438 to general. In most cases, the domain is an Emacs window. In that case |
2444 specifications are searched for as follows: | 2439 specifications are searched for as follows: |
2445 | 2440 |
2489 Return an instance for SPECIFIER in DOMAIN that matches MATCHSPEC. | 2484 Return an instance for SPECIFIER in DOMAIN that matches MATCHSPEC. |
2490 If no instance can be generated for this domain, return DEFAULT. | 2485 If no instance can be generated for this domain, return DEFAULT. |
2491 | 2486 |
2492 This function is identical to `specifier-instance' except that a | 2487 This function is identical to `specifier-instance' except that a |
2493 specification will only be considered if it matches MATCHSPEC. | 2488 specification will only be considered if it matches MATCHSPEC. |
2494 The definition of \"match\", and allowed values for MATCHSPEC, are | 2489 The definition of "match", and allowed values for MATCHSPEC, are |
2495 dependent on the particular type of specifier. Here are some examples: | 2490 dependent on the particular type of specifier. Here are some examples: |
2496 | 2491 |
2497 -- For chartable (e.g. display table) specifiers, MATCHSPEC should be a | 2492 -- For chartable (e.g. display table) specifiers, MATCHSPEC should be a |
2498 character, and the specification (a chartable) must give a value for | 2493 character, and the specification (a chartable) must give a value for |
2499 that character in order to be considered. This allows you to specify, | 2494 that character in order to be considered. This allows you to specify, |
2606 Lisp_Object oldval)) | 2601 Lisp_Object oldval)) |
2607 { | 2602 { |
2608 struct Lisp_Specifier *sp = XSPECIFIER (specifier); | 2603 struct Lisp_Specifier *sp = XSPECIFIER (specifier); |
2609 | 2604 |
2610 if (!sp->caching) | 2605 if (!sp->caching) |
2611 sp->caching = malloc_type_and_zero (struct specifier_caching); | 2606 sp->caching = xnew_and_zero (struct specifier_caching); |
2612 sp->caching->offset_into_struct_window = struct_window_offset; | 2607 sp->caching->offset_into_struct_window = struct_window_offset; |
2613 sp->caching->value_changed_in_window = value_changed_in_window; | 2608 sp->caching->value_changed_in_window = value_changed_in_window; |
2614 sp->caching->offset_into_struct_frame = struct_frame_offset; | 2609 sp->caching->offset_into_struct_frame = struct_frame_offset; |
2615 sp->caching->value_changed_in_frame = value_changed_in_frame; | 2610 sp->caching->value_changed_in_frame = value_changed_in_frame; |
2616 Vcached_specifiers = Fcons (specifier, Vcached_specifiers); | 2611 Vcached_specifiers = Fcons (specifier, Vcached_specifiers); |
2977 } | 2972 } |
2978 | 2973 |
2979 void | 2974 void |
2980 specifier_type_create (void) | 2975 specifier_type_create (void) |
2981 { | 2976 { |
2982 the_specifier_type_entry_dynarr = Dynarr_new (struct specifier_type_entry); | 2977 the_specifier_type_entry_dynarr = Dynarr_new (specifier_type_entry); |
2983 | 2978 |
2984 Vspecifier_type_list = Qnil; | 2979 Vspecifier_type_list = Qnil; |
2985 staticpro (&Vspecifier_type_list); | 2980 staticpro (&Vspecifier_type_list); |
2986 | 2981 |
2987 INITIALIZE_SPECIFIER_TYPE (generic, "generic", "generic-specifier-p"); | 2982 INITIALIZE_SPECIFIER_TYPE (generic, "generic", "generic-specifier-p"); |