*** empty log message ***

[gnu-emacs] / src / print.c

diff --git a/src/print.c b/src/print.c
index 27da81ae8eb352c608c719784142b90e4dee46c4..6150ff2efe61c4bcbbe6eb1d02a8d170b2f20a33 100644 (file)
--- a/src/print.c
+++ b/src/print.c
@@ -1,6 +1,6 @@
 /* Lisp object printing and output streams.
-   Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 01, 03, 2004
-       Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999,
+     2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -16,8 +16,8 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.  */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
 
 
 #include <config.h>
@@ -211,13 +211,17 @@ void print_interval ();
      }                                                                 \
    if (MARKERP (printcharfun))                                         \
      {                                                                 \
-       if (!(XMARKER (original)->buffer))                              \
+       EMACS_INT marker_pos;                                           \
+       if (!(XMARKER (printcharfun)->buffer))                          \
          error ("Marker does not point anywhere");                     \
-       if (XMARKER (original)->buffer != current_buffer)               \
-         set_buffer_internal (XMARKER (original)->buffer);             \
+       if (XMARKER (printcharfun)->buffer != current_buffer)           \
+         set_buffer_internal (XMARKER (printcharfun)->buffer);         \
+       marker_pos = marker_position (printcharfun);                    \
+       if (marker_pos < BEGV || marker_pos > ZV)                       \
+        error ("Marker is outside the accessible part of the buffer"); \
        old_point = PT;                                                 \
        old_point_byte = PT_BYTE;                                       \
-       SET_PT_BOTH (marker_position (printcharfun),                    \
+       SET_PT_BOTH (marker_pos,                                                \
                    marker_byte_position (printcharfun));               \
        start_point = PT;                                               \
        start_point_byte = PT_BYTE;                                     \
@@ -658,7 +662,7 @@ If variable `temp-buffer-show-function' is non-nil, call it at the end
 to get the buffer displayed instead of just displaying the non-selected
 buffer and calling the hook.  It gets one argument, the buffer to display.
 
-usage: (with-output-to-temp-buffer BUFFNAME BODY ...)  */)
+usage: (with-output-to-temp-buffer BUFNAME BODY ...)  */)
      (args)
      Lisp_Object args;
 {
@@ -791,7 +795,7 @@ A printed representation of an object is text which describes that object.  */)
   if (SBYTES (object) == SCHARS (object))
     STRING_SET_UNIBYTE (object);
 
-  /* Note that this won't make prepare_to_modify_buffer call 
+  /* Note that this won't make prepare_to_modify_buffer call
      ask-user-about-supersession-threat because this buffer
      does not visit a file.  */
   Ferase_buffer ();
@@ -929,7 +933,7 @@ DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugg
        doc: /* Redirect debugging output (stderr stream) to file FILE.
 If FILE is nil, reset target to the initial stderr stream.
 Optional arg APPEND non-nil (interactively, with prefix arg) means
-append to existing target file.  */) 
+append to existing target file.  */)
      (file, append)
      Lisp_Object file, append;
 {
@@ -1220,7 +1224,6 @@ print (obj, printcharfun, escapeflag)
      register Lisp_Object printcharfun;
      int escapeflag;
 {
-  print_depth = 0;
   old_backquote_output = 0;
 
   /* Reset print_number_index and Vprint_number_table only when
@@ -1240,6 +1243,7 @@ print (obj, printcharfun, escapeflag)
       start = index = print_number_index;
       /* Construct Vprint_number_table.
         This increments print_number_index for the objects added.  */
+      print_depth = 0;
       print_preprocess (obj);
 
       /* Remove unnecessary objects, which appear only once in OBJ;
@@ -1264,6 +1268,7 @@ print (obj, printcharfun, escapeflag)
       print_number_index = index;
     }
 
+  print_depth = 0;
   print_object (obj, printcharfun, escapeflag);
 }
 
@@ -1283,6 +1288,11 @@ print_preprocess (obj)
   int loop_count = 0;
   Lisp_Object halftail;
 
+  /* 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;
+
   /* Avoid infinite recursion for circular nested structure
      in the case where Vprint_circle is nil.  */
   if (NILP (Vprint_circle))
@@ -1293,11 +1303,6 @@ print_preprocess (obj)
       being_printed[print_depth] = 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;
-
   print_depth++;
   halftail = obj;
 
@@ -1400,7 +1405,7 @@ print_object (obj, printcharfun, escapeflag)
      register Lisp_Object printcharfun;
      int escapeflag;
 {
-  char buf[30];
+  char buf[40];
 
   QUIT;
 
@@ -1821,7 +1826,7 @@ print_object (obj, printcharfun, escapeflag)
 
          PRINTCHAR ('#');
          PRINTCHAR ('&');
-         sprintf (buf, "%d", XBOOL_VECTOR (obj)->size);
+         sprintf (buf, "%ld", (long) XBOOL_VECTOR (obj)->size);
          strout (buf, -1, -1, printcharfun, 0);
          PRINTCHAR ('\"');
 
@@ -1874,7 +1879,7 @@ print_object (obj, printcharfun, escapeflag)
       else if (WINDOWP (obj))
        {
          strout ("#<window ", -1, -1, printcharfun, 0);
-         sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number));
+         sprintf (buf, "%ld", (long) XFASTINT (XWINDOW (obj)->sequence_number));
          strout (buf, -1, -1, printcharfun, 0);
          if (!NILP (XWINDOW (obj)->buffer))
            {
@@ -1895,8 +1900,8 @@ print_object (obj, printcharfun, escapeflag)
              PRINTCHAR (' ');
              strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0);
              PRINTCHAR (' ');
-             sprintf (buf, "%d/%d", XFASTINT (h->count),
-                      XVECTOR (h->next)->size);
+             sprintf (buf, "%ld/%ld", (long) XFASTINT (h->count),
+                      (long) XVECTOR (h->next)->size);
              strout (buf, -1, -1, printcharfun, 0);
            }
          sprintf (buf, " 0x%lx", (unsigned long) h);
@@ -2019,7 +2024,7 @@ print_object (obj, printcharfun, escapeflag)
          break;
 
        case Lisp_Misc_Intfwd:
-         sprintf (buf, "#<intfwd to %d>", *XINTFWD (obj)->intvar);
+         sprintf (buf, "#<intfwd to %ld>", (long) *XINTFWD (obj)->intvar);
          strout (buf, -1, -1, printcharfun, 0);
          break;
 
@@ -2084,6 +2089,15 @@ print_object (obj, printcharfun, escapeflag)
          PRINTCHAR ('>');
          break;
 
+       case Lisp_Misc_Save_Value:
+         strout ("#<save_value ", -1, -1, printcharfun, 0);
+         sprintf(buf, "ptr=0x%08lx int=%d",
+                 (unsigned long) XSAVE_VALUE (obj)->pointer,
+                 XSAVE_VALUE (obj)->integer);
+         strout (buf, -1, -1, printcharfun, 0);
+         PRINTCHAR ('>');
+         break;
+
        default:
          goto badtype;
        }