/* 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.
#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 (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)
\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;
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;
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 ()
{