Mercurial > hg > xemacs-beta

comparison src/specifier.c @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents ee648375d8d6
children 54cc21c15cbb
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
72 72
73 /* #### The purpose of this is to check for inheritance loops 73 /* #### The purpose of this is to check for inheritance loops
74 in specifiers that can inherit from other specifiers, but it's 74 in specifiers that can inherit from other specifiers, but it's
75 not yet implemented. 75 not yet implemented.
76 76
77 #### Look into this some day. */ 77 #### Look into this for 19.14. */
78 lisp_dynarr current_specifiers; 78 lisp_dynarr current_specifiers;
79 79
80 static void recompute_cached_specifier_everywhere (Lisp_Object specifier); 80 static void recompute_cached_specifier_everywhere (Lisp_Object specifier);
81 81
82 82
511 Return non-nil if DOMAIN is a valid specifier domain. 511 Return non-nil if DOMAIN is a valid specifier domain.
512 A domain is used to instance a specifier (i.e. determine the specifier's 512 A domain is used to instance a specifier (i.e. determine the specifier's
513 value in that domain). Valid domains are a window, frame, or device. 513 value in that domain). Valid domains are a window, frame, or device.
514 (nil is not valid.) 514 (nil is not valid.)
515 */ 515 */
516 (domain)) 516 (domain))
517 { 517 {
518 /* This cannot GC. */ 518 /* This cannot GC. */
519 if ((DEVICEP (domain) && DEVICE_LIVE_P (XDEVICE (domain))) || 519 if ((DEVICEP (domain) && DEVICE_LIVE_P (XDEVICE (domain))) ||
520 (FRAMEP (domain) && FRAME_LIVE_P (XFRAME (domain))) || 520 (FRAMEP (domain) && FRAME_LIVE_P (XFRAME (domain))) ||
521 (WINDOWP (domain) && WINDOW_LIVE_P (XWINDOW (domain)))) 521 (WINDOWP (domain) && WINDOW_LIVE_P (XWINDOW (domain))))
528 Given a specifier LOCALE-TYPE, return non-nil if it is valid. 528 Given a specifier LOCALE-TYPE, return non-nil if it is valid.
529 Valid locale types are 'global, 'device, 'frame, 'window, and 'buffer. 529 Valid locale types are 'global, 'device, 'frame, 'window, and 'buffer.
530 (Note, however, that in functions that accept either a locale or a locale 530 (Note, however, that in functions that accept either a locale or a locale
531 type, 'global is considered an individual locale.) 531 type, 'global is considered an individual locale.)
532 */ 532 */
533 (locale_type)) 533 (locale_type))
534 { 534 {
535 /* This cannot GC. */ 535 /* This cannot GC. */
536 if (EQ (locale_type, Qglobal) || 536 if (EQ (locale_type, Qglobal) ||
537 EQ (locale_type, Qdevice) || 537 EQ (locale_type, Qdevice) ||
538 EQ (locale_type, Qframe) || 538 EQ (locale_type, Qframe) ||
684 all tags in the tag set attached to that instantiator. 684 all tags in the tag set attached to that instantiator.
685 685
686 Most of the time, a tag set is not specified, and the instantiator 686 Most of the time, a tag set is not specified, and the instantiator
687 gets a null tag set, which matches all devices. 687 gets a null tag set, which matches all devices.
688 */ 688 */
689 (tag_set)) 689 (tag_set))
690 { 690 {
691 Lisp_Object rest; 691 Lisp_Object rest;
692 692
693 for (rest = tag_set; !NILP (rest); rest = XCDR (rest)) 693 for (rest = tag_set; !NILP (rest); rest = XCDR (rest))
694 { 694 {
1046 Lisp_Object opaque = make_opaque_ptr ((void *) 1046 Lisp_Object opaque = make_opaque_ptr ((void *)
1047 meths->validate_method); 1047 meths->validate_method);
1048 struct gcpro gcpro1; 1048 struct gcpro gcpro1;
1049 1049
1050 GCPRO1 (opaque); 1050 GCPRO1 (opaque);
1051 retval = call_with_suspended_errors 1051 retval = call_with_suspended_errors (call_validate_method,
1052 ((lisp_fn_t) call_validate_method, 1052 Qnil,
1053 Qnil, Qspecifier, errb, 2, opaque, instantiator); 1053 Qspecifier, errb, 2,
1054 1054 opaque, instantiator);
1055 free_opaque_ptr (opaque); 1055 free_opaque_ptr (opaque);
1056 UNGCPRO; 1056 UNGCPRO;
1057 } 1057 }
1058 1058
1059 return retval; 1059 return retval;
1916 (The default value of nil is a subset of all tag sets, so in this case 1916 (The default value of nil is a subset of all tag sets, so in this case
1917 no instantiators will be screened out.) If EXACT-P is non-nil, however, 1917 no instantiators will be screened out.) If EXACT-P is non-nil, however,
1918 TAG-SET must be equal to an instantiator's tag set for the instantiator 1918 TAG-SET must be equal to an instantiator's tag set for the instantiator
1919 to be returned. 1919 to be returned.
1920 */ 1920 */
1921 (specifier, locale, tag_set, exact_p)) 1921 (specifier, locale, tag_set, exact_p))
1922 { 1922 {
1923 struct specifier_spec_list_closure cl; 1923 struct specifier_spec_list_closure cl;
1924 struct gcpro gcpro1, gcpro2; 1924 struct gcpro gcpro1, gcpro2;
1925 1925
1926 CHECK_SPECIFIER (specifier); 1926 CHECK_SPECIFIER (specifier);
2149 Lisp_Object opaque = 2149 Lisp_Object opaque =
2150 make_opaque_ptr ((void *) meths->validate_matchspec_method); 2150 make_opaque_ptr ((void *) meths->validate_matchspec_method);
2151 struct gcpro gcpro1; 2151 struct gcpro gcpro1;
2152 2152
2153 GCPRO1 (opaque); 2153 GCPRO1 (opaque);
2154 retval = call_with_suspended_errors 2154 retval = call_with_suspended_errors (call_validate_matchspec_method,
2155 ((lisp_fn_t) call_validate_matchspec_method, 2155 Qnil,
2156 Qnil, Qspecifier, errb, 2, opaque, matchspec); 2156 Qspecifier, errb, 2,
2157 2157 opaque, matchspec);
2158 free_opaque_ptr (opaque); 2158 free_opaque_ptr (opaque);
2159 UNGCPRO; 2159 UNGCPRO;
2160 } 2160 }
2161 2161
2162 return retval; 2162 return retval;
2273 if (device_matches_specifier_tag_set_p (device, tag_set)) 2273 if (device_matches_specifier_tag_set_p (device, tag_set))
2274 { 2274 {
2275 Lisp_Object val = XCDR (tagged_inst); 2275 Lisp_Object val = XCDR (tagged_inst);
2276 2276
2277 if (HAS_SPECMETH_P (sp, instantiate)) 2277 if (HAS_SPECMETH_P (sp, instantiate))
2278 val = call_with_suspended_errors 2278 val = call_with_suspended_errors (RAW_SPECMETH (sp, instantiate),
2279 ((lisp_fn_t) RAW_SPECMETH (sp, instantiate), 2279 Qunbound, Qspecifier, errb,
2280 Qunbound, Qspecifier, errb, 5, specifier, 2280 5, specifier, matchspec, domain,
2281 matchspec, domain, XCDR (tagged_inst), depth); 2281 XCDR (tagged_inst),
2282 depth);
2282 2283
2283 if (!UNBOUNDP (val)) 2284 if (!UNBOUNDP (val))
2284 { 2285 {
2285 unbind_to (count, Qnil); 2286 unbind_to (count, Qnil);
2286 UNGCPRO; 2287 UNGCPRO;
2342 else if (FRAMEP (domain)) 2343 else if (FRAMEP (domain))
2343 frame = domain; 2344 frame = domain;
2344 else if (DEVICEP (domain)) 2345 else if (DEVICEP (domain))
2345 device = domain; 2346 device = domain;
2346 else 2347 else
2347 /* #### dmoore - dammit, this should just signal an error or something
2348 shouldn't it? */
2349 abort (); 2348 abort ();
2350 2349
2351 if (NILP (buffer) && !NILP (window)) 2350 if (NILP (buffer) && !NILP (window))
2352 buffer = XWINDOW (window)->buffer; 2351 buffer = XWINDOW (window)->buffer;
2353 if (NILP (frame) && !NILP (window)) 2352 if (NILP (frame) && !NILP (window))
2769 is supposed to require only that the specifier type is passed, 2768 is supposed to require only that the specifier type is passed,
2770 while with this approach the actual specifier is needed.) 2769 while with this approach the actual specifier is needed.)
2771 2770
2772 What really needs to be done is to write a function 2771 What really needs to be done is to write a function
2773 `make-specifier-type' that creates new specifier types. 2772 `make-specifier-type' that creates new specifier types.
2773 #### I'll look into this for 19.14.
2774 */ 2774 */
2775 2775
2776 "A generic specifier is a generalized kind of specifier with user-defined\n" 2776 "A generic specifier is a generalized kind of specifier with user-defined\n"
2777 "semantics. The instantiator can be any kind of Lisp object, and the\n" 2777 "semantics. The instantiator can be any kind of Lisp object, and the\n"
2778 "instance computed from it is likewise any kind of Lisp object. The\n" 2778 "instance computed from it is likewise any kind of Lisp object. The\n"