diff src/print.c @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents c0965ff3b039
children 4be1180a9e89
line wrap: on
line diff
--- a/src/print.c	Mon Aug 13 09:00:04 2007 +0200
+++ b/src/print.c	Mon Aug 13 09:02:59 2007 +0200
@@ -590,85 +590,6 @@
   return obj;
 }
 
-# include "emacsfns.h"
-static void print_error_message (Lisp_Object data, Lisp_Object stream);
-/* Synched with Emacs 19.34 */
-DEFUN ("error-message-string", Ferror_message_string, 1, 1, 0, /*
-Convert an error value (ERROR-SYMBOL . DATA) to an error message.
-*/
-  (obj))
-{
-  struct buffer *old = XBUFFER(Fcurrent_buffer());
-  Lisp_Object original, printcharfun, value;
-  struct gcpro gcpro1;
-
-  print_error_message (obj, Vprin1_to_string_buffer);
-
-  set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
-  value = Fbuffer_substring (Fpoint_min(Fcurrent_buffer()),
-			     Fpoint_max(Fcurrent_buffer()),
-			     Fcurrent_buffer());
-
-  GCPRO1 (value);
-  Ferase_buffer (Fcurrent_buffer());
-  set_buffer_internal (old);
-  UNGCPRO;
-
-  return value;
-}
-
-/* Print an error message for the error DATA
-   onto Lisp output stream STREAM (suitable for the print functions).  */
-
-static void
-print_error_message (Lisp_Object data, Lisp_Object stream)
-{
-  Lisp_Object errname, errmsg, file_error, tail;
-  struct gcpro gcpro1;
-  int i;
-
-  errname = Fcar (data);
-
-  if (EQ (errname, Qerror))
-    {
-      data = Fcdr (data);
-      if (!CONSP (data)) data = Qnil;
-      errmsg = Fcar (data);
-      file_error = Qnil;
-    }
-  else
-    {
-      errmsg = Fget (errname, Qerror_message, Qnil);
-      file_error = Fmemq (Qfile_error,
-			  Fget (errname, Qerror_conditions, Qnil));
-    }
-
-  /* Print an error message including the data items.  */
-
-  tail = Fcdr_safe (data);
-  GCPRO1 (tail);
-
-  /* For file-error, make error message by concatenating
-     all the data items.  They are all strings.  */
-  if (!NILP (file_error) && !NILP (tail))
-    errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr;
-
-  if (STRINGP (errmsg))
-    Fprinc (errmsg, stream);
-  else
-    write_string_1 ((CONST Bufbyte *)"Peculiar error", 14, stream);
-
-  for (i = 0; CONSP (tail); tail = Fcdr (tail), i++)
-    {
-      write_string_1 ((CONST Bufbyte *)(i ? ", " : ": "), 2, stream);
-      if (!NILP (file_error))
-	Fprinc (Fcar (tail), stream);
-      else
-	Fprin1 (Fcar (tail), stream);
-    }
-  UNGCPRO;
-}
-
 #ifdef LISP_FLOAT_TYPE
 
 Lisp_Object Vfloat_output_format;
@@ -857,6 +778,45 @@
 	break;
       }
 
+    case Lisp_Char:
+      {
+	/* God intended that this be #\..., you know. */
+	Emchar ch = XCHAR (obj);
+	write_c_string ("?", printcharfun);
+	if (ch == '\n')
+	  strcpy (buf, "\\n");
+	else if (ch == '\r')
+	  strcpy (buf, "\\r");
+	else if (ch == '\t')
+	  strcpy (buf, "\\t");
+	else if (ch < 32)
+	  sprintf (buf, "\\^%c", ch + 64);
+	else if (ch == 127)
+	  strcpy (buf, "\\^?");
+	else if (ch >= 128 && ch < 160)
+	  {
+	    Bytecount i;
+	    strcpy (buf, "\\^");
+	    i = set_charptr_emchar ((unsigned char *) (buf + 2), ch + 64);
+	    buf[2+i] = '\0';
+	  }
+	else if (ch < 127
+		 && !isdigit (ch)
+		 && !isalpha (ch)
+		 && ch != '^') /* must not backslash this or it will
+				  be interpreted as the start of a
+				  control char */
+	  sprintf (buf, "\\%c", ch);
+	else
+	  {
+	    Bytecount i;
+	    i = set_charptr_emchar ((unsigned char *) buf, ch);
+	    buf[i] = '\0';
+	  }
+	write_c_string (buf, printcharfun);
+	break;
+      }
+
     case Lisp_String:
       {
 	Bytecount size = XSTRING_LENGTH (obj);
@@ -1476,7 +1436,6 @@
   DEFSUBR (Fprin1_to_string);
   DEFSUBR (Fprinc);
   DEFSUBR (Fprint);
-  DEFSUBR (Ferror_message_string);
   DEFSUBR (Fterpri);
   DEFSUBR (Fwrite_char);
   DEFSUBR (Falternate_debugging_output);
@@ -1575,7 +1534,7 @@
 those which were made with `make-symbol' or by calling `intern' with a
 second argument.
 
-When print-gensym is true, such symbols will be preceded by \"#:\", which
+When print-gensym is true, such symbols will be preceeded by \"#:\", which
 causes the reader to create a new symbol instead of interning and returning
 an existing one.  Beware: the #: syntax creates a new symbol each time it is
 seen, so if you print an object which contains two pointers to the same