* etc/NEWS: In terminal-oriented subshells, the EMACS environment

[bpt/emacs.git] / src / print.c

diff --git a/src/print.c b/src/print.c
index 6150ff2..1335476 100644 (file)
--- a/src/print.c
+++ b/src/print.c
@@ -1,6 +1,7 @@
 /* Lisp object printing and output streams.
-   Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999,
-     2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997,
+                 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+                 2005, 2006 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -181,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;
+
 \f
 /* Low level output routines for characters and strings */
 
@@ -271,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)                                              \
      {                                                                 \
@@ -408,7 +413,7 @@ strout (ptr, size, size_byte, printcharfun, multibyte)
       if (size == size_byte)
        {
          for (i = 0; i < size; ++i)
-           insert_char ((unsigned char )*ptr++);
+           insert_char ((unsigned char) *ptr++);
        }
       else
        {
@@ -755,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.
@@ -908,15 +914,25 @@ 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;
 }
 
+/* This function is never called.  Its purpose is to prevent
+   print_output_debug_flag from being optimized away.  */
+
+void
+debug_output_compilation_hack (x)
+     int x;
+{
+  print_output_debug_flag = x;
+}
 
 #if defined(GNU_LINUX)
 
@@ -969,6 +985,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
+            );
+}
+
 \f
 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
        1, 1, 0,
@@ -1005,7 +1041,9 @@ error message is constructed.  */)
 }
 
 /* Print an error message for the error DATA onto Lisp output stream
-   STREAM (suitable for the print functions).  */
+   STREAM (suitable for the print functions).
+   CONTEXT is a C string describing the context of the error.
+   CALLER is the Lisp function inside which the error was signaled.  */
 
 void
 print_error_message (data, stream, context, caller)
@@ -1024,8 +1062,10 @@ print_error_message (data, stream, context, caller)
    *Messages*.  */
   if (!NILP (caller) && SYMBOLP (caller))
     {
-      const char *name = SDATA (SYMBOL_NAME (caller));
-      message_dolog (name, strlen (name), 0, 0);
+      Lisp_Object cname = SYMBOL_NAME (caller);
+      char *name = alloca (SBYTES (cname));
+      bcopy (SDATA (cname), name, SBYTES (cname));
+      message_dolog (name, SBYTES (cname), 0, 0);
       message_dolog (": ", 2, 0, 0);
     }
 
@@ -1291,7 +1331,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.  */
@@ -1322,7 +1362,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.  */