Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-13

[gnu-emacs] / src / print.c

diff --git a/src/print.c b/src/print.c
index 6576b387005cf7526685631a0736c7e182f71dfa..5f41f6f773730715519d67491b98f4b2c06a3793 100644 (file)
--- a/src/print.c
+++ b/src/print.c
@@ -1,6 +1,7 @@
 /* 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, 2002, 2003, 2004,
+                 2005, 2006 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -16,8 +17,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>
@@ -212,13 +213,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;                                     \
@@ -965,6 +970,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,
@@ -1020,8 +1045,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);
     }
 
@@ -1287,7 +1314,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.  */
@@ -1318,7 +1345,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.  */
@@ -1494,7 +1522,7 @@ print_object (obj, printcharfun, escapeflag)
 
   /* Detect circularities and truncate them.  */
   if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
-      || COMPILEDP (obj) || CHAR_TABLE_P (obj)
+      || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
       || (! NILP (Vprint_gensym)
          && SYMBOLP (obj)
          && !SYMBOL_INTERNED_P (obj)))
@@ -2183,6 +2211,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;
        }