Merge from emacs-24; up to 2012-12-06T01:39:03Z!monnier@iro.umontreal.ca

[gnu-emacs] / src / print.c

diff --git a/src/print.c b/src/print.c
index 223a79dc552233c5694dba5260d0ed9f8ad43246..e87bbcce0e7974144789f39b2a69fd893d26c260 100644 (file)
--- a/src/print.c
+++ b/src/print.c
@@ -1,7 +1,7 @@
 /* Lisp object printing and output streams.
 
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012
-  Free Software Foundation, Inc.
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2013 Free Software
+Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -21,7 +21,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include <config.h>
 #include <stdio.h>
-#include <setjmp.h>
+
 #include "lisp.h"
 #include "character.h"
 #include "buffer.h"
@@ -45,15 +45,9 @@ static Lisp_Object Qtemp_buffer_setup_hook;
 
 static Lisp_Object Qfloat_output_format;
 
-#include <math.h>
 #include <float.h>
 #include <ftoastr.h>
 
-/* Default to values appropriate for IEEE floating point.  */
-#ifndef DBL_DIG
-#define DBL_DIG 15
-#endif
-
 /* Avoid actual stack overflow in print.  */
 static ptrdiff_t print_depth;
 
@@ -197,8 +191,7 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1;
                               ? PT - start_point : 0),                 \
                  old_point_byte + (old_point_byte >= start_point_byte  \
                                    ? PT_BYTE - start_point_byte : 0)); \
-   if (old != current_buffer)                                          \
-     set_buffer_internal (old);
+   set_buffer_internal (old);
 
 #define PRINTCHAR(ch) printchar (ch, printcharfun)
 
@@ -488,7 +481,7 @@ temp_output_buffer_setup (const char *bufname)
   register struct buffer *old = current_buffer;
   register Lisp_Object buf;
 
-  record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
+  record_unwind_current_buffer ();
 
   Fset_buffer (Fget_buffer_create (build_string (bufname)));
 
@@ -586,6 +579,7 @@ A printed representation of an object is text which describes that object.  */)
   (Lisp_Object object, Lisp_Object noescape)
 {
   Lisp_Object printcharfun;
+  bool prev_abort_on_gc;
   /* struct gcpro gcpro1, gcpro2; */
   Lisp_Object save_deactivate_mark;
   ptrdiff_t count = SPECPDL_INDEX ();
@@ -601,7 +595,8 @@ A printed representation of an object is text which describes that object.  */)
        No need for specbind, since errors deactivate the mark.  */
     save_deactivate_mark = Vdeactivate_mark;
     /* GCPRO2 (object, save_deactivate_mark); */
-    abort_on_gc++;
+    prev_abort_on_gc = abort_on_gc;
+    abort_on_gc = 1;
 
     printcharfun = Vprin1_to_string_buffer;
     PRINTPREPARE;
@@ -625,7 +620,7 @@ A printed representation of an object is text which describes that object.  */)
   Vdeactivate_mark = save_deactivate_mark;
   /* UNGCPRO; */
 
-  abort_on_gc--;
+  abort_on_gc = prev_abort_on_gc;
   return unbind_to (count, object);
 }
 
@@ -758,9 +753,9 @@ append to existing target file.  */)
 {
   if (initial_stderr_stream != NULL)
     {
-      BLOCK_INPUT;
+      block_input ();
       fclose (stderr);
-      UNBLOCK_INPUT;
+      unblock_input ();
     }
   stderr = initial_stderr_stream;
   initial_stderr_stream = NULL;
@@ -803,7 +798,7 @@ safe_debug_print (Lisp_Object arg)
   else
     fprintf (stderr, "#<%s_LISP_OBJECT 0x%08"pI"x>\r\n",
             !valid ? "INVALID" : "SOME",
-            XHASH (arg));
+            XLI (arg));
 }
 
 \f
@@ -1820,14 +1815,14 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
 #endif
          /* Implement a readable output, e.g.:
            #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
-         /* Always print the size. */
+         /* Always print the size.  */
          len = sprintf (buf, "#s(hash-table size %"pD"d", ASIZE (h->next));
          strout (buf, len, len, printcharfun);
 
-         if (!NILP (h->test))
+         if (!NILP (h->test.name))
            {
              strout (" test ", -1, -1, printcharfun);
-             print_object (h->test, printcharfun, escapeflag);
+             print_object (h->test.name, printcharfun, escapeflag);
            }
 
          if (!NILP (h->weak))
@@ -1878,7 +1873,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
        }
       else if (BUFFERP (obj))
        {
-         if (NILP (BVAR (XBUFFER (obj), name)))
+         if (!BUFFER_LIVE_P (XBUFFER (obj)))
            strout ("#<killed buffer>", -1, -1, printcharfun);
          else if (escapeflag)
            {
@@ -2039,14 +2034,44 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
          break;
 
        case Lisp_Misc_Save_Value:
-         strout ("#<save_value ", -1, -1, printcharfun);
          {
-           int len = sprintf (buf, "ptr=%p int=%"pD"d",
-                              XSAVE_VALUE (obj)->pointer,
-                              XSAVE_VALUE (obj)->integer);
-           strout (buf, len, len, printcharfun);
+           int i;
+           struct Lisp_Save_Value *v = XSAVE_VALUE (obj);
+
+           strout ("#<save-value ", -1, -1, printcharfun);
+           if (v->dogc)
+             {
+               int lim = min (v->integer, 8);
+               
+               /* Try to print up to 8 objects we have saved.  Although
+                  valid_lisp_object_p is slow, this shouldn't be a real
+                  bottleneck because such a saved values are quite rare.  */
+
+               i = sprintf (buf, "with %"pD"d objects", v->integer);
+               strout (buf, i, i, printcharfun);
+
+               for (i = 0; i < lim; i++)
+                 {
+                   Lisp_Object maybe = ((Lisp_Object *) v->pointer)[i];
+
+                   if (valid_lisp_object_p (maybe) > 0)
+                     {
+                       PRINTCHAR (' ');
+                       print_object (maybe, printcharfun, escapeflag);
+                     }
+                   else
+                     strout (" <invalid>", -1, -1, printcharfun);
+                 }
+               if (i == lim && i < v->integer)
+                 strout (" ...", 4, 4, printcharfun);
+             }
+           else
+             {
+               i = sprintf (buf, "ptr=%p int=%"pD"d", v->pointer, v->integer);
+               strout (buf, i, i, printcharfun);
+             }
+           PRINTCHAR ('>');
          }
-         PRINTCHAR ('>');
          break;
 
        default:
@@ -2059,7 +2084,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
       {
        int len;
        /* We're in trouble if this happens!
-          Probably should just abort () */
+          Probably should just emacs_abort ().  */
        strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun);
        if (MISCP (obj))
          len = sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
@@ -2080,7 +2105,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
 /* Print a description of INTERVAL using PRINTCHARFUN.
    This is part of printing a string that has text properties.  */
 
-void
+static void
 print_interval (INTERVAL interval, Lisp_Object printcharfun)
 {
   if (NILP (interval->plist))