/* 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
static int print_chars;
static int max_print;
#endif /* MAX_PRINT_CHARS */
+
+void print_interval ();
\f
#if 0
/* Convert between chars and GLYPHs */
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;
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')
+ 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;
{
{
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;
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 (((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);
}
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;
HCoop / bpt / emacs.git / blobdiff