*** empty log message ***

[bpt/guile.git] / libguile / error.c

diff --git a/libguile/error.c b/libguile/error.c
index 4ff12ae..78e6986 100644 (file)
--- a/libguile/error.c
+++ b/libguile/error.c
@@ -45,14 +45,18 @@
 \f
 
 #include <stdio.h>
+
 #include "_scm.h"
 #include "pairs.h"
 #include "genio.h"
 #include "throw.h"
 
-#include "scm_validate.h"
+#include "validate.h"
 #include "error.h"
 
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 #endif
@@ -89,17 +93,17 @@ scm_error (SCM key, const char *subr, const char *message, SCM args, SCM rest)
 /* Scheme interface to scm_error.  */
 SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0, 
            (SCM key, SCM subr, SCM message, SCM args, SCM rest),
-"Raise an error with key @var{key}.  @var{subr} can be a string naming
-the procedure associated with the error, or @code{#f}.  @var{message}
-is the error message string, possibly containing @code{%S} and @code{%s}
-escapes.  When an error is reported, these are replaced by formating the
-corresponding members of @var{args}: @code{%s} formats using @code{display}
-and @code{%S} formats using @code{write}.  @var{data} is a
-list or @code{#f} depending on @var{key}: if @var{key} is
-@code{system-error} then it should be a list
-containing the Unix @code{errno} value;  If @var{key} is @code{signal} then
-it should be a list containing the Unix signal number; otherwise it
-will usually be @code{#f}.")
+           "Raise an error with key @var{key}.  @var{subr} can be a string naming\n"
+           "the procedure associated with the error, or @code{#f}.  @var{message}\n"
+           "is the error message string, possibly containing @code{~S} and @code{~A}\n"
+           "escapes.  When an error is reported, these are replaced by formating the\n"
+           "corresponding members of @var{args}: @code{~A} (was @code{%s}) formats using @code{display}\n"
+           "and @code(~S) (was @code{%S}) formats using @code{write}.  @var{data} is a\n"
+           "list or @code{#f} depending on @var{key}: if @var{key} is\n"
+           "@code{system-error} then it should be a list\n"
+           "containing the Unix @code{errno} value;  If @var{key} is @code{signal} then\n"
+           "it should be a list containing the Unix signal number; otherwise it\n"
+           "will usually be @code{#f}.")
 #define FUNC_NAME s_scm_error_scm
 {
   char *szSubr;
@@ -116,7 +120,7 @@ will usually be @code{#f}.")
 
 SCM_DEFINE (scm_strerror, "strerror", 1, 0, 0, 
             (SCM err),
-"Returns the Unix error message corresponding to @var{errno}, an integer.")
+           "Returns the Unix error message corresponding to @var{errno}, an integer.")
 #define FUNC_NAME s_scm_strerror
 {
   SCM_VALIDATE_INUM (1,err);
@@ -130,7 +134,7 @@ scm_syserror (const char *subr)
 {
   scm_error (scm_system_error_key,
             subr,
-            "%s",
+            "~A",
             scm_cons (scm_makfrom0str (strerror (errno)), SCM_EOL),
             scm_cons (SCM_MAKINUM (errno), SCM_EOL));
 }
@@ -145,13 +149,16 @@ scm_syserror_msg (const char *subr, const char *message, SCM args, int eno)
             scm_cons (SCM_MAKINUM (eno), SCM_EOL));
 }
 
+/* scm_sysmissing is no longer used in libguile.  it can probably be
+   removed after a release or two.  there's a comment in NEWS about it
+   (2000-01-09).  */
 void
 scm_sysmissing (const char *subr)
 {
 #ifdef ENOSYS
   scm_error (scm_system_error_key,
             subr,
-            "%s",
+            "~A",
             scm_cons (scm_makfrom0str (strerror (ENOSYS)), SCM_EOL),
             scm_cons (SCM_MAKINUM (ENOSYS), SCM_EOL));
 #else
@@ -180,19 +187,30 @@ scm_out_of_range (const char *subr, SCM bad_value)
 {
   scm_error (scm_out_of_range_key,
             subr,
-            "Argument out of range: %S",
-            scm_cons (bad_value, SCM_EOL),
+            "Argument out of range: ~S",
+             SCM_LIST1(bad_value),
+            SCM_BOOL_F);
+}
+
+void
+scm_out_of_range_pos (const char *subr, SCM bad_value, SCM pos)
+{
+  scm_error (scm_out_of_range_key,
+            subr,
+            "Argument ~S out of range: ~S",
+             SCM_LIST2(pos,bad_value),
             SCM_BOOL_F);
 }
 
+
 SCM_SYMBOL (scm_args_number_key, "wrong-number-of-args");
 void
 scm_wrong_num_args (SCM proc)
 {
   scm_error (scm_args_number_key,
             NULL,
-            "Wrong number of arguments to %s",
-            scm_cons (proc, SCM_EOL),
+            "Wrong number of arguments to ~A",
+            SCM_LIST1(proc),
             SCM_BOOL_F);
 }
 
@@ -202,13 +220,32 @@ scm_wrong_type_arg (const char *subr, int pos, SCM bad_value)
 {
   scm_error (scm_arg_type_key,
             subr,
-            (pos == 0) ? "Wrong type argument: %S"
-            : "Wrong type argument in position %s: %S",
-            (pos == 0) ? scm_cons (bad_value, SCM_EOL)
-            : scm_cons (SCM_MAKINUM (pos), scm_cons (bad_value, SCM_EOL)),
+            (pos == 0) ? "Wrong type argument: ~S"
+            : "Wrong type argument in position ~A: ~S",
+            (pos == 0) ? SCM_LIST1(bad_value)
+            : SCM_LIST2(SCM_MAKINUM(pos), bad_value),
             SCM_BOOL_F);
 }
 
+void
+scm_wrong_type_arg_msg (const char *subr, int pos, SCM bad_value, const char *szMessage)
+{
+  SCM msg = scm_makfrom0str(szMessage);
+  if (pos == 0) {
+    scm_error (scm_arg_type_key,
+               subr, "Wrong type argument (expecting ~A): ~S",
+               SCM_LIST2(msg,bad_value),
+               SCM_BOOL_F);
+  } else {
+    scm_error (scm_arg_type_key,
+               subr,
+               "Wrong type argument in position ~A (expecting ~A): ~S",
+               SCM_LIST3(SCM_MAKINUM(pos),msg,bad_value),
+               SCM_BOOL_F);
+  }
+}
+
+
 SCM_SYMBOL (scm_memory_alloc_key, "memory-allocation-error");
 void
 scm_memory_error (const char *subr)