*** empty log message ***

[gnu-emacs] / src / print.c

diff --git a/src/print.c b/src/print.c
index 9eff5250e636dc268a79f46503b2a4930895c59b..b65db9aedc66e47e2c4ea2c126972e0a852313e2 100644 (file)
--- a/src/print.c
+++ b/src/print.c
@@ -41,6 +41,10 @@ Lisp_Object Vfloat_output_format, Qfloat_output_format;
 /* Avoid actual stack overflow in print.  */
 int print_depth;
 
+/* Detect most circularities to print finite output.  */
+#define PRINT_CIRCLE 200
+Lisp_Object being_printed[PRINT_CIRCLE];
+
 /* Maximum length of list to print in full; noninteger means
    effectively infinity */
 
@@ -133,7 +137,7 @@ glyph_to_str_cpy (glyphs, str)
 
 #define PRINTPREPARE \
    original = printcharfun; \
-   if (NULL (printcharfun)) printcharfun = Qt; \
+   if (NILP (printcharfun)) printcharfun = Qt; \
    if (XTYPE (printcharfun) == Lisp_Buffer) \
      { if (XBUFFER (printcharfun) != current_buffer) Fset_buffer (printcharfun); \
        printcharfun = Qnil;}\
@@ -297,7 +301,7 @@ STREAM defaults to the value of `standard-output' (which see).")
   int start_point;
   Lisp_Object original;
 
-  if (NULL (printcharfun))
+  if (NILP (printcharfun))
     printcharfun = Vstandard_output;
   CHECK_NUMBER (ch, 0);
   PRINTPREPARE;
@@ -434,7 +438,7 @@ If STREAM is omitted or nil, the value of `standard-output' is used.")
   int start_point;
   Lisp_Object original;
 
-  if (NULL (printcharfun))
+  if (NILP (printcharfun))
     printcharfun = Vstandard_output;
   PRINTPREPARE;
   PRINTCHAR ('\n');
@@ -458,7 +462,7 @@ Output stream is STREAM, or value of `standard-output' (which see).")
 #ifdef MAX_PRINT_CHARS
   max_print = 0;
 #endif /* MAX_PRINT_CHARS */
-  if (NULL (printcharfun))
+  if (NILP (printcharfun))
     printcharfun = Vstandard_output;
   PRINTPREPARE;
   print_depth = 0;
@@ -487,7 +491,7 @@ second argument NOESCAPE is non-nil.")
   printcharfun = Vprin1_to_string_buffer;
   PRINTPREPARE;
   print_depth = 0;
-  print (obj, printcharfun, NULL (noescape));
+  print (obj, printcharfun, NILP (noescape));
   /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
   PRINTFINISH;
   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
@@ -514,7 +518,7 @@ Output stream is STREAM, or value of standard-output (which see).")
   int start_point;
   Lisp_Object original;
 
-  if (NULL (printcharfun))
+  if (NILP (printcharfun))
     printcharfun = Vstandard_output;
   PRINTPREPARE;
   print_depth = 0;
@@ -541,7 +545,7 @@ Output stream is STREAM, or value of `standard-output' (which see).")
   print_chars = 0;
   max_print = MAX_PRINT_CHARS;
 #endif /* MAX_PRINT_CHARS */
-  if (NULL (printcharfun))
+  if (NILP (printcharfun))
     printcharfun = Vstandard_output;
   GCPRO1 (obj);
   PRINTPREPARE;
@@ -598,7 +602,7 @@ float_to_string (buf, data)
   register unsigned char *cp, c;
   register int width;
       
-  if (NULL (Vfloat_output_format)
+  if (NILP (Vfloat_output_format)
       || XTYPE (Vfloat_output_format) != Lisp_String)
   lose:
     sprintf (buf, "%.20g", data);
@@ -651,9 +655,27 @@ print (obj, printcharfun, escapeflag)
 
   QUIT;
 
+#if 1  /* I'm not sure this is really worth doing.  */
+  /* Detect circularities and truncate them.
+     No need to offer any alternative--this is better than an error.  */
+  if (XTYPE (obj) == Lisp_Cons || XTYPE (obj) == Lisp_Vector
+      || XTYPE (obj) == Lisp_Compiled)
+    {
+      int i;
+      for (i = 0; i < print_depth; i++)
+       if (EQ (obj, being_printed[i]))
+         {
+           sprintf (buf, "#%d", i);
+           strout (buf, -1, printcharfun);
+           return;
+         }
+    }
+#endif
+
+  being_printed[print_depth] = obj;
   print_depth++;
 
-  if (print_depth > 200)
+  if (print_depth > PRINT_CIRCLE)
     error ("Apparently circular structure being printed");
 #ifdef MAX_PRINT_CHARS
   if (max_print && print_chars > max_print)
@@ -783,6 +805,9 @@ print (obj, printcharfun, escapeflag)
 
        if (XTYPE (Vprint_length) == Lisp_Int)
          max = XINT (Vprint_length);
+       /* Could recognize circularities in cdrs here,
+          but that would make printing of long lists quadratic.
+          It's not worth doing.  */
        while (CONSP (obj))
          {
            if (i++)
@@ -796,7 +821,7 @@ print (obj, printcharfun, escapeflag)
            obj = Fcdr (obj);
          }
       }
-      if (!NULL (obj) && !CONSP (obj))
+      if (!NILP (obj) && !CONSP (obj))
        {
          strout (" . ", 3, printcharfun);
          print (obj, printcharfun, escapeflag);
@@ -805,7 +830,7 @@ print (obj, printcharfun, escapeflag)
       break;
 
     case Lisp_Compiled:
-      strout ("#<byte-code ", -1, printcharfun);
+      strout ("#", -1, printcharfun);
     case Lisp_Vector:
       PRINTCHAR ('[');
       {
@@ -819,13 +844,11 @@ print (obj, printcharfun, escapeflag)
          }
       }
       PRINTCHAR (']');
-      if (XTYPE (obj) == Lisp_Compiled)
-       PRINTCHAR ('>');
       break;
 
 #ifndef standalone
     case Lisp_Buffer:
-      if (NULL (XBUFFER (obj)->name))
+      if (NILP (XBUFFER (obj)->name))
        strout ("#<killed buffer>", -1, printcharfun);
       else if (escapeflag)
        {
@@ -852,7 +875,7 @@ print (obj, printcharfun, escapeflag)
       strout ("#<window ", -1, printcharfun);
       sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number));
       strout (buf, -1, printcharfun);
-      if (!NULL (XWINDOW (obj)->buffer))
+      if (!NILP (XWINDOW (obj)->buffer))
        {
          strout (" on ", -1, printcharfun);
          print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun);
@@ -866,7 +889,9 @@ print (obj, printcharfun, escapeflag)
 
 #ifdef MULTI_SCREEN
     case Lisp_Screen:
-      strout ("#<screen ", -1, printcharfun);
+      strout (((XSCREEN (obj)->display.nothing == 0)
+              ? "#<dead screen " : "#<screen "),
+             -1, printcharfun);
       print_string (XSCREEN (obj)->name, printcharfun);
       sprintf (buf, " 0x%x", XFASTINT (XSCREEN (obj)));
       strout (buf, -1, printcharfun);