Document sun change.

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

diff --git a/src/print.c b/src/print.c
index e9bfbcf..2390117 100644 (file)
--- a/src/print.c
+++ b/src/print.c
@@ -1,5 +1,5 @@
 /* Lisp object printing and output streams.
-   Copyright (C) 1985, 1986, 1988, 1992 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1988, 1993 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -32,6 +32,10 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 #include "termchar.h"
 #endif /* not standalone */
 
+#ifdef USE_TEXT_PROPERTIES
+#include "intervals.h"
+#endif
+
 Lisp_Object Vstandard_output, Qstandard_output;
 
 #ifdef LISP_FLOAT_TYPE
@@ -69,6 +73,8 @@ extern int noninteractive_need_newline;
 static int print_chars;
 static int max_print;
 #endif /* MAX_PRINT_CHARS */
+
+void print_interval ();
 \f
 #if 0
 /* Convert between chars and GLYPHs */
@@ -135,26 +141,30 @@ glyph_to_str_cpy (glyphs, str)
    Lisp_Object original;
 */ 
 
-#define PRINTPREPARE \
-   original = printcharfun; \
-   if (NILP (printcharfun)) printcharfun = Qt; \
-   if (XTYPE (printcharfun) == Lisp_Buffer) \
-     { if (XBUFFER (printcharfun) != current_buffer) Fset_buffer (printcharfun); \
-       printcharfun = Qnil;}\
-   if (XTYPE (printcharfun) == Lisp_Marker) \
-     { if (XMARKER (original)->buffer != current_buffer) \
-         set_buffer_internal (XMARKER (original)->buffer); \
-       old_point = point; \
-       SET_PT (marker_position (printcharfun)); \
-       start_point = point; \
+#define PRINTPREPARE                                           \
+   original = printcharfun;                                    \
+   if (NILP (printcharfun)) printcharfun = Qt;                 \
+   if (XTYPE (printcharfun) == Lisp_Buffer)                    \
+     { if (XBUFFER (printcharfun) != current_buffer)           \
+        Fset_buffer (printcharfun);                            \
+       printcharfun = Qnil;}                                   \
+   if (XTYPE (printcharfun) == Lisp_Marker)                    \
+     { if (!(XMARKER (original)->buffer))                      \
+         error ("Marker does not point anywhere");             \
+       if (XMARKER (original)->buffer != current_buffer)       \
+         set_buffer_internal (XMARKER (original)->buffer);     \
+       old_point = point;                                      \
+       SET_PT (marker_position (printcharfun));                        \
+       start_point = point;                                    \
        printcharfun = Qnil;}
 
-#define PRINTFINISH \
-   if (XTYPE (original) == Lisp_Marker) \
-     Fset_marker (original, make_number (point), Qnil); \
-   if (old_point >= 0) \
-     SET_PT ((old_point >= start_point ? point - start_point : 0) + old_point); \
-   if (old != current_buffer) \
+#define PRINTFINISH                                    \
+   if (XTYPE (original) == Lisp_Marker)                        \
+     Fset_marker (original, make_number (point), Qnil);        \
+   if (old_point >= 0)                                 \
+     SET_PT (old_point + (old_point >= start_point     \
+                         ? point - start_point : 0));  \
+   if (old != current_buffer)                          \
      set_buffer_internal (old)
 
 #define PRINTCHAR(ch) printchar (ch, printcharfun)
@@ -597,7 +607,7 @@ to make it write to the debugging output.\n")
 
 void
 float_to_string (buf, data)
-     char *buf;
+     unsigned char *buf;
      double data;
 {
   register unsigned char *cp, c;
@@ -663,11 +673,7 @@ float_to_string (buf, data)
 \f
 static void
 print (obj, printcharfun, escapeflag)
-#ifndef RTPC_REGISTER_BUG
-     register Lisp_Object obj;
-#else
      Lisp_Object obj;
-#endif
      register Lisp_Object printcharfun;
      int escapeflag;
 {
@@ -744,14 +750,17 @@ print (obj, printcharfun, escapeflag)
        {
          register int i;
          register unsigned char c;
-         Lisp_Object obj1;
          struct gcpro gcpro1;
 
-         /* You can't gcpro register variables, so copy obj to a
-            non-register variable so we can gcpro it without
-            making it non-register.  */
-         obj1 = obj;
-         GCPRO1 (obj1);
+         GCPRO1 (obj);
+
+#ifdef USE_TEXT_PROPERTIES
+         if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
+           {
+             PRINTCHAR ('#');
+             PRINTCHAR ('(');
+           }
+#endif
 
          PRINTCHAR ('\"');
          for (i = 0; i < XSTRING (obj)->size; i++)
@@ -771,6 +780,17 @@ print (obj, printcharfun, escapeflag)
                }
            }
          PRINTCHAR ('\"');
+
+#ifdef USE_TEXT_PROPERTIES
+         if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
+           {
+             PRINTCHAR (' ');
+             traverse_intervals (XSTRING (obj)->intervals,
+                                 0, 0, print_interval, printcharfun);
+             PRINTCHAR (')');
+           }
+#endif
+
          UNGCPRO;
        }
       break;
@@ -932,6 +952,23 @@ print (obj, printcharfun, escapeflag)
        }
       PRINTCHAR ('>');
       break;
+
+    case Lisp_Overlay:
+      strout ("#<overlay ", -1, printcharfun);
+      if (!(XMARKER (OVERLAY_START (obj))->buffer))
+       strout ("in no buffer", -1, printcharfun);
+      else
+       {
+         sprintf (buf, "from %d to %d in ",
+                  marker_position (OVERLAY_START (obj)),
+                  marker_position (OVERLAY_END   (obj)));
+         strout (buf, -1, printcharfun);
+         print_string (XMARKER (OVERLAY_START (obj))->buffer->name,
+                       printcharfun);
+       }
+      PRINTCHAR ('>');
+      break;
+
 #endif /* standalone */
 
     case Lisp_Subr:
@@ -944,6 +981,27 @@ print (obj, printcharfun, escapeflag)
   print_depth--;
 }
 \f
+#ifdef USE_TEXT_PROPERTIES
+
+/* Print a description of INTERVAL using PRINTCHARFUN.
+   This is part of printing a string that has text properties.  */
+
+void
+print_interval (interval, printcharfun)
+     INTERVAL interval;
+     Lisp_Object printcharfun;
+{
+  print (make_number (interval->position), printcharfun, 1);
+  PRINTCHAR (' ');
+  print (make_number (interval->position + LENGTH (interval)),
+        printcharfun, 1);
+  PRINTCHAR (' ');
+  print (interval->plist, printcharfun, 1);
+  PRINTCHAR (' ');
+}
+
+#endif /* USE_TEXT_PROPERTIES */
+\f
 void
 syms_of_print ()
 {