Mercurial > hg > xemacs-beta

comparison src/specifier.c @ 563:183866b06e0b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2001-05-24 07:50:48 by ben] Makefile.in.in, abbrev.c, alloc.c, buffer.c, bytecode.c, callint.c, callproc.c, casetab.c, chartab.c, cmdloop.c, cmds.c, console-msw.c, console-msw.h, console-stream.c, console-tty.c, console-x.c, console.c, data.c, database.c, debug.c, device-gtk.c, device-msw.c, device-tty.c, device-x.c, device.c, dialog-gtk.c, dialog-msw.c, dialog-x.c, dialog.c, dired-msw.c, dired.c, doc.c, doprnt.c, dragdrop.c, editfns.c, eldap.c, eldap.h, elhash.c, emacs-widget-accessors.c, emacs.c, emodules.c, esd.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, extents.c, faces.c, file-coding.c, fileio.c, filelock.c, floatfns.c, fns.c, font-lock.c, frame-gtk.c, frame-x.c, frame.c, general-slots.h, glade.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, gpmevent.c, gui-gtk.c, gui-x.c, gui.c, gutter.c, hpplay.c, indent.c, input-method-xlib.c, insdel.c, intl.c, keymap.c, libsst.c, libsst.h, linuxplay.c, lisp.h, lread.c, lstream.c, lstream.h, macros.c, marker.c, md5.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, miscplay.c, miscplay.h, mule-ccl.c, mule-charset.c, mule-wnnfns.c, mule.c, nas.c, ntplay.c, ntproc.c, objects-gtk.c, objects-msw.c, objects-x.c, objects.c, postgresql.c, print.c, process-nt.c, process-unix.c, process.c, ralloc.c, rangetab.c, redisplay.c, scrollbar.c, search.c, select-gtk.c, select-x.c, select.c, sgiplay.c, sheap.c, sound.c, specifier.c, sunplay.c, symbols.c, symeval.h, symsinit.h, syntax.c, sysdep.c, toolbar-msw.c, toolbar.c, tooltalk.c, ui-byhand.c, ui-gtk.c, undo.c, unexaix.c, unexapollo.c, unexconvex.c, unexec.c, widget.c, win32.c, window.c: -- defsymbol -> DEFSYMBOL. -- add an error type to all errors. -- eliminate the error functions in eval.c that let you just use Qerror as the type. -- redo the error API to be more consistent, sensibly named, and easier to use. -- redo the error hierarchy somewhat. create new errors: structure-formation-error, gui-error, invalid-constant, stack-overflow, out-of-memory, process-error, network-error, sound-error, printing-unreadable-object, base64-conversion- error; coding-system-error renamed to text-conversion error; some others. -- fix Mule problems in error strings in emodules.c, tooltalk.c. -- fix error handling in mswin open-network-stream. -- Mule-ize all sound files and clean up the headers. -- nativesound.h -> sound.h and used for all sound files. -- move some shared stuff into glyphs-shared.c: first attempt at eliminating some of the massive GTK code duplication. xemacs.mak: add glyphs-shared.c. xemacs-faq.texi: document how to debug X errors subr.el: fix doc string to reflect reality
author ben
date Thu, 24 May 2001 07:51:33 +0000
parents e7ef97881643
children 190b164ddcac
comparison
equal deleted inserted replaced
562:c775bd016b32 563:183866b06e0b
43 Lisp_Object Qspecifierp; 43 Lisp_Object Qspecifierp;
44 Lisp_Object Qremove_tag_set_prepend, Qremove_tag_set_append; 44 Lisp_Object Qremove_tag_set_prepend, Qremove_tag_set_append;
45 Lisp_Object Qremove_locale, Qremove_locale_type; 45 Lisp_Object Qremove_locale, Qremove_locale_type;
46 46
47 Lisp_Object Qconsole_type, Qdevice_class; 47 Lisp_Object Qconsole_type, Qdevice_class;
48
49 Lisp_Object Qspecifier_syntax_error;
50 Lisp_Object Qspecifier_argument_error;
51 Lisp_Object Qspecifier_change_error;
52 48
53 static Lisp_Object Vuser_defined_tags; 49 static Lisp_Object Vuser_defined_tags;
54 50
55 typedef struct specifier_type_entry specifier_type_entry; 51 typedef struct specifier_type_entry specifier_type_entry;
56 struct specifier_type_entry 52 struct specifier_type_entry
272 char buf[100]; 268 char buf[100];
273 int count = specpdl_depth (); 269 int count = specpdl_depth ();
274 Lisp_Object the_specs; 270 Lisp_Object the_specs;
275 271
276 if (print_readably) 272 if (print_readably)
277 error ("printing unreadable object #<%s-specifier 0x%x>", 273 printing_unreadable_object ("#<%s-specifier 0x%x>",
278 sp->methods->name, sp->header.uid); 274 sp->methods->name, sp->header.uid);
279 275
280 sprintf (buf, "#<%s-specifier global=", sp->methods->name); 276 sprintf (buf, "#<%s-specifier global=", sp->methods->name);
281 write_c_string (buf, printcharfun); 277 write_c_string (buf, printcharfun);
282 specbind (Qprint_string_length, make_int (100)); 278 specbind (Qprint_string_length, make_int (100));
283 specbind (Qprint_length, make_int (5)); 279 specbind (Qprint_length, make_int (5));
431 { 427 {
432 if (EQ (type, Dynarr_at (the_specifier_type_entry_dynarr, i).symbol)) 428 if (EQ (type, Dynarr_at (the_specifier_type_entry_dynarr, i).symbol))
433 return Dynarr_at (the_specifier_type_entry_dynarr, i).meths; 429 return Dynarr_at (the_specifier_type_entry_dynarr, i).meths;
434 } 430 }
435 431
436 maybe_signal_type_error (Qspecifier_argument_error, "Invalid specifier type", 432 maybe_invalid_argument ("Invalid specifier type",
437 type, Qspecifier, errb); 433 type, Qspecifier, errb);
438 434
439 return 0; 435 return 0;
440 } 436 }
441 437
676 /* This cannot GC. */ 672 /* This cannot GC. */
677 if (EQ (locale, Qall) || 673 if (EQ (locale, Qall) ||
678 !NILP (Fvalid_specifier_locale_p (locale)) || 674 !NILP (Fvalid_specifier_locale_p (locale)) ||
679 !NILP (Fvalid_specifier_locale_type_p (locale))) 675 !NILP (Fvalid_specifier_locale_type_p (locale)))
680 return; 676 return;
681 signal_type_error (Qspecifier_argument_error, 677 invalid_argument ("Invalid specifier locale or locale type", locale);
682 "Invalid specifier locale or locale type", locale);
683 } 678 }
684 679
685 DEFUN ("specifier-locale-type-from-locale", Fspecifier_locale_type_from_locale, 680 DEFUN ("specifier-locale-type-from-locale", Fspecifier_locale_type_from_locale,
686 1, 1, 0, /* 681 1, 1, 0, /*
687 Given a specifier LOCALE, return its type. 682 Given a specifier LOCALE, return its type.
688 */ 683 */
689 (locale)) 684 (locale))
690 { 685 {
691 /* This cannot GC. */ 686 /* This cannot GC. */
692 if (NILP (Fvalid_specifier_locale_p (locale))) 687 if (NILP (Fvalid_specifier_locale_p (locale)))
693 signal_type_error (Qspecifier_argument_error, "Invalid specifier locale", 688 invalid_argument ("Invalid specifier locale",
694 locale); 689 locale);
695 if (DEVICEP (locale)) return Qdevice; 690 if (DEVICEP (locale)) return Qdevice;
696 if (FRAMEP (locale)) return Qframe; 691 if (FRAMEP (locale)) return Qframe;
697 if (WINDOWP (locale)) return Qwindow; 692 if (WINDOWP (locale)) return Qwindow;
698 if (BUFFERP (locale)) return Qbuffer; 693 if (BUFFERP (locale)) return Qbuffer;
707 if (NILP (locale)) 702 if (NILP (locale))
708 return Qglobal; 703 return Qglobal;
709 else if (!NILP (Fvalid_specifier_locale_p (locale))) 704 else if (!NILP (Fvalid_specifier_locale_p (locale)))
710 return locale; 705 return locale;
711 else 706 else
712 signal_type_error (Qspecifier_argument_error, "Invalid specifier locale", 707 invalid_argument ("Invalid specifier locale",
713 locale); 708 locale);
714 709
715 return Qnil; 710 return Qnil;
716 } 711 }
717 712
723 if (EQ (locale_type, Qdevice)) return LOCALE_DEVICE; 718 if (EQ (locale_type, Qdevice)) return LOCALE_DEVICE;
724 if (EQ (locale_type, Qframe)) return LOCALE_FRAME; 719 if (EQ (locale_type, Qframe)) return LOCALE_FRAME;
725 if (EQ (locale_type, Qwindow)) return LOCALE_WINDOW; 720 if (EQ (locale_type, Qwindow)) return LOCALE_WINDOW;
726 if (EQ (locale_type, Qbuffer)) return LOCALE_BUFFER; 721 if (EQ (locale_type, Qbuffer)) return LOCALE_BUFFER;
727 722
728 signal_type_error (Qspecifier_argument_error, "Invalid specifier locale type", 723 invalid_argument ("Invalid specifier locale type",
729 locale_type); 724 locale_type);
730 return LOCALE_GLOBAL; /* not reached */ 725 return LOCALE_GLOBAL; /* not reached */
731 } 726 }
732 727
733 Lisp_Object 728 Lisp_Object
760 755
761 static void 756 static void
762 check_valid_domain (Lisp_Object domain) 757 check_valid_domain (Lisp_Object domain)
763 { 758 {
764 if (NILP (Fvalid_specifier_domain_p (domain))) 759 if (NILP (Fvalid_specifier_domain_p (domain)))
765 signal_type_error (Qspecifier_argument_error, "Invalid specifier domain", 760 invalid_argument ("Invalid specifier domain",
766 domain); 761 domain);
767 } 762 }
768 763
769 Lisp_Object 764 Lisp_Object
770 decode_domain (Lisp_Object domain) 765 decode_domain (Lisp_Object domain)
837 { 832 {
838 /* The return value of this function must be GCPRO'd. */ 833 /* The return value of this function must be GCPRO'd. */
839 if (!NILP (Fvalid_specifier_tag_p (tag_set))) 834 if (!NILP (Fvalid_specifier_tag_p (tag_set)))
840 return list1 (tag_set); 835 return list1 (tag_set);
841 if (NILP (Fvalid_specifier_tag_set_p (tag_set))) 836 if (NILP (Fvalid_specifier_tag_set_p (tag_set)))
842 signal_type_error (Qspecifier_argument_error, "Invalid specifier tag-set", 837 invalid_argument ("Invalid specifier tag-set",
843 tag_set); 838 tag_set);
844 return tag_set; 839 return tag_set;
845 } 840 }
846 841
847 static Lisp_Object 842 static Lisp_Object
901 sorting by symbol name and removing duplicates.) 896 sorting by symbol name and removing duplicates.)
902 */ 897 */
903 (tag_set)) 898 (tag_set))
904 { 899 {
905 if (NILP (Fvalid_specifier_tag_set_p (tag_set))) 900 if (NILP (Fvalid_specifier_tag_set_p (tag_set)))
906 signal_type_error (Qspecifier_argument_error, "Invalid tag set", tag_set); 901 invalid_argument ("Invalid tag set", tag_set);
907 return canonicalize_tag_set (tag_set); 902 return canonicalize_tag_set (tag_set);
908 } 903 }
909 904
910 static int 905 static int
911 device_matches_specifier_tag_set_p (Lisp_Object device, Lisp_Object tag_set) 906 device_matches_specifier_tag_set_p (Lisp_Object device, Lisp_Object tag_set)
943 (device, tag_set)) 938 (device, tag_set))
944 { 939 {
945 CHECK_LIVE_DEVICE (device); 940 CHECK_LIVE_DEVICE (device);
946 941
947 if (NILP (Fvalid_specifier_tag_set_p (tag_set))) 942 if (NILP (Fvalid_specifier_tag_set_p (tag_set)))
948 signal_type_error (Qspecifier_argument_error, "Invalid tag set", tag_set); 943 invalid_argument ("Invalid tag set", tag_set);
949 944
950 return device_matches_specifier_tag_set_p (device, tag_set) ? Qt : Qnil; 945 return device_matches_specifier_tag_set_p (device, tag_set) ? Qt : Qnil;
951 } 946 }
952 947
953 DEFUN ("define-specifier-tag", Fdefine_specifier_tag, 1, 2, 0, /* 948 DEFUN ("define-specifier-tag", Fdefine_specifier_tag, 1, 2, 0, /*
966 int recompute = 0; 961 int recompute = 0;
967 962
968 CHECK_SYMBOL (tag); 963 CHECK_SYMBOL (tag);
969 if (valid_device_class_p (tag) || 964 if (valid_device_class_p (tag) ||
970 valid_console_type_p (tag)) 965 valid_console_type_p (tag))
971 signal_type_error (Qspecifier_change_error, 966 invalid_change ("Cannot redefine built-in specifier tags", tag);
972 "Cannot redefine built-in specifier tags", tag);
973 /* Try to prevent common instantiators and locales from being 967 /* Try to prevent common instantiators and locales from being
974 redefined, to reduce ambiguity */ 968 redefined, to reduce ambiguity */
975 if (NILP (tag) || EQ (tag, Qt) || EQ (tag, Qall) || EQ (tag, Qglobal)) 969 if (NILP (tag) || EQ (tag, Qt) || EQ (tag, Qall) || EQ (tag, Qglobal))
976 signal_type_error (Qspecifier_change_error, "Cannot define nil, t, 'all, or 'global", 970 invalid_change ("Cannot define nil, t, 'all, or 'global", tag);
977 tag);
978 assoc = assq_no_quit (tag, Vuser_defined_tags); 971 assoc = assq_no_quit (tag, Vuser_defined_tags);
979 if (NILP (assoc)) 972 if (NILP (assoc))
980 { 973 {
981 recompute = 1; 974 recompute = 1;
982 Vuser_defined_tags = Fcons (Fcons (tag, predicate), Vuser_defined_tags); 975 Vuser_defined_tags = Fcons (Fcons (tag, predicate), Vuser_defined_tags);
1102 { 1095 {
1103 /* The return value of this function must be GCPRO'd. */ 1096 /* The return value of this function must be GCPRO'd. */
1104 CHECK_SYMBOL (tag); 1097 CHECK_SYMBOL (tag);
1105 1098
1106 if (NILP (Fvalid_specifier_tag_p (tag))) 1099 if (NILP (Fvalid_specifier_tag_p (tag)))
1107 signal_type_error (Qspecifier_argument_error, "Invalid specifier tag", 1100 invalid_argument ("Invalid specifier tag",
1108 tag); 1101 tag);
1109 1102
1110 /* Make up some predicates for the built-in types */ 1103 /* Make up some predicates for the built-in types */
1111 1104
1112 if (valid_console_type_p (tag)) 1105 if (valid_console_type_p (tag))
1230 { 1223 {
1231 Lisp_Object inst_pair, tag_set; 1224 Lisp_Object inst_pair, tag_set;
1232 1225
1233 if (!CONSP (rest)) 1226 if (!CONSP (rest))
1234 { 1227 {
1235 maybe_signal_type_error (Qspecifier_syntax_error, 1228 maybe_sferror (
1236 "Invalid instantiator list", inst_list, 1229 "Invalid instantiator list", inst_list,
1237 Qspecifier, errb); 1230 Qspecifier, errb);
1238 return Qnil; 1231 return Qnil;
1239 } 1232 }
1240 if (!CONSP (inst_pair = XCAR (rest))) 1233 if (!CONSP (inst_pair = XCAR (rest)))
1241 { 1234 {
1242 maybe_signal_type_error (Qspecifier_syntax_error, 1235 maybe_sferror (
1243 "Invalid instantiator pair", inst_pair, 1236 "Invalid instantiator pair", inst_pair,
1244 Qspecifier, errb); 1237 Qspecifier, errb);
1245 return Qnil; 1238 return Qnil;
1246 } 1239 }
1247 if (NILP (Fvalid_specifier_tag_set_p (tag_set = XCAR (inst_pair)))) 1240 if (NILP (Fvalid_specifier_tag_set_p (tag_set = XCAR (inst_pair))))
1248 { 1241 {
1249 maybe_signal_type_error (Qspecifier_syntax_error, 1242 maybe_invalid_argument (
1250 "Invalid specifier tag", tag_set, 1243 "Invalid specifier tag", tag_set,
1251 Qspecifier, errb); 1244 Qspecifier, errb);
1252 return Qnil; 1245 return Qnil;
1253 } 1246 }
1254 1247
1288 LIST_LOOP (rest, spec_list) 1281 LIST_LOOP (rest, spec_list)
1289 { 1282 {
1290 Lisp_Object spec, locale; 1283 Lisp_Object spec, locale;
1291 if (!CONSP (rest) || !CONSP (spec = XCAR (rest))) 1284 if (!CONSP (rest) || !CONSP (spec = XCAR (rest)))
1292 { 1285 {
1293 maybe_signal_type_error (Qspecifier_syntax_error, 1286 maybe_sferror (
1294 "Invalid specification list", spec_list, 1287 "Invalid specification list", spec_list,
1295 Qspecifier, errb); 1288 Qspecifier, errb);
1296 return Qnil; 1289 return Qnil;
1297 } 1290 }
1298 if (NILP (Fvalid_specifier_locale_p (locale = XCAR (spec)))) 1291 if (NILP (Fvalid_specifier_locale_p (locale = XCAR (spec))))
1299 { 1292 {
1300 maybe_signal_type_error (Qspecifier_syntax_error, 1293 maybe_invalid_argument (
1301 "Invalid specifier locale", locale, 1294 "Invalid specifier locale", locale,
1302 Qspecifier, errb); 1295 Qspecifier, errb);
1303 return Qnil; 1296 return Qnil;
1304 } 1297 }
1305 1298
1346 if (EQ (Qremove_locale_type, how_to_add)) 1339 if (EQ (Qremove_locale_type, how_to_add))
1347 return SPEC_REMOVE_LOCALE_TYPE; 1340 return SPEC_REMOVE_LOCALE_TYPE;
1348 if (EQ (Qremove_all, how_to_add)) 1341 if (EQ (Qremove_all, how_to_add))
1349 return SPEC_REMOVE_ALL; 1342 return SPEC_REMOVE_ALL;
1350 1343
1351 signal_type_error (Qspecifier_argument_error, "Invalid `how-to-add' flag", 1344 invalid_constant ("Invalid `how-to-add' flag", how_to_add);
1352 how_to_add);
1353 1345
1354 return SPEC_PREPEND; /* not reached */ 1346 return SPEC_PREPEND; /* not reached */
1355 } 1347 }
1356 1348
1357 /* Given a specifier object SPEC, return bodily specifier if SPEC is a 1349 /* Given a specifier object SPEC, return bodily specifier if SPEC is a
1371 static void 1363 static void
1372 check_modifiable_specifier (Lisp_Object spec) 1364 check_modifiable_specifier (Lisp_Object spec)
1373 { 1365 {
1374 if (NILP (Vunlock_ghost_specifiers) 1366 if (NILP (Vunlock_ghost_specifiers)
1375 && GHOST_SPECIFIER_P (XSPECIFIER (spec))) 1367 && GHOST_SPECIFIER_P (XSPECIFIER (spec)))
1376 signal_type_error (Qspecifier_change_error, 1368 signal_error (Qsetting_constant,
1377 "Attempt to modify read-only specifier", 1369 "Attempt to modify read-only specifier",
1378 list1 (spec)); 1370 spec);
1379 } 1371 }
1380 1372
1381 /* Helper function which unwind protects the value of 1373 /* Helper function which unwind protects the value of
1382 Vunlock_ghost_specifiers, then sets it to non-nil value */ 1374 Vunlock_ghost_specifiers, then sets it to non-nil value */
1383 static Lisp_Object 1375 static Lisp_Object
2330 else 2322 else
2331 { 2323 {
2332 CHECK_SPECIFIER (dest); 2324 CHECK_SPECIFIER (dest);
2333 check_modifiable_specifier (dest); 2325 check_modifiable_specifier (dest);
2334 if (XSPECIFIER (dest)->methods != XSPECIFIER (specifier)->methods) 2326 if (XSPECIFIER (dest)->methods != XSPECIFIER (specifier)->methods)
2335 error ("Specifiers not of same type"); 2327 invalid_argument ("Specifiers not of same type", Qunbound);
2336 } 2328 }
2337 2329
2338 cl.dest = dest; 2330 cl.dest = dest;
2339 GCPRO1 (dest); 2331 GCPRO1 (dest);
2340 map_specifier (specifier, locale, copy_specifier_mapfun, 2332 map_specifier (specifier, locale, copy_specifier_mapfun,
2388 2380
2389 return retval; 2381 return retval;
2390 } 2382 }
2391 else 2383 else
2392 { 2384 {
2393 maybe_signal_simple_error 2385 maybe_sferror
2394 ("Matchspecs not allowed for this specifier type", 2386 ("Matchspecs not allowed for this specifier type",
2395 intern (meths->name), Qspecifier, errb); 2387 intern (meths->name), Qspecifier, errb);
2396 return Qnil; 2388 return Qnil;
2397 } 2389 }
2398 } 2390 }
2595 tag = DEVICE_CLASS (XDEVICE (device)); 2587 tag = DEVICE_CLASS (XDEVICE (device));
2596 2588
2597 depth = make_int (1 + XINT (depth)); 2589 depth = make_int (1 + XINT (depth));
2598 if (XINT (depth) > 20) 2590 if (XINT (depth) > 20)
2599 { 2591 {
2600 maybe_error (Qspecifier, errb, "Apparent loop in specifier inheritance"); 2592 maybe_signal_error (Qstack_overflow,
2593 "Apparent loop in specifier inheritance",
2594 Qunbound, Qspecifier, errb);
2601 /* The specification is fucked; at least try the fallback 2595 /* The specification is fucked; at least try the fallback
2602 (which better not be fucked, because it's not changeable 2596 (which better not be fucked, because it's not changeable
2603 from Lisp). */ 2597 from Lisp). */
2604 depth = Qzero; 2598 depth = Qzero;
2605 goto do_fallback; 2599 goto do_fallback;
3117 3111
3118 static void 3112 static void
3119 boolean_validate (Lisp_Object instantiator) 3113 boolean_validate (Lisp_Object instantiator)
3120 { 3114 {
3121 if (!EQ (instantiator, Qt) && !EQ (instantiator, Qnil)) 3115 if (!EQ (instantiator, Qt) && !EQ (instantiator, Qnil))
3122 signal_type_error (Qspecifier_argument_error, "Must be t or nil", 3116 invalid_constant ("Must be t or nil", instantiator);
3123 instantiator);
3124 } 3117 }
3125 3118
3126 DEFUN ("boolean-specifier-p", Fboolean_specifier_p, 1, 1, 0, /* 3119 DEFUN ("boolean-specifier-p", Fboolean_specifier_p, 1, 1, 0, /*
3127 Return non-nil if OBJECT is a boolean specifier. 3120 Return non-nil if OBJECT is a boolean specifier.
3128 3121
3259 /* some how-to-add flags in general.c. */ 3252 /* some how-to-add flags in general.c. */
3260 DEFSYMBOL (Qremove_tag_set_prepend); 3253 DEFSYMBOL (Qremove_tag_set_prepend);
3261 DEFSYMBOL (Qremove_tag_set_append); 3254 DEFSYMBOL (Qremove_tag_set_append);
3262 DEFSYMBOL (Qremove_locale); 3255 DEFSYMBOL (Qremove_locale);
3263 DEFSYMBOL (Qremove_locale_type); 3256 DEFSYMBOL (Qremove_locale_type);
3264
3265 DEFERROR_STANDARD (Qspecifier_syntax_error, Qsyntax_error);
3266 DEFERROR_STANDARD (Qspecifier_argument_error, Qinvalid_argument);
3267 DEFERROR_STANDARD (Qspecifier_change_error, Qinvalid_change);
3268 } 3257 }
3269 3258
3270 void 3259 void
3271 specifier_type_create (void) 3260 specifier_type_create (void)
3272 { 3261 {