1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
31 #include "dispextern.h"
33 #endif /* not standalone */
35 #ifdef USE_TEXT_PROPERTIES
36 #include "intervals.h"
39 Lisp_Object Vstandard_output
, Qstandard_output
;
41 #ifdef LISP_FLOAT_TYPE
42 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
43 #endif /* LISP_FLOAT_TYPE */
45 /* Avoid actual stack overflow in print. */
48 /* Detect most circularities to print finite output. */
49 #define PRINT_CIRCLE 200
50 Lisp_Object being_printed
[PRINT_CIRCLE
];
52 /* Maximum length of list to print in full; noninteger means
53 effectively infinity */
55 Lisp_Object Vprint_length
;
57 /* Maximum depth of list to print in full; noninteger means
58 effectively infinity. */
60 Lisp_Object Vprint_level
;
62 /* Nonzero means print newlines in strings as \n. */
64 int print_escape_newlines
;
66 Lisp_Object Qprint_escape_newlines
;
68 /* Nonzero means print newline to stdout before next minibuffer message.
71 extern int noninteractive_need_newline
;
73 /* Nonzero means print newline to message log before next message.
76 extern int message_log_need_newline
;
78 #ifdef MAX_PRINT_CHARS
79 static int print_chars
;
81 #endif /* MAX_PRINT_CHARS */
83 void print_interval ();
86 /* Convert between chars and GLYPHs */
90 register GLYPH
*glyphs
;
100 str_to_glyph_cpy (str
, glyphs
)
104 register GLYPH
*gp
= glyphs
;
105 register char *cp
= str
;
112 str_to_glyph_ncpy (str
, glyphs
, n
)
117 register GLYPH
*gp
= glyphs
;
118 register char *cp
= str
;
125 glyph_to_str_cpy (glyphs
, str
)
129 register GLYPH
*gp
= glyphs
;
130 register char *cp
= str
;
133 *str
++ = *gp
++ & 0377;
137 /* Low level output routines for characters and strings */
139 /* Lisp functions to do output using a stream
140 must have the stream in a variable called printcharfun
141 and must start with PRINTPREPARE and end with PRINTFINISH.
142 Use PRINTCHAR to output one character,
143 or call strout to output a block of characters.
144 Also, each one must have the declarations
145 struct buffer *old = current_buffer;
146 int old_point = -1, start_point;
147 Lisp_Object original;
150 #define PRINTPREPARE \
151 original = printcharfun; \
152 if (NILP (printcharfun)) printcharfun = Qt; \
153 if (BUFFERP (printcharfun)) \
154 { if (XBUFFER (printcharfun) != current_buffer) \
155 Fset_buffer (printcharfun); \
156 printcharfun = Qnil;} \
157 if (MARKERP (printcharfun)) \
158 { if (!(XMARKER (original)->buffer)) \
159 error ("Marker does not point anywhere"); \
160 if (XMARKER (original)->buffer != current_buffer) \
161 set_buffer_internal (XMARKER (original)->buffer); \
163 SET_PT (marker_position (printcharfun)); \
164 start_point = point; \
165 printcharfun = Qnil;}
167 #define PRINTFINISH \
168 if (MARKERP (original)) \
169 Fset_marker (original, make_number (point), Qnil); \
170 if (old_point >= 0) \
171 SET_PT (old_point + (old_point >= start_point \
172 ? point - start_point : 0)); \
173 if (old != current_buffer) \
174 set_buffer_internal (old)
176 #define PRINTCHAR(ch) printchar (ch, printcharfun)
178 /* Index of first unused element of FRAME_MESSAGE_BUF(mini_frame). */
179 static int printbufidx
;
188 #ifdef MAX_PRINT_CHARS
191 #endif /* MAX_PRINT_CHARS */
203 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
208 noninteractive_need_newline
= 1;
212 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
213 || !message_buf_print
)
215 if (message_log_need_newline
)
216 message_dolog ("", 0, 1);
217 message_log_need_newline
= 0;
218 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
220 echo_area_glyphs_length
= 0;
221 message_buf_print
= 1;
224 message_dolog (&ch
, 1, 0);
225 message_log_need_newline
= 1;
226 if (printbufidx
< FRAME_WIDTH (mini_frame
) - 1)
227 FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
++] = ch
;
228 FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
] = 0;
229 echo_area_glyphs_length
= printbufidx
;
233 #endif /* not standalone */
235 XSETFASTINT (ch1
, ch
);
240 strout (ptr
, size
, printcharfun
)
243 Lisp_Object printcharfun
;
247 if (EQ (printcharfun
, Qnil
))
249 insert (ptr
, size
>= 0 ? size
: strlen (ptr
));
250 #ifdef MAX_PRINT_CHARS
252 print_chars
+= size
>= 0 ? size
: strlen(ptr
);
253 #endif /* MAX_PRINT_CHARS */
256 if (EQ (printcharfun
, Qt
))
259 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
261 i
= size
>= 0 ? size
: strlen (ptr
);
262 #ifdef MAX_PRINT_CHARS
265 #endif /* MAX_PRINT_CHARS */
269 fwrite (ptr
, 1, i
, stdout
);
270 noninteractive_need_newline
= 1;
274 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
275 || !message_buf_print
)
277 if (message_log_need_newline
)
278 message_dolog ("", 0, 1);
279 message_log_need_newline
= 0;
280 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
282 echo_area_glyphs_length
= 0;
283 message_buf_print
= 1;
286 message_dolog (ptr
, i
, 0);
287 message_log_need_newline
= 1;
288 if (i
> FRAME_WIDTH (mini_frame
) - printbufidx
- 1)
289 i
= FRAME_WIDTH (mini_frame
) - printbufidx
- 1;
290 bcopy (ptr
, &FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
], i
);
292 echo_area_glyphs_length
= printbufidx
;
293 FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
] = 0;
300 PRINTCHAR (ptr
[i
++]);
303 PRINTCHAR (ptr
[i
++]);
306 /* Print the contents of a string STRING using PRINTCHARFUN.
307 It isn't safe to use strout, because printing one char can relocate. */
309 print_string (string
, printcharfun
)
311 Lisp_Object printcharfun
;
313 if (EQ (printcharfun
, Qnil
) || EQ (printcharfun
, Qt
))
314 /* In predictable cases, strout is safe: output to buffer or frame. */
315 strout (XSTRING (string
)->data
, XSTRING (string
)->size
, printcharfun
);
318 /* Otherwise, fetch the string address for each character. */
320 int size
= XSTRING (string
)->size
;
323 for (i
= 0; i
< size
; i
++)
324 PRINTCHAR (XSTRING (string
)->data
[i
]);
329 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
330 "Output character CHAR to stream PRINTCHARFUN.\n\
331 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
333 Lisp_Object ch
, printcharfun
;
335 struct buffer
*old
= current_buffer
;
338 Lisp_Object original
;
340 if (NILP (printcharfun
))
341 printcharfun
= Vstandard_output
;
342 CHECK_NUMBER (ch
, 0);
344 PRINTCHAR (XINT (ch
));
349 /* Used from outside of print.c to print a block of SIZE chars at DATA
350 on the default output stream.
351 Do not use this on the contents of a Lisp string. */
353 write_string (data
, size
)
357 struct buffer
*old
= current_buffer
;
358 Lisp_Object printcharfun
;
361 Lisp_Object original
;
363 printcharfun
= Vstandard_output
;
366 strout (data
, size
, printcharfun
);
370 /* Used from outside of print.c to print a block of SIZE chars at DATA
371 on a specified stream PRINTCHARFUN.
372 Do not use this on the contents of a Lisp string. */
374 write_string_1 (data
, size
, printcharfun
)
377 Lisp_Object printcharfun
;
379 struct buffer
*old
= current_buffer
;
382 Lisp_Object original
;
385 strout (data
, size
, printcharfun
);
393 temp_output_buffer_setup (bufname
)
396 register struct buffer
*old
= current_buffer
;
397 register Lisp_Object buf
;
399 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
401 current_buffer
->read_only
= Qnil
;
404 XSETBUFFER (buf
, current_buffer
);
405 specbind (Qstandard_output
, buf
);
407 set_buffer_internal (old
);
411 internal_with_output_to_temp_buffer (bufname
, function
, args
)
413 Lisp_Object (*function
) ();
416 int count
= specpdl_ptr
- specpdl
;
417 Lisp_Object buf
, val
;
421 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
422 temp_output_buffer_setup (bufname
);
423 buf
= Vstandard_output
;
426 val
= (*function
) (args
);
429 temp_output_buffer_show (buf
);
432 return unbind_to (count
, val
);
435 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
437 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
438 The buffer is cleared out initially, and marked as unmodified when done.\n\
439 All output done by BODY is inserted in that buffer by default.\n\
440 The buffer is displayed in another window, but not selected.\n\
441 The value of the last form in BODY is returned.\n\
442 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
443 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
444 to get the buffer displayed. It gets one argument, the buffer to display.")
450 int count
= specpdl_ptr
- specpdl
;
451 Lisp_Object buf
, val
;
454 name
= Feval (Fcar (args
));
457 CHECK_STRING (name
, 0);
458 temp_output_buffer_setup (XSTRING (name
)->data
);
459 buf
= Vstandard_output
;
461 val
= Fprogn (Fcdr (args
));
463 temp_output_buffer_show (buf
);
465 return unbind_to (count
, val
);
467 #endif /* not standalone */
469 static void print ();
471 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
472 "Output a newline to stream PRINTCHARFUN.\n\
473 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
475 Lisp_Object printcharfun
;
477 struct buffer
*old
= current_buffer
;
480 Lisp_Object original
;
482 if (NILP (printcharfun
))
483 printcharfun
= Vstandard_output
;
490 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
491 "Output the printed representation of OBJECT, any Lisp object.\n\
492 Quoting characters are printed when needed to make output that `read'\n\
493 can handle, whenever this is possible.\n\
494 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
496 Lisp_Object obj
, printcharfun
;
498 struct buffer
*old
= current_buffer
;
501 Lisp_Object original
;
503 #ifdef MAX_PRINT_CHARS
505 #endif /* MAX_PRINT_CHARS */
506 if (NILP (printcharfun
))
507 printcharfun
= Vstandard_output
;
510 print (obj
, printcharfun
, 1);
515 /* a buffer which is used to hold output being built by prin1-to-string */
516 Lisp_Object Vprin1_to_string_buffer
;
518 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
519 "Return a string containing the printed representation of OBJECT,\n\
520 any Lisp object. Quoting characters are used when needed to make output\n\
521 that `read' can handle, whenever this is possible, unless the optional\n\
522 second argument NOESCAPE is non-nil.")
524 Lisp_Object obj
, noescape
;
526 struct buffer
*old
= current_buffer
;
529 Lisp_Object original
, printcharfun
;
532 printcharfun
= Vprin1_to_string_buffer
;
535 print (obj
, printcharfun
, NILP (noescape
));
536 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
538 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
539 obj
= Fbuffer_string ();
543 set_buffer_internal (old
);
549 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
550 "Output the printed representation of OBJECT, any Lisp object.\n\
551 No quoting characters are used; no delimiters are printed around\n\
552 the contents of strings.\n\
553 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
555 Lisp_Object obj
, printcharfun
;
557 struct buffer
*old
= current_buffer
;
560 Lisp_Object original
;
562 if (NILP (printcharfun
))
563 printcharfun
= Vstandard_output
;
566 print (obj
, printcharfun
, 0);
571 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
572 "Output the printed representation of OBJECT, with newlines around it.\n\
573 Quoting characters are printed when needed to make output that `read'\n\
574 can handle, whenever this is possible.\n\
575 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
577 Lisp_Object obj
, printcharfun
;
579 struct buffer
*old
= current_buffer
;
582 Lisp_Object original
;
585 #ifdef MAX_PRINT_CHARS
587 max_print
= MAX_PRINT_CHARS
;
588 #endif /* MAX_PRINT_CHARS */
589 if (NILP (printcharfun
))
590 printcharfun
= Vstandard_output
;
595 print (obj
, printcharfun
, 1);
598 #ifdef MAX_PRINT_CHARS
601 #endif /* MAX_PRINT_CHARS */
606 /* The subroutine object for external-debugging-output is kept here
607 for the convenience of the debugger. */
608 Lisp_Object Qexternal_debugging_output
;
610 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
611 "Write CHARACTER to stderr.\n\
612 You can call print while debugging emacs, and pass it this function\n\
613 to make it write to the debugging output.\n")
615 Lisp_Object character
;
617 CHECK_NUMBER (character
, 0);
618 putc (XINT (character
), stderr
);
623 /* This is the interface for debugging printing. */
629 Fprin1 (arg
, Qexternal_debugging_output
);
632 #ifdef LISP_FLOAT_TYPE
635 * The buffer should be at least as large as the max string size of the
636 * largest float, printed in the biggest notation. This is undoubtably
637 * 20d float_output_format, with the negative of the C-constant "HUGE"
640 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
642 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
643 * case of -1e307 in 20d float_output_format. What is one to do (short of
644 * re-writing _doprnt to be more sane)?
649 float_to_string (buf
, data
)
656 if (NILP (Vfloat_output_format
)
657 || !STRINGP (Vfloat_output_format
))
660 sprintf (buf
, "%.17g", data
);
665 /* Check that the spec we have is fully valid.
666 This means not only valid for printf,
667 but meant for floats, and reasonable. */
668 cp
= XSTRING (Vfloat_output_format
)->data
;
677 /* Check the width specification. */
679 if ('0' <= *cp
&& *cp
<= '9')
680 for (width
= 0; (*cp
>= '0' && *cp
<= '9'); cp
++)
681 width
= (width
* 10) + (*cp
- '0');
683 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
686 /* A precision of zero is valid for %f; everything else requires
687 at least one. Width may be omitted anywhere. */
689 && (width
< (*cp
!= 'f')
696 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
699 /* Make sure there is a decimal point with digit after, or an
700 exponent, so that the value is readable as a float. But don't do
701 this with "%.0f"; it's valid for that not to produce a decimal
702 point. Note that width can be 0 only for %.0f. */
705 for (cp
= buf
; *cp
; cp
++)
706 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
709 if (*cp
== '.' && cp
[1] == 0)
723 #endif /* LISP_FLOAT_TYPE */
726 print (obj
, printcharfun
, escapeflag
)
728 register Lisp_Object printcharfun
;
735 #if 1 /* I'm not sure this is really worth doing. */
736 /* Detect circularities and truncate them.
737 No need to offer any alternative--this is better than an error. */
738 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
741 for (i
= 0; i
< print_depth
; i
++)
742 if (EQ (obj
, being_printed
[i
]))
744 sprintf (buf
, "#%d", i
);
745 strout (buf
, -1, printcharfun
);
751 being_printed
[print_depth
] = obj
;
754 if (print_depth
> PRINT_CIRCLE
)
755 error ("Apparently circular structure being printed");
756 #ifdef MAX_PRINT_CHARS
757 if (max_print
&& print_chars
> max_print
)
762 #endif /* MAX_PRINT_CHARS */
764 switch (XGCTYPE (obj
))
767 sprintf (buf
, "%d", XINT (obj
));
768 strout (buf
, -1, printcharfun
);
771 #ifdef LISP_FLOAT_TYPE
774 char pigbuf
[350]; /* see comments in float_to_string */
776 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
777 strout (pigbuf
, -1, printcharfun
);
784 print_string (obj
, printcharfun
);
788 register unsigned char c
;
793 #ifdef USE_TEXT_PROPERTIES
794 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
802 for (i
= 0; i
< XSTRING (obj
)->size
; i
++)
805 c
= XSTRING (obj
)->data
[i
];
806 if (c
== '\n' && print_escape_newlines
)
811 else if (c
== '\f' && print_escape_newlines
)
818 if (c
== '\"' || c
== '\\')
825 #ifdef USE_TEXT_PROPERTIES
826 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
828 traverse_intervals (XSTRING (obj
)->intervals
,
829 0, 0, print_interval
, printcharfun
);
840 register int confusing
;
841 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
842 register unsigned char *end
= p
+ XSYMBOL (obj
)->name
->size
;
843 register unsigned char c
;
845 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
850 while (p
!= end
&& *p
>= '0' && *p
<= '9')
852 confusing
= (end
== p
);
855 p
= XSYMBOL (obj
)->name
->data
;
862 if (c
== '\"' || c
== '\\' || c
== '\'' || c
== ';' || c
== '#' ||
863 c
== '(' || c
== ')' || c
== ',' || c
=='.' || c
== '`' ||
864 c
== '[' || c
== ']' || c
== '?' || c
<= 040 || confusing
)
865 PRINTCHAR ('\\'), confusing
= 0;
873 /* If deeper than spec'd depth, print placeholder. */
874 if (INTEGERP (Vprint_level
)
875 && print_depth
> XINT (Vprint_level
))
876 strout ("...", -1, printcharfun
);
882 register int max
= 0;
884 if (INTEGERP (Vprint_length
))
885 max
= XINT (Vprint_length
);
886 /* Could recognize circularities in cdrs here,
887 but that would make printing of long lists quadratic.
888 It's not worth doing. */
895 strout ("...", 3, printcharfun
);
898 print (Fcar (obj
), printcharfun
, escapeflag
);
902 if (!NILP (obj
) && !CONSP (obj
))
904 strout (" . ", 3, printcharfun
);
905 print (obj
, printcharfun
, escapeflag
);
911 case Lisp_Vectorlike
:
916 strout ("#<process ", -1, printcharfun
);
917 print_string (XPROCESS (obj
)->name
, printcharfun
);
921 print_string (XPROCESS (obj
)->name
, printcharfun
);
923 else if (SUBRP (obj
))
925 strout ("#<subr ", -1, printcharfun
);
926 strout (XSUBR (obj
)->symbol_name
, -1, printcharfun
);
930 else if (WINDOWP (obj
))
932 strout ("#<window ", -1, printcharfun
);
933 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
934 strout (buf
, -1, printcharfun
);
935 if (!NILP (XWINDOW (obj
)->buffer
))
937 strout (" on ", -1, printcharfun
);
938 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
942 else if (BUFFERP (obj
))
944 if (NILP (XBUFFER (obj
)->name
))
945 strout ("#<killed buffer>", -1, printcharfun
);
948 strout ("#<buffer ", -1, printcharfun
);
949 print_string (XBUFFER (obj
)->name
, printcharfun
);
953 print_string (XBUFFER (obj
)->name
, printcharfun
);
955 else if (WINDOW_CONFIGURATIONP (obj
))
957 strout ("#<window-configuration>", -1, printcharfun
);
960 else if (FRAMEP (obj
))
962 strout ((FRAME_LIVE_P (XFRAME (obj
))
963 ? "#<frame " : "#<dead frame "),
965 print_string (XFRAME (obj
)->name
, printcharfun
);
966 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
967 strout (buf
, -1, printcharfun
);
971 #endif /* not standalone */
974 int size
= XVECTOR (obj
)->size
;
978 size
&= PSEUDOVECTOR_SIZE_MASK
;
980 if (size
& PSEUDOVECTOR_FLAG
)
986 register Lisp_Object tem
;
987 for (i
= 0; i
< size
; i
++)
989 if (i
) PRINTCHAR (' ');
990 tem
= XVECTOR (obj
)->contents
[i
];
991 print (tem
, printcharfun
, escapeflag
);
1000 switch (XMISC (obj
)->type
)
1002 case Lisp_Misc_Marker
:
1003 strout ("#<marker ", -1, printcharfun
);
1004 if (!(XMARKER (obj
)->buffer
))
1005 strout ("in no buffer", -1, printcharfun
);
1008 sprintf (buf
, "at %d", marker_position (obj
));
1009 strout (buf
, -1, printcharfun
);
1010 strout (" in ", -1, printcharfun
);
1011 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1016 case Lisp_Misc_Overlay
:
1017 strout ("#<overlay ", -1, printcharfun
);
1018 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1019 strout ("in no buffer", -1, printcharfun
);
1022 sprintf (buf
, "from %d to %d in ",
1023 marker_position (OVERLAY_START (obj
)),
1024 marker_position (OVERLAY_END (obj
)));
1025 strout (buf
, -1, printcharfun
);
1026 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1032 /* Remaining cases shouldn't happen in normal usage, but let's print
1033 them anyway for the benefit of the debugger. */
1034 case Lisp_Misc_Free
:
1035 strout ("#<misc free cell>", -1, printcharfun
);
1038 case Lisp_Misc_Intfwd
:
1039 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1040 strout (buf
, -1, printcharfun
);
1043 case Lisp_Misc_Boolfwd
:
1044 sprintf (buf
, "#<boolfwd to %s>",
1045 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1046 strout (buf
, -1, printcharfun
);
1049 case Lisp_Misc_Objfwd
:
1050 strout (buf
, "#<objfwd to ", -1, printcharfun
);
1051 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1055 case Lisp_Misc_Buffer_Objfwd
:
1056 strout (buf
, "#<buffer_objfwd to ", -1, printcharfun
);
1057 print (*(Lisp_Object
*)((char *)current_buffer
+
1058 XBUFFER_OBJFWD (obj
)->offset
),
1059 printcharfun
, escapeflag
);
1063 case Lisp_Misc_Buffer_Local_Value
:
1064 strout ("#<buffer_local_value ", -1, printcharfun
);
1065 goto do_buffer_local
;
1066 case Lisp_Misc_Some_Buffer_Local_Value
:
1067 strout ("#<some_buffer_local_value ", -1, printcharfun
);
1069 strout ("[realvalue] ", -1, printcharfun
);
1070 print (XBUFFER_LOCAL_VALUE (obj
)->car
, printcharfun
, escapeflag
);
1071 strout ("[buffer] ", -1, printcharfun
);
1072 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1073 printcharfun
, escapeflag
);
1074 strout ("[alist-elt] ", -1, printcharfun
);
1075 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
)->car
,
1076 printcharfun
, escapeflag
);
1077 strout ("[default-value] ", -1, printcharfun
);
1078 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
)->cdr
,
1079 printcharfun
, escapeflag
);
1087 #endif /* standalone */
1092 /* We're in trouble if this happens!
1093 Probably should just abort () */
1094 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, printcharfun
);
1096 sprintf (buf
, "(MISC 0x%04x)", (int) XMISC (obj
)->type
);
1097 else if (VECTORLIKEP (obj
))
1098 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1100 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1101 strout (buf
, -1, printcharfun
);
1102 strout (" Save your buffers immediately and please report this bug>",
1110 #ifdef USE_TEXT_PROPERTIES
1112 /* Print a description of INTERVAL using PRINTCHARFUN.
1113 This is part of printing a string that has text properties. */
1116 print_interval (interval
, printcharfun
)
1118 Lisp_Object printcharfun
;
1121 print (make_number (interval
->position
), printcharfun
, 1);
1123 print (make_number (interval
->position
+ LENGTH (interval
)),
1126 print (interval
->plist
, printcharfun
, 1);
1129 #endif /* USE_TEXT_PROPERTIES */
1134 staticpro (&Qprint_escape_newlines
);
1135 Qprint_escape_newlines
= intern ("print-escape-newlines");
1137 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1138 "Output stream `print' uses by default for outputting a character.\n\
1139 This may be any function of one argument.\n\
1140 It may also be a buffer (output is inserted before point)\n\
1141 or a marker (output is inserted and the marker is advanced)\n\
1142 or the symbol t (output appears in the minibuffer line).");
1143 Vstandard_output
= Qt
;
1144 Qstandard_output
= intern ("standard-output");
1145 staticpro (&Qstandard_output
);
1147 #ifdef LISP_FLOAT_TYPE
1148 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1149 "The format descriptor string used to print floats.\n\
1150 This is a %-spec like those accepted by `printf' in C,\n\
1151 but with some restrictions. It must start with the two characters `%.'.\n\
1152 After that comes an integer precision specification,\n\
1153 and then a letter which controls the format.\n\
1154 The letters allowed are `e', `f' and `g'.\n\
1155 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1156 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1157 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1158 The precision in any of these cases is the number of digits following\n\
1159 the decimal point. With `f', a precision of 0 means to omit the\n\
1160 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1161 A value of nil means to use `%.17g'.");
1162 Vfloat_output_format
= Qnil
;
1163 Qfloat_output_format
= intern ("float-output-format");
1164 staticpro (&Qfloat_output_format
);
1165 #endif /* LISP_FLOAT_TYPE */
1167 DEFVAR_LISP ("print-length", &Vprint_length
,
1168 "Maximum length of list to print before abbreviating.\n\
1169 A value of nil means no limit.");
1170 Vprint_length
= Qnil
;
1172 DEFVAR_LISP ("print-level", &Vprint_level
,
1173 "Maximum depth of list nesting to print before abbreviating.\n\
1174 A value of nil means no limit.");
1175 Vprint_level
= Qnil
;
1177 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1178 "Non-nil means print newlines in strings as backslash-n.\n\
1179 Also print formfeeds as backslash-f.");
1180 print_escape_newlines
= 0;
1182 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1183 staticpro (&Vprin1_to_string_buffer
);
1186 defsubr (&Sprin1_to_string
);
1190 defsubr (&Swrite_char
);
1191 defsubr (&Sexternal_debugging_output
);
1193 Qexternal_debugging_output
= intern ("external-debugging-output");
1194 staticpro (&Qexternal_debugging_output
);
1197 defsubr (&Swith_output_to_temp_buffer
);
1198 #endif /* not standalone */