X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/826256dd2b72d9046df706235c8424c2344d7430..4985dde2d0220cf74334261e0f558c377d295815:/src/print.c

diff --git a/src/print.c b/src/print.c
index 91642afd65..3f8982849d 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1,7 +1,7 @@
 /* Lisp object printing and output streams.
    Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997,
                  1998, 1999, 2000, 2001, 2002, 2003, 2004,
-                 2005 Free Software Foundation, Inc.
+                 2005, 2006 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -182,6 +182,9 @@ static int max_print;
 
 void print_interval ();
 
+/* GDB resets this to zero on W32 to disable OutputDebugString calls.  */
+int print_output_debug_flag = 1;
+
 
 /* Low level output routines for characters and strings */
 
@@ -272,6 +275,7 @@ void print_interval ();
        else								\
 	 insert_1_both (print_buffer, print_buffer_pos,			\
 			print_buffer_pos_byte, 0, 1, 0);		\
+       signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
      }									\
    if (free_print_buffer)						\
      {									\
@@ -756,7 +760,8 @@ DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
        doc: /* Return a string containing the printed representation of OBJECT.
 OBJECT can be any Lisp object.  This function outputs quoting characters
 when necessary to make output that `read' can handle, whenever possible,
-unless the optional second argument NOESCAPE is non-nil.
+unless the optional second argument NOESCAPE is non-nil.  For complex objects,
+the behavior is controlled by `print-level' and `print-length', which see.
 
 OBJECT is any of the Lisp data types: a number, a string, a symbol,
 a list, a buffer, a window, a frame, etc.
@@ -909,10 +914,11 @@ to make it write to the debugging output.  */)
 
 #ifdef WINDOWSNT
   /* Send the output to a debugger (nothing happens if there isn't one).  */
-  {
-    char buf[2] = {(char) XINT (character), '\0'};
-    OutputDebugString (buf);
-  }
+  if (print_output_debug_flag)
+    {
+      char buf[2] = {(char) XINT (character), '\0'};
+      OutputDebugString (buf);
+    }
 #endif
 
   return character;
@@ -970,6 +976,26 @@ debug_print (arg)
   Fprin1 (arg, Qexternal_debugging_output);
   fprintf (stderr, "\r\n");
 }
+
+void
+safe_debug_print (arg)
+     Lisp_Object arg;
+{
+  int valid = valid_lisp_object_p (arg);
+
+  if (valid > 0)
+    debug_print (arg);
+  else
+    fprintf (stderr, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
+	     !valid ? "INVALID" : "SOME",
+#ifdef NO_UNION_TYPE
+	     (unsigned long) arg
+#else
+	     (unsigned long) arg.i
+#endif
+	     );
+}
+
 
 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
        1, 1, 0,
@@ -1294,7 +1320,7 @@ print_preprocess (obj)
   /* Give up if we go so deep that print_object will get an error.  */
   /* See similar code in print_object.  */
   if (print_depth >= PRINT_CIRCLE)
-    return;
+    error ("Apparently circular structure being printed");
 
   /* Avoid infinite recursion for circular nested structure
      in the case where Vprint_circle is nil.  */
@@ -1325,7 +1351,8 @@ print_preprocess (obj)
 	      {
 		/* OBJ appears more than once.  Let's remember that.  */
 		PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
-		return;
+                print_depth--;
+                return;
 	      }
 
 	  /* OBJ is not yet recorded.  Let's add to the table.  */