xemacs-beta: src/eval.c comparison

comparison src/eval.c @ 563:183866b06e0b

[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	666d73d6ac56
children	190b164ddcac

comparison

equal deleted inserted replaced

-:c775bd016b32
+:183866b06e0b
 /* Evaluator for XEmacs Lisp interpreter.
 Copyright (C) 1985-1987, 1992-1994 Free Software Foundation, Inc.
 Copyright (C) 1995 Sun Microsystems, Inc.
-Copyright (C) 2000 Ben Wing.
+Copyright (C) 2000, 2001 Ben Wing.
 This file is part of XEmacs.
 XEmacs is free software; you can redistribute it and/or modify it
 under the terms of the GNU General Public License as published by the
 (subr->max_args == UNEVALLED) ? "#<special-form " : "#<subr ";
 const char *name = subr_name (subr);
 const char *trailer = subr->prompt ? " (interactive)>" : ">";
 if (print_readably)
-error ("printing unreadable object %s%s%s", header, name, trailer);
+printing_unreadable_object ("%s%s%s", header, name, trailer);
 write_c_string (header,  printcharfun);
 write_c_string (name,    printcharfun);
 write_c_string (trailer, printcharfun);
 }
 	  else
 	    {
 	      CHECK_CONS (tem);
 	      value = Feval (XCAR (tem));
 	      if (!NILP (XCDR (tem)))
-		signal_simple_error
+		sferror
 		  ("`let' bindings can have only one value-form", var);
 	    }
 	}
 specbind (symbol, value);
 }
 		CHECK_CONS (tem);
 		*value = Feval (XCAR (tem));
 		gcpro1.nvars = idx;
 		if (!NILP (XCDR (tem)))
-		  signal_simple_error
+		  sferror
 		    ("`let' bindings can have only one value-form", var);
 	      }
 	  }
 }
 }
 if (!NILP (args = XCDR (args)))
 	{
 	  Lisp_Object doc = XCAR (args);
 	  Fput (sym, Qvariable_documentation, doc);
 	  if (!NILP (args = XCDR (args)))
-	    error ("too many arguments");
+	    signal_error (Qwrong_number_of_arguments, "too many arguments", Qunbound);
 	}
 }
 #ifdef I18N3
 if (!NILP (Vfile_domain))
 if (!NILP (args = XCDR (args)))
 {
 Lisp_Object doc = XCAR (args);
 Fput (sym, Qvariable_documentation, doc);
 if (!NILP (args = XCDR (args)))
-	error ("too many arguments");
+	signal_error (Qwrong_number_of_arguments, "too many arguments", Qunbound);
 }
 #ifdef I18N3
 if (!NILP (Vfile_domain))
 Fput (sym, Qvariable_domain, Vfile_domain);
 	    }
 	}
 else
 	{
 	invalid_condition_handler:
-	  signal_simple_error ("Invalid condition handler", handler);
+	  sferror ("Invalid condition handler", handler);
 	}
 }
 CHECK_SYMBOL (var);
 /* Have called debugger; return value to signaller  */
 return value;
 #else  /* But the reality is that that stinks, because: */
 /* GACK!!! Really want some way for debug-on-quit errors
 to be continuable!! */
-error ("Returning a value from an error is no longer supported");
+signal_error (Qunimplemented,
+		"Returning a value from an error is no longer supported",
+		Qunbound);
 #endif
 }
 extern int in_display;
 /* Class 1: General functions that signal an error.
 These functions take an error type and a list of associated error
 data. */
 /* The simplest external error function: it would be called
-signal_continuable_error() in the terminology below, but it's
+signal_continuable_error_1() in the terminology below, but it's
 Lisp-callable. */
 DEFUN ("signal", Fsignal, 2, 2, 0, /*
 Signal a continuable error.  Args are ERROR-SYMBOL, and associated DATA.
 An error symbol is a symbol defined using `define-error'.
 }
 /* Signal a non-continuable error. */
 DOESNT_RETURN
-signal_error (Lisp_Object sig, Lisp_Object data)
+signal_error_1 (Lisp_Object sig, Lisp_Object data)
 {
 for (;;)
 Fsignal (sig, data);
 }
 #ifdef ERROR_CHECK_TYPECHECK
 according to ERRB.  CLASS is the class of warning and should
 refer to what sort of operation is being done (e.g. Qtoolbar,
 Qresource, etc.). */
 void
-maybe_signal_error (Lisp_Object sig, Lisp_Object data, Lisp_Object class,
+maybe_signal_error_1 (Lisp_Object sig, Lisp_Object data, Lisp_Object class,
-		    Error_behavior errb)
+		      Error_behavior errb)
 {
 if (ERRB_EQ (errb, ERROR_ME_NOT))
 return;
 else if (ERRB_EQ (errb, ERROR_ME_WARN))
 warn_when_safe_lispobj (class, Qwarning, Fcons (sig, data));
 /* Signal a continuable error or display a warning or do nothing,
 according to ERRB. */
 Lisp_Object
-maybe_signal_continuable_error (Lisp_Object sig, Lisp_Object data,
+maybe_signal_continuable_error_1 (Lisp_Object sig, Lisp_Object data,
-				Lisp_Object class, Error_behavior errb)
+				  Lisp_Object class, Error_behavior errb)
 {
 if (ERRB_EQ (errb, ERROR_ME_NOT))
 return Qnil;
 else if (ERRB_EQ (errb, ERROR_ME_WARN))
 {
 }
 /****************** Error functions class 2 ******************/
-/* Class 2: Printf-like functions that signal an error.
+/* Class 2: Signal an error with a string and an associated object.
+Normally these functions are used to attach one associated object,
+but to attach no objects, specify Qunbound for FROB, and for more
+than one object, make a list of the objects with Qunbound as the
+first element. (If you have specifically two objects to attach,
+consider using the function in class 3 below.) These functions
+signal an error of a specified type, whose data is one or more
+objects (usually two), a string the related Lisp object(s)
+specified as FROB. */
+/* Out of REASON and FROB, return a list of elements suitable for passing
+to signal_error_1(). */
+Lisp_Object
+build_error_data (const char *reason, Lisp_Object frob)
+{
+if (EQ (frob, Qunbound))
+frob = Qnil;
+else if (CONSP (frob) && EQ (XCAR (frob), Qunbound))
+frob = XCDR (frob);
+else
+frob = list1 (frob);
+if (!reason)
+return frob;
+else
+return Fcons (build_translated_string (reason), frob);
+}
+DOESNT_RETURN
+signal_error (Lisp_Object type, const char *reason, Lisp_Object frob)
+{
+signal_error_1 (type, build_error_data (reason, frob));
+}
+void
+maybe_signal_error (Lisp_Object type, const char *reason,
+		    Lisp_Object frob, Lisp_Object class,
+		    Error_behavior errb)
+{
+/* Optimization: */
+if (ERRB_EQ (errb, ERROR_ME_NOT))
+return;
+maybe_signal_error_1 (type, build_error_data (reason, frob), class, errb);
+}
+Lisp_Object
+signal_continuable_error (Lisp_Object type, const char *reason,
+			  Lisp_Object frob)
+{
+return Fsignal (type, build_error_data (reason, frob));
+}
+Lisp_Object
+maybe_signal_continuable_error (Lisp_Object type, const char *reason,
+				Lisp_Object frob, Lisp_Object class,
+				Error_behavior errb)
+{
+/* Optimization: */
+if (ERRB_EQ (errb, ERROR_ME_NOT))
+return Qnil;
+return maybe_signal_continuable_error_1 (type,
+					   build_error_data (reason, frob),
+					   class, errb);
+}
+/****************** Error functions class 3 ******************/
+/* Class 3: Signal an error with a string and two associated objects.
+These functions signal an error of a specified type, whose data
+is three objects, a string and two related Lisp objects.
+(The equivalent could be accomplished using the class 2 functions,
+but these are more convenient in this particular case.) */
+DOESNT_RETURN
+signal_error_2 (Lisp_Object type, const char *reason,
+		Lisp_Object frob0, Lisp_Object frob1)
+{
+signal_error_1 (type, list3 (build_translated_string (reason), frob0,
+			       frob1));
+}
+void
+maybe_signal_error_2 (Lisp_Object type, const char *reason,
+		      Lisp_Object frob0, Lisp_Object frob1,
+		      Lisp_Object class, Error_behavior errb)
+{
+/* Optimization: */
+if (ERRB_EQ (errb, ERROR_ME_NOT))
+return;
+maybe_signal_error_1 (type, list3 (build_translated_string (reason), frob0,
+				     frob1), class, errb);
+}
+Lisp_Object
+signal_continuable_error_2 (Lisp_Object type, const char *reason,
+			    Lisp_Object frob0, Lisp_Object frob1)
+{
+return Fsignal (type, list3 (build_translated_string (reason), frob0,
+			       frob1));
+}
+Lisp_Object
+maybe_signal_continuable_error_2 (Lisp_Object type, const char *reason,
+				  Lisp_Object frob0, Lisp_Object frob1,
+				  Lisp_Object class, Error_behavior errb)
+{
+/* Optimization: */
+if (ERRB_EQ (errb, ERROR_ME_NOT))
+return Qnil;
+return maybe_signal_continuable_error_1
+(type, list3 (build_translated_string (reason), frob0, frob1),
+class, errb);
+}
+/****************** Error functions class 4 ******************/
+/* Class 4: Printf-like functions that signal an error.
 These functions signal an error of a specified type, whose data
 is a single string, created using the arguments. */
-/* dump an error message; called like printf */
 DOESNT_RETURN
-type_error (Lisp_Object type, const char *fmt, ...)
+signal_ferror (Lisp_Object type, const char *fmt, ...)
 {
 Lisp_Object obj;
 va_list args;
 va_start (args, fmt);
 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
 				args);
 va_end (args);
 /* Fsignal GC-protects its args */
-signal_error (type, list1 (obj));
+signal_error (type, 0, obj);
 }
 void
-maybe_type_error (Lisp_Object type, Lisp_Object class, Error_behavior errb,
+maybe_signal_ferror (Lisp_Object type, Lisp_Object class, Error_behavior errb,
-		  const char *fmt, ...)
+		     const char *fmt, ...)
 {
 Lisp_Object obj;
 va_list args;
 /* Optimization: */
 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
 				args);
 va_end (args);
 /* Fsignal GC-protects its args */
-maybe_signal_error (type, list1 (obj), class, errb);
+maybe_signal_error (type, 0, obj, class, errb);
 }
 Lisp_Object
-continuable_type_error (Lisp_Object type, const char *fmt, ...)
+signal_continuable_ferror (Lisp_Object type, const char *fmt, ...)
 {
 Lisp_Object obj;
 va_list args;
 va_start (args, fmt);
 /* Fsignal GC-protects its args */
 return Fsignal (type, list1 (obj));
 }
 Lisp_Object
-maybe_continuable_type_error (Lisp_Object type, Lisp_Object class,
+maybe_signal_continuable_ferror (Lisp_Object type, Lisp_Object class,
-			      Error_behavior errb, const char *fmt, ...)
+				 Error_behavior errb, const char *fmt, ...)
 {
 Lisp_Object obj;
 va_list args;
 /* Optimization: */
 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
 				args);
 va_end (args);
 /* Fsignal GC-protects its args */
-return maybe_signal_continuable_error (type, list1 (obj), class, errb);
+return maybe_signal_continuable_error (type, 0, obj, class, errb);
 }
-/****************** Error functions class 3 ******************/
+/****************** Error functions class 5 ******************/
-/* Class 3: Signal an error with a string and an associated object.
+/* Class 5: Printf-like functions that signal an error.
 These functions signal an error of a specified type, whose data
-is two objects, a string and a related Lisp object (usually the object
+is a one or more objects, a string (created using the arguments)
-where the error is occurring). */
+and additional Lisp objects specified in FROB. (The syntax of FROB
+is the same as for class 2.)
+There is no need for a class 6 because you can always attach 2
+objects using class 5 (for FROB, specify a list with three
+elements, the first of which is Qunbound), and these functions are
+not commonly used.
+*/
 DOESNT_RETURN
-signal_type_error (Lisp_Object type, const char *reason, Lisp_Object frob)
+signal_ferror_with_frob (Lisp_Object type, Lisp_Object frob, const char *fmt,
-{
+			 ...)
-if (UNBOUNDP (frob))
-signal_error (type, list1 (build_translated_string (reason)));
-else
-signal_error (type, list2 (build_translated_string (reason), frob));
-}
-void
-maybe_signal_type_error (Lisp_Object type, const char *reason,
-			 Lisp_Object frob, Lisp_Object class,
-			 Error_behavior errb)
-{
-/* Optimization: */
-if (ERRB_EQ (errb, ERROR_ME_NOT))
-return;
-maybe_signal_error (type, list2 (build_translated_string (reason), frob),
-				     class, errb);
-}
-Lisp_Object
-signal_type_continuable_error (Lisp_Object type, const char *reason,
-			       Lisp_Object frob)
-{
-return Fsignal (type, list2 (build_translated_string (reason), frob));
-}
-Lisp_Object
-maybe_signal_type_continuable_error (Lisp_Object type, const char *reason,
-				     Lisp_Object frob, Lisp_Object class,
-				     Error_behavior errb)
-{
-/* Optimization: */
-if (ERRB_EQ (errb, ERROR_ME_NOT))
-return Qnil;
-return maybe_signal_continuable_error
-(type, list2 (build_translated_string (reason),
-		    frob), class, errb);
-}
-/****************** Error functions class 4 ******************/
-/* Class 4: Printf-like functions that signal an error.
-These functions signal an error of a specified type, whose data
-is a two objects, a string (created using the arguments) and a
-Lisp object.
-*/
-DOESNT_RETURN
-type_error_with_frob (Lisp_Object type, Lisp_Object frob, const char *fmt, ...)
 {
 Lisp_Object obj;
 va_list args;
 va_start (args, fmt);
 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
 				args);
 va_end (args);
 /* Fsignal GC-protects its args */
-signal_error (type, list2 (obj, frob));
+signal_error_1 (type, Fcons (obj, build_error_data (0, frob)));
 }
 void
-maybe_type_error_with_frob (Lisp_Object type, Lisp_Object frob,
+maybe_signal_ferror_with_frob (Lisp_Object type, Lisp_Object frob,
-			    Lisp_Object class, Error_behavior errb,
+			       Lisp_Object class, Error_behavior errb,
-			    const char *fmt, ...)
+			       const char *fmt, ...)
 {
 Lisp_Object obj;
 va_list args;
 /* Optimization: */
 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
 				args);
 va_end (args);
 /* Fsignal GC-protects its args */
-maybe_signal_error (type, list2 (obj, frob), class, errb);
+maybe_signal_error_1 (type, Fcons (obj, build_error_data (0, frob)), class,
+			errb);
 }
 Lisp_Object
-continuable_type_error_with_frob (Lisp_Object type, Lisp_Object frob,
+signal_continuable_ferror_with_frob (Lisp_Object type, Lisp_Object frob,
-				  const char *fmt, ...)
+				     const char *fmt, ...)
 {
 Lisp_Object obj;
 va_list args;
 va_start (args, fmt);
 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
 				args);
 va_end (args);
 /* Fsignal GC-protects its args */
-return Fsignal (type, list2 (obj, frob));
+return Fsignal (type, Fcons (obj, build_error_data (0, frob)));
 }
 Lisp_Object
-maybe_continuable_type_error_with_frob (Lisp_Object type, Lisp_Object frob,
+maybe_signal_continuable_ferror_with_frob (Lisp_Object type, Lisp_Object frob,
-					Lisp_Object class, Error_behavior errb,
+					   Lisp_Object class,
-					const char *fmt, ...)
+					   Error_behavior errb,
+					   const char *fmt, ...)
 {
 Lisp_Object obj;
 va_list args;
 /* Optimization: */
 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
 				args);
 va_end (args);
 /* Fsignal GC-protects its args */
-return maybe_signal_continuable_error (type, list2 (obj, frob),
+return maybe_signal_continuable_error_1 (type,
-					 class, errb);
+					   Fcons (obj,
-}
+						  build_error_data (0, frob)),
+					   class, errb);
-/****************** Error functions class 5 ******************/
-/* Class 5: Signal an error with a string and two associated objects.
-These functions signal an error of a specified type, whose data
-is three objects, a string and two related Lisp objects. */
-DOESNT_RETURN
-signal_type_error_2 (Lisp_Object type, const char *reason,
-		     Lisp_Object frob0, Lisp_Object frob1)
-{
-signal_error (type, list3 (build_translated_string (reason), frob0,
-			       frob1));
-}
-void
-maybe_signal_type_error_2 (Lisp_Object type, const char *reason,
-			   Lisp_Object frob0, Lisp_Object frob1,
-			   Lisp_Object class, Error_behavior errb)
-{
-/* Optimization: */
-if (ERRB_EQ (errb, ERROR_ME_NOT))
-return;
-maybe_signal_error (type, list3 (build_translated_string (reason), frob0,
-				     frob1), class, errb);
-}
-Lisp_Object
-signal_type_continuable_error_2 (Lisp_Object type, const char *reason,
-				 Lisp_Object frob0, Lisp_Object frob1)
-{
-return Fsignal (type, list3 (build_translated_string (reason), frob0,
-				 frob1));
-}
-Lisp_Object
-maybe_signal_type_continuable_error_2 (Lisp_Object type, const char *reason,
-				       Lisp_Object frob0, Lisp_Object frob1,
-				       Lisp_Object class, Error_behavior errb)
-{
-/* Optimization: */
-if (ERRB_EQ (errb, ERROR_ME_NOT))
-return Qnil;
-return maybe_signal_continuable_error
-(type, list3 (build_translated_string (reason), frob0,
-		    frob1),
-class, errb);
-}
-/****************** Simple error functions class 2 ******************/
-/* Simple class 2: Printf-like functions that signal an error.
-These functions signal an error of type Qerror, whose data
-is a single string, created using the arguments. */
-/* dump an error message; called like printf */
-DOESNT_RETURN
-error (const char *fmt, ...)
-{
-Lisp_Object obj;
-va_list args;
-va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
-				args);
-va_end (args);
-/* Fsignal GC-protects its args */
-signal_error (Qerror, list1 (obj));
-}
-void
-maybe_error (Lisp_Object class, Error_behavior errb, const char *fmt, ...)
-{
-Lisp_Object obj;
-va_list args;
-/* Optimization: */
-if (ERRB_EQ (errb, ERROR_ME_NOT))
-return;
-va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
-				args);
-va_end (args);
-/* Fsignal GC-protects its args */
-maybe_signal_error (Qerror, list1 (obj), class, errb);
-}
-Lisp_Object
-continuable_error (const char *fmt, ...)
-{
-Lisp_Object obj;
-va_list args;
-va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
-				args);
-va_end (args);
-/* Fsignal GC-protects its args */
-return Fsignal (Qerror, list1 (obj));
-}
-Lisp_Object
-maybe_continuable_error (Lisp_Object class, Error_behavior errb,
-			 const char *fmt, ...)
-{
-Lisp_Object obj;
-va_list args;
-/* Optimization: */
-if (ERRB_EQ (errb, ERROR_ME_NOT))
-return Qnil;
-va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
-				args);
-va_end (args);
-/* Fsignal GC-protects its args */
-return maybe_signal_continuable_error (Qerror, list1 (obj), class, errb);
-}
-/****************** Simple error functions class 3 ******************/
-/* Simple class 3: Signal an error with a string and an associated object.
-These functions signal an error of type Qerror, whose data
-is two objects, a string and a related Lisp object (usually the object
-where the error is occurring). */
-DOESNT_RETURN
-signal_simple_error (const char *reason, Lisp_Object frob)
-{
-signal_error (Qerror, list2 (build_translated_string (reason), frob));
-}
-void
-maybe_signal_simple_error (const char *reason, Lisp_Object frob,
-			   Lisp_Object class, Error_behavior errb)
-{
-/* Optimization: */
-if (ERRB_EQ (errb, ERROR_ME_NOT))
-return;
-maybe_signal_error (Qerror, list2 (build_translated_string (reason), frob),
-				     class, errb);
-}
-Lisp_Object
-signal_simple_continuable_error (const char *reason, Lisp_Object frob)
-{
-return Fsignal (Qerror, list2 (build_translated_string (reason), frob));
-}
-Lisp_Object
-maybe_signal_simple_continuable_error (const char *reason, Lisp_Object frob,
-				       Lisp_Object class, Error_behavior errb)
-{
-/* Optimization: */
-if (ERRB_EQ (errb, ERROR_ME_NOT))
-return Qnil;
-return maybe_signal_continuable_error
-(Qerror, list2 (build_translated_string (reason),
-		    frob), class, errb);
-}
-/****************** Simple error functions class 4 ******************/
-/* Simple class 4: Printf-like functions that signal an error.
-These functions signal an error of type Qerror, whose data
-is a two objects, a string (created using the arguments) and a
-Lisp object.
-*/
-DOESNT_RETURN
-error_with_frob (Lisp_Object frob, const char *fmt, ...)
-{
-Lisp_Object obj;
-va_list args;
-va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
-				args);
-va_end (args);
-/* Fsignal GC-protects its args */
-signal_error (Qerror, list2 (obj, frob));
-}
-void
-maybe_error_with_frob (Lisp_Object frob, Lisp_Object class,
-		       Error_behavior errb, const char *fmt, ...)
-{
-Lisp_Object obj;
-va_list args;
-/* Optimization: */
-if (ERRB_EQ (errb, ERROR_ME_NOT))
-return;
-va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
-				args);
-va_end (args);
-/* Fsignal GC-protects its args */
-maybe_signal_error (Qerror, list2 (obj, frob), class, errb);
-}
-Lisp_Object
-continuable_error_with_frob (Lisp_Object frob, const char *fmt, ...)
-{
-Lisp_Object obj;
-va_list args;
-va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
-				args);
-va_end (args);
-/* Fsignal GC-protects its args */
-return Fsignal (Qerror, list2 (obj, frob));
-}
-Lisp_Object
-maybe_continuable_error_with_frob (Lisp_Object frob, Lisp_Object class,
-				   Error_behavior errb, const char *fmt, ...)
-{
-Lisp_Object obj;
-va_list args;
-/* Optimization: */
-if (ERRB_EQ (errb, ERROR_ME_NOT))
-return Qnil;
-va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
-				args);
-va_end (args);
-/* Fsignal GC-protects its args */
-return maybe_signal_continuable_error (Qerror, list2 (obj, frob),
-					 class, errb);
-}
-/****************** Simple error functions class 5 ******************/
-/* Simple class 5: Signal an error with a string and two associated objects.
-These functions signal an error of type Qerror, whose data
-is three objects, a string and two related Lisp objects. */
-DOESNT_RETURN
-signal_simple_error_2 (const char *reason,
-Lisp_Object frob0, Lisp_Object frob1)
-{
-signal_error (Qerror, list3 (build_translated_string (reason), frob0,
-			       frob1));
-}
-void
-maybe_signal_simple_error_2 (const char *reason, Lisp_Object frob0,
-			     Lisp_Object frob1, Lisp_Object class,
-			     Error_behavior errb)
-{
-/* Optimization: */
-if (ERRB_EQ (errb, ERROR_ME_NOT))
-return;
-maybe_signal_error (Qerror, list3 (build_translated_string (reason), frob0,
-				     frob1), class, errb);
-}
-Lisp_Object
-signal_simple_continuable_error_2 (const char *reason, Lisp_Object frob0,
-				   Lisp_Object frob1)
-{
-return Fsignal (Qerror, list3 (build_translated_string (reason), frob0,
-				 frob1));
-}
-Lisp_Object
-maybe_signal_simple_continuable_error_2 (const char *reason, Lisp_Object frob0,
-					 Lisp_Object frob1, Lisp_Object class,
-					 Error_behavior errb)
-{
-/* Optimization: */
-if (ERRB_EQ (errb, ERROR_ME_NOT))
-return Qnil;
-return maybe_signal_continuable_error
-(Qerror, list3 (build_translated_string (reason), frob0,
-		    frob1),
-class, errb);
 }
 /* This is what the QUIT macro calls to signal a quit */
 void
 /* note that this is continuable. */
 Fsignal (Qquit, Qnil);
 }
-/* Used in core lisp functions for efficiency */
+/************************ convenience error functions ***********************/
 Lisp_Object
 signal_void_function_error (Lisp_Object function)
 {
 return Fsignal (Qvoid_function, list1 (function));
 }
 /* Used in list traversal macros for efficiency. */
 DOESNT_RETURN
 signal_malformed_list_error (Lisp_Object list)
 {
-signal_error (Qmalformed_list, list1 (list));
+signal_error (Qmalformed_list, 0, list);
 }
 DOESNT_RETURN
 signal_malformed_property_list_error (Lisp_Object list)
 {
-signal_error (Qmalformed_property_list, list1 (list));
+signal_error (Qmalformed_property_list, 0, list);
 }
 DOESNT_RETURN
 signal_circular_list_error (Lisp_Object list)
 {
-signal_error (Qcircular_list, list1 (list));
+signal_error (Qcircular_list, 0, list);
 }
 DOESNT_RETURN
 signal_circular_property_list_error (Lisp_Object list)
 {
-signal_error (Qcircular_property_list, list1 (list));
+signal_error (Qcircular_property_list, 0, list);
 }
 DOESNT_RETURN
 syntax_error (const char *reason, Lisp_Object frob)
 {
-signal_type_error (Qsyntax_error, reason, frob);
+signal_error (Qsyntax_error, reason, frob);
 }
 DOESNT_RETURN
 syntax_error_2 (const char *reason, Lisp_Object frob1, Lisp_Object frob2)
 {
-signal_type_error_2 (Qsyntax_error, reason, frob1, frob2);
+signal_error_2 (Qsyntax_error, reason, frob1, frob2);
+}
+void
+maybe_syntax_error (const char *reason, Lisp_Object frob,
+		    Lisp_Object class, Error_behavior errb)
+{
+maybe_signal_error (Qsyntax_error, reason, frob, class, errb);
+}
+DOESNT_RETURN
+sferror (const char *reason, Lisp_Object frob)
+{
+signal_error (Qstructure_formation_error, reason, frob);
+}
+DOESNT_RETURN
+sferror_2 (const char *reason, Lisp_Object frob1, Lisp_Object frob2)
+{
+signal_error_2 (Qstructure_formation_error, reason, frob1, frob2);
+}
+void
+maybe_sferror (const char *reason, Lisp_Object frob,
+	       Lisp_Object class, Error_behavior errb)
+{
+maybe_signal_error (Qstructure_formation_error, reason, frob, class, errb);
 }
 DOESNT_RETURN
 invalid_argument (const char *reason, Lisp_Object frob)
 {
-signal_type_error (Qinvalid_argument, reason, frob);
+signal_error (Qinvalid_argument, reason, frob);
 }
 DOESNT_RETURN
 invalid_argument_2 (const char *reason, Lisp_Object frob1, Lisp_Object frob2)
 {
-signal_type_error_2 (Qinvalid_argument, reason, frob1, frob2);
+signal_error_2 (Qinvalid_argument, reason, frob1, frob2);
+}
+void
+maybe_invalid_argument (const char *reason, Lisp_Object frob,
+			Lisp_Object class, Error_behavior errb)
+{
+maybe_signal_error (Qinvalid_argument, reason, frob, class, errb);
+}
+DOESNT_RETURN
+invalid_constant (const char *reason, Lisp_Object frob)
+{
+signal_error (Qinvalid_constant, reason, frob);
+}
+DOESNT_RETURN
+invalid_constant_2 (const char *reason, Lisp_Object frob1, Lisp_Object frob2)
+{
+signal_error_2 (Qinvalid_constant, reason, frob1, frob2);
+}
+void
+maybe_invalid_constant (const char *reason, Lisp_Object frob,
+			Lisp_Object class, Error_behavior errb)
+{
+maybe_signal_error (Qinvalid_constant, reason, frob, class, errb);
 }
 DOESNT_RETURN
 invalid_operation (const char *reason, Lisp_Object frob)
 {
-signal_type_error (Qinvalid_operation, reason, frob);
+signal_error (Qinvalid_operation, reason, frob);
 }
 DOESNT_RETURN
 invalid_operation_2 (const char *reason, Lisp_Object frob1, Lisp_Object frob2)
 {
-signal_type_error_2 (Qinvalid_operation, reason, frob1, frob2);
+signal_error_2 (Qinvalid_operation, reason, frob1, frob2);
+}
+void
+maybe_invalid_operation (const char *reason, Lisp_Object frob,
+			 Lisp_Object class, Error_behavior errb)
+{
+maybe_signal_error (Qinvalid_operation, reason, frob, class, errb);
 }
 DOESNT_RETURN
 invalid_change (const char *reason, Lisp_Object frob)
 {
-signal_type_error (Qinvalid_change, reason, frob);
+signal_error (Qinvalid_change, reason, frob);
 }
 DOESNT_RETURN
 invalid_change_2 (const char *reason, Lisp_Object frob1, Lisp_Object frob2)
 {
-signal_type_error_2 (Qinvalid_change, reason, frob1, frob2);
+signal_error_2 (Qinvalid_change, reason, frob1, frob2);
+}
+void
+maybe_invalid_change (const char *reason, Lisp_Object frob,
+		      Lisp_Object class, Error_behavior errb)
+{
+maybe_signal_error (Qinvalid_change, reason, frob, class, errb);
+}
+DOESNT_RETURN
+invalid_state (const char *reason, Lisp_Object frob)
+{
+signal_error (Qinvalid_state, reason, frob);
+}
+DOESNT_RETURN
+invalid_state_2 (const char *reason, Lisp_Object frob1, Lisp_Object frob2)
+{
+signal_error_2 (Qinvalid_state, reason, frob1, frob2);
+}
+void
+maybe_invalid_state (const char *reason, Lisp_Object frob,
+		     Lisp_Object class, Error_behavior errb)
+{
+maybe_signal_error (Qinvalid_state, reason, frob, class, errb);
+}
+DOESNT_RETURN
+wtaerror (const char *reason, Lisp_Object frob)
+{
+signal_error (Qwrong_type_argument, reason, frob);
+}
+DOESNT_RETURN
+stack_overflow (const char *reason, Lisp_Object frob)
+{
+signal_error (Qstack_overflow, reason, frob);
+}
+DOESNT_RETURN
+out_of_memory (const char *reason, Lisp_Object frob)
+{
+signal_error (Qout_of_memory, reason, frob);
+}
+DOESNT_RETURN
+printing_unreadable_object (const char *fmt, ...)
+{
+Lisp_Object obj;
+va_list args;
+va_start (args, fmt);
+obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
+				args);
+va_end (args);
+/* Fsignal GC-protects its args */
+signal_error (Qprinting_unreadable_object, 0, obj);
 }
 /************************************************************************/
 /*			      User commands				*/
 #else
 if (UNBOUNDP (fun)
 || (CONSP (fun)
 && EQ (XCAR (fun), Qautoload)))
 #endif
-error ("Autoloading failed to define function %s",
+invalid_state ("Autoloading failed to define function", funname);
-	   string_data (XSYMBOL (funname)->name));
 UNGCPRO;
 }
 /************************************************************************/
 if (++lisp_eval_depth > max_lisp_eval_depth)
 {
 if (max_lisp_eval_depth < 100)
 	max_lisp_eval_depth = 100;
 if (lisp_eval_depth > max_lisp_eval_depth)
-	error ("Lisp nesting exceeds `max-lisp-eval-depth'");
+	stack_overflow ("Lisp nesting exceeds `max-lisp-eval-depth'",
+			Qunbound);
 }
 /* We guaranteed CONSP (form) above */
 original_fun  = XCAR (form);
 original_args = XCDR (form);
 if (++lisp_eval_depth > max_lisp_eval_depth)
 {
 if (max_lisp_eval_depth < 100)
 	max_lisp_eval_depth = 100;
 if (lisp_eval_depth > max_lisp_eval_depth)
-	error ("Lisp nesting exceeds `max-lisp-eval-depth'");
+	stack_overflow ("Lisp nesting exceeds `max-lisp-eval-depth'",
+			Qunbound);
 }
 backtrace.pdlcount = specpdl_depth();
 backtrace.function = &args[0];
 backtrace.args  = fun_args;
 	{
 	  if (!NILP (Vdebug_on_error) ||
 	      !NILP (Vdebug_on_signal))
 	    /* Leave room for some specpdl in the debugger.  */
 	    max_specpdl_size = size_needed + 100;
-	  continuable_error
+	  signal_continuable_error
-	    ("Variable binding depth exceeds max-specpdl-size");
+	    (Qstack_overflow,
+	     "Variable binding depth exceeds max-specpdl-size", Qunbound);
 	}
 }
 while (specpdl_size < size_needed)
 {
 specpdl_size *= 2;
 void
 syms_of_eval (void)
 {
 INIT_LRECORD_IMPLEMENTATION (subr);
-defsymbol (&Qinhibit_quit, "inhibit-quit");
+DEFSYMBOL (Qinhibit_quit);
-defsymbol (&Qautoload, "autoload");
+DEFSYMBOL (Qautoload);
-defsymbol (&Qdebug_on_error, "debug-on-error");
+DEFSYMBOL (Qdebug_on_error);
-defsymbol (&Qstack_trace_on_error, "stack-trace-on-error");
+DEFSYMBOL (Qstack_trace_on_error);
-defsymbol (&Qdebug_on_signal, "debug-on-signal");
+DEFSYMBOL (Qdebug_on_signal);
-defsymbol (&Qstack_trace_on_signal, "stack-trace-on-signal");
+DEFSYMBOL (Qstack_trace_on_signal);
-defsymbol (&Qdebugger, "debugger");
+DEFSYMBOL (Qdebugger);
-defsymbol (&Qmacro, "macro");
+DEFSYMBOL (Qmacro);
 defsymbol (&Qand_rest, "&rest");
 defsymbol (&Qand_optional, "&optional");
 /* Note that the process code also uses Qexit */
-defsymbol (&Qexit, "exit");
+DEFSYMBOL (Qexit);
-defsymbol (&Qsetq, "setq");
+DEFSYMBOL (Qsetq);
-defsymbol (&Qinteractive, "interactive");
+DEFSYMBOL (Qinteractive);
-defsymbol (&Qcommandp, "commandp");
+DEFSYMBOL (Qcommandp);
-defsymbol (&Qdefun, "defun");
+DEFSYMBOL (Qdefun);
-defsymbol (&Qprogn, "progn");
+DEFSYMBOL (Qprogn);
-defsymbol (&Qvalues, "values");
+DEFSYMBOL (Qvalues);
-defsymbol (&Qdisplay_warning, "display-warning");
+DEFSYMBOL (Qdisplay_warning);
-defsymbol (&Qrun_hooks, "run-hooks");
+DEFSYMBOL (Qrun_hooks);
-defsymbol (&Qif, "if");
+DEFSYMBOL (Qif);
 DEFSUBR (For);
 DEFSUBR (Fand);
 DEFSUBR (Fif);
 DEFSUBR_MACRO (Fwhen);

Mercurial > hg > xemacs-beta

comparison src/eval.c @ 563:183866b06e0b