XEmacs 21.2.25 "Hephaestus".
[chise/xemacs-chise.git.1] / src / print.c
index 98d4a84..5b828ca 100644 (file)
@@ -51,14 +51,13 @@ Lisp_Object Vstandard_output, Qstandard_output;
 /* The subroutine object for external-debugging-output is kept here
    for the convenience of the debugger.  */
 Lisp_Object Qexternal_debugging_output;
-Lisp_Object Qalternate_debugging_output;
 
 /* Avoid actual stack overflow in print.  */
 static int print_depth;
 
 /* Detect most circularities to print finite output.  */
 #define PRINT_CIRCLE 200
-Lisp_Object being_printed[PRINT_CIRCLE];
+static Lisp_Object being_printed[PRINT_CIRCLE];
 
 /* Maximum length of list or vector to print in full; noninteger means
    effectively infinity */
@@ -92,9 +91,6 @@ int print_readably;
 Lisp_Object Vprint_gensym;
 Lisp_Object Vprint_gensym_alist;
 
-Lisp_Object Qprint_escape_newlines;
-Lisp_Object Qprint_readably;
-
 Lisp_Object Qdisplay_error;
 Lisp_Object Qprint_message_label;
 
@@ -711,7 +707,6 @@ Display ERROR-OBJECT on STREAM in a user-friendly way.
 #ifdef LISP_FLOAT_TYPE
 
 Lisp_Object Vfloat_output_format;
-Lisp_Object Qfloat_output_format;
 
 /*
  * This buffer should be at least as large as the max string size of the
@@ -806,37 +801,52 @@ float_to_string (char *buf, double data)
    faster.
 
    BUFFER should accept 24 bytes.  This should suffice for the longest
-   numbers on 64-bit machines.  */
+   numbers on 64-bit machines, including the `-' sign and the trailing
+   \0.  */
 void
 long_to_string (char *buffer, long number)
 {
-  char *p;
-  int i, len;
+#if (SIZEOF_LONG != 4) && (SIZEOF_LONG != 8)
+  /* Huh? */
+  sprintf (buffer, "%ld", number);
+#else /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
+  char *p = buffer;
+  int force = 0;
 
   if (number < 0)
     {
-      *buffer++ = '-';
+      *p++ = '-';
       number = -number;
     }
-  p = buffer;
-
-  /* Print the digits to the string.  */
-  do
-    {
-      *p++ = number % 10 + '0';
-      number /= 10;
-    }
-  while (number);
 
-  /* And reverse them.  */
-  len = p - buffer - 1;
-  for (i = len / 2; i >= 0; i--)
-    {
-      char c = buffer[i];
-      buffer[i] = buffer[len - i];
-      buffer[len - i] = c;
-    }
-  buffer[len + 1] = '\0';
+#define FROB(figure) do {                                              \
+    if (force || number >= figure)                                     \
+      *p++ = number / figure + '0', number %= figure, force = 1;       \
+    } while (0)
+#if SIZEOF_LONG == 8
+  FROB (1000000000000000000L);
+  FROB (100000000000000000L);
+  FROB (10000000000000000L);
+  FROB (1000000000000000L);
+  FROB (100000000000000L);
+  FROB (10000000000000L);
+  FROB (1000000000000L);
+  FROB (100000000000L);
+  FROB (10000000000L);
+#endif /* SIZEOF_LONG == 8 */
+  FROB (1000000000);
+  FROB (100000000);
+  FROB (10000000);
+  FROB (1000000);
+  FROB (100000);
+  FROB (10000);
+  FROB (1000);
+  FROB (100);
+  FROB (10);
+#undef FROB
+  *p++ = number + '0';
+  *p = '\0';
+#endif /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
 }
 \f
 static void
@@ -1096,7 +1106,9 @@ print_internal (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
     case Lisp_Type_Int_Even:
     case Lisp_Type_Int_Odd:
       {
-       char buf[24];
+       /* ASCII Decimal representation uses 2.4 times as many bits as
+          machine binary.  */
+       char buf[3 * sizeof (EMACS_INT) + 5];
        long_to_string (buf, XINT (obj));
        write_c_string (buf, printcharfun);
        break;
@@ -1109,36 +1121,61 @@ print_internal (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
        Emchar ch = XCHAR (obj);
        char *p = buf;
        *p++ = '?';
-       if (ch == '\n')
-         *p++ = '\\', *p++ = 'n';
-       else if (ch == '\r')
-         *p++ = '\\', *p++ = 'r';
-       else if (ch == '\t')
-         *p++ = '\\', *p++ = 't';
-       else if (ch < 32)
+       if (ch < 32)
          {
-           *p++ = '\\', *p++ = '^';
-           *p++ = ch + 64;
-           if ((ch + 64) == '\\')
-             *p++ = '\\';
+           *p++ = '\\';
+           switch (ch)
+             {
+             case '\t': *p++ = 't'; break;
+             case '\n': *p++ = 'n'; break;
+             case '\r': *p++ = 'r'; break;
+             default:
+               *p++ = '^';
+               *p++ = ch + 64;
+               if ((ch + 64) == '\\')
+                 *p++ = '\\';
+               break;
+             }
+         }
+       else if (ch < 127)
+         {
+           /* syntactically special characters should be escaped. */
+           switch (ch)
+             {
+             case ' ':
+             case '"':
+             case '#':
+             case '\'':
+             case '(':
+             case ')':
+             case ',':
+             case '.':
+             case ';':
+             case '?':
+             case '[':
+             case '\\':
+             case ']':
+             case '`':
+               *p++ = '\\';
+             }
+           *p++ = ch;
          }
        else if (ch == 127)
-         *p++ = '\\', *p++ = '^', *p++ = '?';
-       else if (ch >= 128 && ch < 160)
+         {
+           *p++ = '\\', *p++ = '^', *p++ = '?';
+         }
+       else if (ch < 160)
          {
            *p++ = '\\', *p++ = '^';
-           p += set_charptr_emchar ((Bufbyte *)p, ch + 64);
+           p += set_charptr_emchar ((Bufbyte *) p, ch + 64);
          }
-       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 */
-         *p++ = '\\', *p++ = ch;
        else
-         p += set_charptr_emchar ((Bufbyte *)p, ch);
-       output_string (printcharfun, (Bufbyte *)buf, Qnil, 0, p - buf);
+         {
+           p += set_charptr_emchar ((Bufbyte *) p, ch);
+         }
+         
+       output_string (printcharfun, (Bufbyte *) buf, Qnil, 0, p - buf);
+
        break;
       }
 
@@ -1347,8 +1384,8 @@ print_symbol (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
    getting rid of this function altogether?  Does anything actually
    *use* it?  --hniksic */
 
-int alternate_do_pointer;
-char alternate_do_string[5000];
+static int alternate_do_pointer;
+static char alternate_do_string[5000];
 
 DEFUN ("alternate-debugging-output", Falternate_debugging_output, 1, 1, 0, /*
 Append CHARACTER to the array `alternate_do_string'.
@@ -1452,7 +1489,6 @@ FILE = nil means just close any termscript file currently open.
 /* Debugging kludge -- unbuffered */
 static int debug_print_length = 50;
 static int debug_print_level = 15;
-Lisp_Object debug_temp;
 
 static void
 debug_print_no_newline (Lisp_Object debug_print_obj)
@@ -1589,15 +1625,8 @@ debug_short_backtrace (int length)
 void
 syms_of_print (void)
 {
-  defsymbol (&Qprint_escape_newlines, "print-escape-newlines");
-  defsymbol (&Qprint_readably, "print-readably");
-
   defsymbol (&Qstandard_output, "standard-output");
 
-#ifdef LISP_FLOAT_TYPE
-  defsymbol (&Qfloat_output_format, "float-output-format");
-#endif
-
   defsymbol (&Qprint_length, "print-length");
 
   defsymbol (&Qprint_string_length, "print-string-length");
@@ -1614,7 +1643,6 @@ syms_of_print (void)
   DEFSUBR (Fterpri);
   DEFSUBR (Fwrite_char);
   DEFSUBR (Falternate_debugging_output);
-  defsymbol (&Qalternate_debugging_output, "alternate-debugging-output");
   DEFSUBR (Fexternal_debugging_output);
   DEFSUBR (Fopen_termscript);
   defsymbol (&Qexternal_debugging_output, "external-debugging-output");
@@ -1622,9 +1650,15 @@ syms_of_print (void)
 }
 
 void
-vars_of_print (void)
+reinit_vars_of_print (void)
 {
   alternate_do_pointer = 0;
+}
+
+void
+vars_of_print (void)
+{
+  reinit_vars_of_print ();
 
   DEFVAR_LISP ("standard-output", &Vstandard_output /*
 Output stream `print' uses by default for outputting a character.