/* Lisp object printing and output streams.
- Copyright (C) 1985, 1986, 1988 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1988, 1993 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 1, or (at your option)
+the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
#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
/* Avoid actual stack overflow in print. */
int print_depth;
+/* Detect most circularities to print finite output. */
+#define PRINT_CIRCLE 200
+Lisp_Object being_printed[PRINT_CIRCLE];
+
/* Maximum length of list to print in full; noninteger means
effectively infinity */
static int print_chars;
static int max_print;
#endif /* MAX_PRINT_CHARS */
+
+void print_interval ();
\f
#if 0
/* Convert between chars and GLYPHs */
}
#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
Lisp_Object original;
*/
-#define PRINTPREPARE \
- original = printcharfun; \
- if (NULL (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
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;
}
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;
}
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
{
int start_point;
Lisp_Object original;
- if (NULL (printcharfun))
+ if (NILP (printcharfun))
printcharfun = Vstandard_output;
CHECK_NUMBER (ch, 0);
PRINTPREPARE;
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;
int start_point;
Lisp_Object original;
- if (NULL (printcharfun))
+ if (NILP (printcharfun))
printcharfun = Vstandard_output;
PRINTPREPARE;
PRINTCHAR ('\n');
#ifdef MAX_PRINT_CHARS
max_print = 0;
#endif /* MAX_PRINT_CHARS */
- if (NULL (printcharfun))
+ if (NILP (printcharfun))
printcharfun = Vstandard_output;
PRINTPREPARE;
print_depth = 0;
printcharfun = Vprin1_to_string_buffer;
PRINTPREPARE;
print_depth = 0;
- print (obj, printcharfun, NULL (noescape));
+ print (obj, printcharfun, NILP (noescape));
/* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
PRINTFINISH;
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
int start_point;
Lisp_Object original;
- if (NULL (printcharfun))
+ if (NILP (printcharfun))
printcharfun = Vstandard_output;
PRINTPREPARE;
print_depth = 0;
print_chars = 0;
max_print = MAX_PRINT_CHARS;
#endif /* MAX_PRINT_CHARS */
- if (NULL (printcharfun))
+ if (NILP (printcharfun))
printcharfun = Vstandard_output;
GCPRO1 (obj);
PRINTPREPARE;
for the convenience of the debugger. */
Lisp_Object Qexternal_debugging_output;
-DEFUN ("external-debugging-output",
- Fexternal_debugging_output, Sexternal_debugging_output,
- 1, 1, 0, "Write CHARACTER to stderr.\n\
+DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
+ "Write CHARACTER to stderr.\n\
You can call print while debugging emacs, and pass it this function\n\
to make it write to the debugging output.\n")
- (Lisp_Object character)
+ (character)
+ Lisp_Object character;
{
CHECK_NUMBER (character, 0);
putc (XINT (character), stderr);
\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>.
* 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;
- if (NULL (Vfloat_output_format)
+ if (NILP (Vfloat_output_format)
|| XTYPE (Vfloat_output_format) != Lisp_String)
lose:
sprintf (buf, "%.20g", 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. */
+ 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;
{
QUIT;
+#if 1 /* I'm not sure this is really worth doing. */
+ /* Detect circularities and truncate them.
+ No need to offer any alternative--this is better than an error. */
+ if (XTYPE (obj) == Lisp_Cons || XTYPE (obj) == Lisp_Vector
+ || XTYPE (obj) == Lisp_Compiled)
+ {
+ int i;
+ for (i = 0; i < print_depth; i++)
+ if (EQ (obj, being_printed[i]))
+ {
+ sprintf (buf, "#%d", i);
+ strout (buf, -1, printcharfun);
+ return;
+ }
+ }
+#endif
+
+ being_printed[print_depth] = obj;
print_depth++;
- if (print_depth > 200)
+ if (print_depth > PRINT_CIRCLE)
error ("Apparently circular structure being printed");
#ifdef MAX_PRINT_CHARS
if (max_print && print_chars > max_print)
{
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++)
}
}
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;
if (XTYPE (Vprint_length) == Lisp_Int)
max = XINT (Vprint_length);
+ /* Could recognize circularities in cdrs here,
+ but that would make printing of long lists quadratic.
+ It's not worth doing. */
while (CONSP (obj))
{
if (i++)
obj = Fcdr (obj);
}
}
- if (!NULL (obj) && !CONSP (obj))
+ if (!NILP (obj) && !CONSP (obj))
{
strout (" . ", 3, printcharfun);
print (obj, printcharfun, escapeflag);
#ifndef standalone
case Lisp_Buffer:
- if (NULL (XBUFFER (obj)->name))
+ if (NILP (XBUFFER (obj)->name))
strout ("#<killed buffer>", -1, printcharfun);
else if (escapeflag)
{
strout ("#<window ", -1, printcharfun);
sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number));
strout (buf, -1, printcharfun);
- if (!NULL (XWINDOW (obj)->buffer))
+ if (!NILP (XWINDOW (obj)->buffer))
{
strout (" on ", -1, printcharfun);
print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun);
strout ("#<window-configuration>", -1, printcharfun);
break;
-#ifdef MULTI_SCREEN
- case Lisp_Screen:
- strout ("#<screen ", -1, printcharfun);
- print_string (XSCREEN (obj)->name, printcharfun);
- sprintf (buf, " 0x%x", XFASTINT (XSCREEN (obj)));
+#ifdef MULTI_FRAME
+ case Lisp_Frame:
+ strout ((FRAME_LIVE_P (XFRAME (obj))
+ ? "#<frame " : "#<dead frame "),
+ -1, printcharfun);
+ 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);
}
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:
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 ()
{
#ifdef LISP_FLOAT_TYPE
DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
- "The format descriptor string that lisp uses to print floats.\n\
+ "The format descriptor string used to print floats.\n\
This is a %-spec like those accepted by `printf' in C,\n\
but with some restrictions. It must start with the two characters `%.'.\n\
After that comes an integer precision specification,\n\
#endif /* LISP_FLOAT_TYPE */
DEFVAR_LISP ("print-length", &Vprint_length,
- "Maximum length of list to print before abbreviating.\
+ "Maximum length of list to print before abbreviating.\n\
A value of nil means no limit.");
Vprint_length = Qnil;
DEFVAR_LISP ("print-level", &Vprint_level,
- "Maximum depth of list nesting to print before abbreviating.\
+ "Maximum depth of list nesting to print before abbreviating.\n\
A value of nil means no limit.");
Vprint_level = Qnil;