Include <config.h> instead of "config.h".
[bpt/emacs.git] / src / print.c
index 2cd2b9c..83dcb2a 100644 (file)
@@ -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.
 
@@ -18,20 +18,24 @@ along with GNU Emacs; see the file COPYING.  If not, write to
 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 
 
-#include "config.h"
+#include <config.h>
 #include <stdio.h>
 #undef NULL
 #include "lisp.h"
 
 #ifndef standalone
 #include "buffer.h"
-#include "screen.h"
+#include "frame.h"
 #include "window.h"
 #include "process.h"
 #include "dispextern.h"
 #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 */
@@ -122,7 +128,7 @@ glyph_to_str_cpy (glyphs, str)
 }
 #endif
 \f
-/* Low level output routines for charaters and strings */
+/* Low level output routines for characters and strings */
 
 /* Lisp functions to do output using a stream
  must have the stream in a variable called printcharfun
@@ -135,31 +141,35 @@ 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)
 
-/* Index of first unused element of message_buf */
+/* Index of first unused element of FRAME_MESSAGE_BUF(selected_frame). */
 static int printbufidx;
 
 static void
@@ -190,17 +200,17 @@ printchar (ch, fun)
          return;
        }
 
-      if (echo_area_glyphs != SCREEN_MESSAGE_BUF (selected_screen)
+      if (echo_area_glyphs != FRAME_MESSAGE_BUF (selected_frame)
          || !message_buf_print)
        {
-         echo_area_glyphs = SCREEN_MESSAGE_BUF (selected_screen);
+         echo_area_glyphs = FRAME_MESSAGE_BUF (selected_frame);
          printbufidx = 0;
          message_buf_print = 1;
        }
 
-      if (printbufidx < SCREEN_WIDTH (selected_screen) - 1)
-       SCREEN_MESSAGE_BUF (selected_screen)[printbufidx++] = ch;
-      SCREEN_MESSAGE_BUF (selected_screen)[printbufidx] = 0;
+      if (printbufidx < FRAME_WIDTH (selected_frame) - 1)
+       FRAME_MESSAGE_BUF (selected_frame)[printbufidx++] = ch;
+      FRAME_MESSAGE_BUF (selected_frame)[printbufidx] = 0;
 
       return;
     }
@@ -242,19 +252,19 @@ strout (ptr, size, printcharfun)
          return;
        }
 
-      if (echo_area_glyphs != SCREEN_MESSAGE_BUF (selected_screen)
+      if (echo_area_glyphs != FRAME_MESSAGE_BUF (selected_frame)
          || !message_buf_print)
        {
-         echo_area_glyphs = SCREEN_MESSAGE_BUF (selected_screen);
+         echo_area_glyphs = FRAME_MESSAGE_BUF (selected_frame);
          printbufidx = 0;
          message_buf_print = 1;
        }
 
-      if (i > SCREEN_WIDTH (selected_screen) - printbufidx - 1)
-       i = SCREEN_WIDTH (selected_screen) - printbufidx - 1;
-      bcopy (ptr, &SCREEN_MESSAGE_BUF (selected_screen) [printbufidx], i);
+      if (i > FRAME_WIDTH (selected_frame) - printbufidx - 1)
+       i = FRAME_WIDTH (selected_frame) - printbufidx - 1;
+      bcopy (ptr, &FRAME_MESSAGE_BUF (selected_frame) [printbufidx], i);
       printbufidx += i;
-      SCREEN_MESSAGE_BUF (selected_screen) [printbufidx] = 0;
+      FRAME_MESSAGE_BUF (selected_frame) [printbufidx] = 0;
 
       return;
     }
@@ -275,7 +285,7 @@ print_string (string, printcharfun)
      Lisp_Object printcharfun;
 {
   if (EQ (printcharfun, Qnil) || EQ (printcharfun, Qt))
-    /* In predictable cases, strout is safe: output to buffer or screen.  */
+    /* In predictable cases, strout is safe: output to buffer or frame.  */
     strout (XSTRING (string)->data, XSTRING (string)->size, printcharfun);
   else
     {
@@ -399,7 +409,7 @@ All output done by BODY is inserted in that buffer by default.\n\
 The buffer is displayed in another window, but not selected.\n\
 The value of the last form in BODY is returned.\n\
 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
-If variable `temp-buffer-show-hook' is non-nil, call it at the end\n\
+If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
 to get the buffer displayed.  It gets one argument, the buffer to display.")
   (args)
      Lisp_Object args;
@@ -581,11 +591,8 @@ to make it write to the debugging output.\n")
 \f
 #ifdef LISP_FLOAT_TYPE
 
-void
-float_to_string (buf, data)
-     char *buf;
 /*
- * This buffer should be at least as large as the max string size of the
+ * The buffer should be at least as large as the max string size of the
  * largest float, printed in the biggest notation.  This is undoubtably
  * 20d float_output_format, with the negative of the C-constant "HUGE"
  * from <math.h>.
@@ -597,15 +604,22 @@ float_to_string (buf, data)
  * re-writing _doprnt to be more sane)?
  *                     -wsr
  */
+
+void
+float_to_string (buf, data)
+     unsigned char *buf;
      double data;
 {
-  register unsigned char *cp, c;
-  register int width;
+  unsigned char *cp;
+  int width;
       
   if (NILP (Vfloat_output_format)
       || XTYPE (Vfloat_output_format) != Lisp_String)
   lose:
-    sprintf (buf, "%.20g", data);
+    {
+      sprintf (buf, "%.17g", data);
+      width = -1;
+    }
   else                 /* oink oink */
     {
       /* Check that the spec we have is fully valid.
@@ -619,18 +633,21 @@ float_to_string (buf, data)
        goto lose;
 
       cp += 2;
-      for (width = 0;
-          ((c = *cp) >= '0' && c <= '9');
-          cp++)
-       {
-         width *= 10;
-         width += c - '0';
-       }
+
+      /* Check the width specification.  */
+      width = -1;
+      if ('0' <= *cp && *cp <= '9')
+       for (width = 0; (*cp >= '0' && *cp <= '9'); cp++)
+         width = (width * 10) + (*cp - '0');
 
       if (*cp != 'e' && *cp != 'f' && *cp != 'g')
        goto lose;
 
-      if (width < (*cp != 'e') || width > DBL_DIG)
+      /* A precision of zero is valid for %f; everything else requires
+        at least one.  Width may be omitted anywhere.  */
+      if (width != -1
+         && (width < (*cp != 'f')
+             || width > DBL_DIG))
        goto lose;
 
       if (cp[1] != 0)
@@ -638,16 +655,36 @@ float_to_string (buf, data)
 
       sprintf (buf, XSTRING (Vfloat_output_format)->data, data);
     }
+
+  /* Make sure there is a decimal point with digit after, or an
+     exponent, so that the value is readable as a float.  But don't do
+     this with "%.0f"; it's valid for that not to produce a decimal
+     point.  Note that width can be 0 only for %.0f.  */
+  if (width != 0)
+    {
+      for (cp = buf; *cp; cp++)
+       if ((*cp < '0' || *cp > '9') && *cp != '-')
+         break;
+
+      if (*cp == '.' && cp[1] == 0)
+       {
+         cp[1] = '0';
+         cp[2] = 0;
+       }
+
+      if (*cp == 0)
+       {
+         *cp++ = '.';
+         *cp++ = '0';
+         *cp++ = 0;
+       }
+    }
 }
 #endif /* LISP_FLOAT_TYPE */
 \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;
 {
@@ -724,14 +761,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++)
@@ -751,6 +791,16 @@ print (obj, printcharfun, escapeflag)
                }
            }
          PRINTCHAR ('\"');
+
+#ifdef USE_TEXT_PROPERTIES
+         if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
+           {
+             traverse_intervals (XSTRING (obj)->intervals,
+                                 0, 0, print_interval, printcharfun);
+             PRINTCHAR (')');
+           }
+#endif
+
          UNGCPRO;
        }
       break;
@@ -887,17 +937,17 @@ print (obj, printcharfun, escapeflag)
       strout ("#<window-configuration>", -1, printcharfun);
       break;
 
-#ifdef MULTI_SCREEN
-    case Lisp_Screen:
-      strout (((XSCREEN (obj)->display.nothing == 0)
-              ? "#<dead screen " : "#<screen "),
+#ifdef MULTI_FRAME
+    case Lisp_Frame:
+      strout ((FRAME_LIVE_P (XFRAME (obj))
+              ? "#<frame " : "#<dead frame "),
              -1, printcharfun);
-      print_string (XSCREEN (obj)->name, printcharfun);
-      sprintf (buf, " 0x%x", XFASTINT (XSCREEN (obj)));
+      print_string (XFRAME (obj)->name, printcharfun);
+      sprintf (buf, " 0x%x", (unsigned int) (XFRAME (obj)));
       strout (buf, -1, printcharfun);
       strout (">", -1, printcharfun);
       break;
-#endif /* MULTI_SCREEN */
+#endif /* MULTI_FRAME */
 
     case Lisp_Marker:
       strout ("#<marker ", -1, printcharfun);
@@ -912,6 +962,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:
@@ -924,6 +991,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;
+{
+  PRINTCHAR (' ');
+  print (make_number (interval->position), printcharfun, 1);
+  PRINTCHAR (' ');
+  print (make_number (interval->position + LENGTH (interval)),
+        printcharfun, 1);
+  PRINTCHAR (' ');
+  print (interval->plist, printcharfun, 1);
+}
+
+#endif /* USE_TEXT_PROPERTIES */
+\f
 void
 syms_of_print ()
 {
@@ -953,8 +1041,8 @@ Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
 Use `g' to choose the shorter of those two formats for the number at hand.\n\
 The precision in any of these cases is the number of digits following\n\
 the decimal point.  With `f', a precision of 0 means to omit the\n\
-decimal point.  0 is not allowed with `f' or `g'.\n\n\
-A value of nil means to use `%.20g'.");
+decimal point.  0 is not allowed with `e' or `g'.\n\n\
+A value of nil means to use `%.17g'.");
   Vfloat_output_format = Qnil;
   Qfloat_output_format = intern ("float-output-format");
   staticpro (&Qfloat_output_format);