1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98 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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
32 #include "dispextern.h"
35 #endif /* not standalone */
37 #ifdef USE_TEXT_PROPERTIES
38 #include "intervals.h"
41 Lisp_Object Vstandard_output
, Qstandard_output
;
43 /* These are used to print like we read. */
44 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
46 #ifdef LISP_FLOAT_TYPE
47 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
49 /* Work around a problem that happens because math.h on hpux 7
50 defines two static variables--which, in Emacs, are not really static,
51 because `static' is defined as nothing. The problem is that they are
52 defined both here and in lread.c.
53 These macros prevent the name conflict. */
54 #if defined (HPUX) && !defined (HPUX8)
55 #define _MAXLDBL print_maxldbl
56 #define _NMAXLDBL print_nmaxldbl
66 /* Default to values appropriate for IEEE floating point. */
71 #define DBL_MANT_DIG 53
77 #define DBL_MIN 2.2250738585072014e-308
80 #ifdef DBL_MIN_REPLACEMENT
82 #define DBL_MIN DBL_MIN_REPLACEMENT
85 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
86 needed to express a float without losing information.
87 The general-case formula is valid for the usual case, IEEE floating point,
88 but many compilers can't optimize the formula to an integer constant,
89 so make a special case for it. */
90 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
91 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
93 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
96 #endif /* LISP_FLOAT_TYPE */
98 /* Avoid actual stack overflow in print. */
101 /* Detect most circularities to print finite output. */
102 #define PRINT_CIRCLE 200
103 Lisp_Object being_printed
[PRINT_CIRCLE
];
105 /* When printing into a buffer, first we put the text in this
106 block, then insert it all at once. */
109 /* Size allocated in print_buffer. */
110 int print_buffer_size
;
111 /* Chars stored in print_buffer. */
112 int print_buffer_pos
;
113 /* Bytes stored in print_buffer. */
114 int print_buffer_pos_byte
;
116 /* Maximum length of list to print in full; noninteger means
117 effectively infinity */
119 Lisp_Object Vprint_length
;
121 /* Maximum depth of list to print in full; noninteger means
122 effectively infinity. */
124 Lisp_Object Vprint_level
;
126 /* Nonzero means print newlines in strings as \n. */
128 int print_escape_newlines
;
130 Lisp_Object Qprint_escape_newlines
;
132 /* Nonzero means print (quote foo) forms as 'foo, etc. */
136 /* Non-nil means print #: before uninterned symbols.
137 Neither t nor nil means so that and don't clear Vprint_gensym_alist
138 on entry to and exit from print functions. */
140 Lisp_Object Vprint_gensym
;
142 /* Association list of certain objects that are `eq' in the form being
143 printed and which should be `eq' when read back in, using the #n=object
144 and #n# reader forms. Each element has the form (object . n). */
146 Lisp_Object Vprint_gensym_alist
;
148 /* Nonzero means print newline to stdout before next minibuffer message.
149 Defined in xdisp.c */
151 extern int noninteractive_need_newline
;
153 extern int minibuffer_auto_raise
;
155 #ifdef MAX_PRINT_CHARS
156 static int print_chars
;
157 static int max_print
;
158 #endif /* MAX_PRINT_CHARS */
160 void print_interval ();
163 /* Convert between chars and GLYPHs */
167 register GLYPH
*glyphs
;
177 str_to_glyph_cpy (str
, glyphs
)
181 register GLYPH
*gp
= glyphs
;
182 register char *cp
= str
;
189 str_to_glyph_ncpy (str
, glyphs
, n
)
194 register GLYPH
*gp
= glyphs
;
195 register char *cp
= str
;
202 glyph_to_str_cpy (glyphs
, str
)
206 register GLYPH
*gp
= glyphs
;
207 register char *cp
= str
;
210 *str
++ = *gp
++ & 0377;
214 /* Low level output routines for characters and strings */
216 /* Lisp functions to do output using a stream
217 must have the stream in a variable called printcharfun
218 and must start with PRINTPREPARE, end with PRINTFINISH,
219 and use PRINTDECLARE to declare common variables.
220 Use PRINTCHAR to output one character,
221 or call strout to output a block of characters.
224 #define PRINTDECLARE \
225 struct buffer *old = current_buffer; \
226 int old_point = -1, start_point; \
227 int old_point_byte, start_point_byte; \
228 int specpdl_count = specpdl_ptr - specpdl; \
229 int free_print_buffer = 0; \
232 #define PRINTPREPARE \
233 original = printcharfun; \
234 if (NILP (printcharfun)) printcharfun = Qt; \
235 if (BUFFERP (printcharfun)) \
237 if (XBUFFER (printcharfun) != current_buffer) \
238 Fset_buffer (printcharfun); \
239 printcharfun = Qnil; \
241 if (MARKERP (printcharfun)) \
243 if (!(XMARKER (original)->buffer)) \
244 error ("Marker does not point anywhere"); \
245 if (XMARKER (original)->buffer != current_buffer) \
246 set_buffer_internal (XMARKER (original)->buffer); \
248 old_point_byte = PT_BYTE; \
249 SET_PT_BOTH (marker_position (printcharfun), \
250 marker_byte_position (printcharfun)); \
252 start_point_byte = PT_BYTE; \
253 printcharfun = Qnil; \
255 if (NILP (printcharfun)) \
257 Lisp_Object string; \
258 if (print_buffer != 0) \
260 string = make_multibyte_string (print_buffer, \
262 print_buffer_pos_byte); \
263 record_unwind_protect (print_unwind, string); \
267 print_buffer_size = 1000; \
268 print_buffer = (char *) xmalloc (print_buffer_size); \
269 free_print_buffer = 1; \
271 print_buffer_pos = 0; \
272 print_buffer_pos_byte = 0; \
274 if (!CONSP (Vprint_gensym)) \
275 Vprint_gensym_alist = Qnil
277 #define PRINTFINISH \
278 if (NILP (printcharfun)) \
279 insert_1_both (print_buffer, print_buffer_pos, \
280 print_buffer_pos_byte, 0, 1, 0); \
281 if (free_print_buffer) \
283 xfree (print_buffer); \
286 unbind_to (specpdl_count, Qnil); \
287 if (MARKERP (original)) \
288 set_marker_both (original, Qnil, PT, PT_BYTE); \
289 if (old_point >= 0) \
290 SET_PT_BOTH (old_point + (old_point >= start_point \
291 ? PT - start_point : 0), \
292 old_point_byte + (old_point_byte >= start_point_byte \
293 ? PT_BYTE - start_point_byte : 0)); \
294 if (old != current_buffer) \
295 set_buffer_internal (old); \
296 if (!CONSP (Vprint_gensym)) \
297 Vprint_gensym_alist = Qnil
299 #define PRINTCHAR(ch) printchar (ch, printcharfun)
301 /* Nonzero if there is no room to print any more characters
302 so print might as well return right away. */
304 #define PRINTFULLP() \
305 (EQ (printcharfun, Qt) && !noninteractive \
306 && printbufidx >= FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)))))
308 /* This is used to restore the saved contents of print_buffer
309 when there is a recursive call to print. */
311 print_unwind (saved_text
)
312 Lisp_Object saved_text
;
314 bcopy (XSTRING (saved_text
)->data
, print_buffer
, XSTRING (saved_text
)->size
);
317 /* Index of first unused element of FRAME_MESSAGE_BUF (mini_frame). */
318 static int printbufidx
;
327 #ifdef MAX_PRINT_CHARS
330 #endif /* MAX_PRINT_CHARS */
335 unsigned char work
[4], *str
;
338 len
= CHAR_STRING (ch
, work
, str
);
339 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
340 print_buffer
= (char *) xrealloc (print_buffer
,
341 print_buffer_size
*= 2);
342 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
343 print_buffer_pos
+= 1;
344 print_buffer_pos_byte
+= len
;
351 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
352 unsigned char work
[4], *str
;
353 int len
= CHAR_STRING (ch
, work
, str
);
360 putchar (*str
), str
++;
361 noninteractive_need_newline
= 1;
365 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
366 || !message_buf_print
)
368 message_log_maybe_newline ();
369 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
371 echo_area_glyphs_length
= 0;
372 message_buf_print
= 1;
374 if (minibuffer_auto_raise
)
376 Lisp_Object mini_window
;
378 /* Get the frame containing the minibuffer
379 that the selected frame is using. */
380 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
382 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
386 message_dolog (str
, len
, 0, len
> 1);
388 /* Convert message to multibyte if we are now adding multibyte text. */
389 if (! NILP (current_buffer
->enable_multibyte_characters
)
390 && ! message_enable_multibyte
393 int size
= count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame
),
395 unsigned char *tembuf
= (unsigned char *) alloca (size
+ 1);
396 copy_text (FRAME_MESSAGE_BUF (mini_frame
), tembuf
, printbufidx
,
399 if (printbufidx
> FRAME_MESSAGE_BUF_SIZE (mini_frame
))
400 printbufidx
= FRAME_MESSAGE_BUF_SIZE (mini_frame
);
401 bcopy (tembuf
, FRAME_MESSAGE_BUF (mini_frame
), printbufidx
);
403 message_enable_multibyte
404 = ! NILP (current_buffer
->enable_multibyte_characters
);
406 if (printbufidx
< FRAME_MESSAGE_BUF_SIZE (mini_frame
) - len
)
407 bcopy (str
, &FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
], len
),
409 FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
] = 0;
410 echo_area_glyphs_length
= printbufidx
;
414 #endif /* not standalone */
416 XSETFASTINT (ch1
, ch
);
421 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
424 Lisp_Object printcharfun
;
430 size_byte
= size
= strlen (ptr
);
432 if (EQ (printcharfun
, Qnil
))
434 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
436 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
437 print_buffer
= (char *) xrealloc (print_buffer
,
440 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
441 print_buffer_pos
+= size
;
442 print_buffer_pos_byte
+= size_byte
;
444 #ifdef MAX_PRINT_CHARS
447 #endif /* MAX_PRINT_CHARS */
450 if (EQ (printcharfun
, Qt
))
453 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
457 #ifdef MAX_PRINT_CHARS
460 #endif /* MAX_PRINT_CHARS */
464 fwrite (ptr
, 1, size_byte
, stdout
);
465 noninteractive_need_newline
= 1;
469 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
470 || !message_buf_print
)
472 message_log_maybe_newline ();
473 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
475 echo_area_glyphs_length
= 0;
476 message_buf_print
= 1;
478 if (minibuffer_auto_raise
)
480 Lisp_Object mini_window
;
482 /* Get the frame containing the minibuffer
483 that the selected frame is using. */
484 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
486 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
490 message_dolog (ptr
, size_byte
, 0, multibyte
);
491 if (size_byte
> FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1)
493 size_byte
= FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1;
494 /* Rewind incomplete multi-byte form. */
495 while (size_byte
&& (unsigned char) ptr
[size
] >= 0xA0) size
--;
497 bcopy (ptr
, &FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
], size_byte
);
498 printbufidx
+= size_byte
;
499 echo_area_glyphs_length
= printbufidx
;
500 FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
] = 0;
506 if (size
== size_byte
)
507 while (i
< size_byte
)
514 while (i
< size_byte
)
516 /* Here, we must convert each multi-byte form to the
517 corresponding character code before handing it to PRINTCHAR. */
519 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
526 /* Print the contents of a string STRING using PRINTCHARFUN.
527 It isn't safe to use strout in many cases,
528 because printing one char can relocate. */
531 print_string (string
, printcharfun
)
533 Lisp_Object printcharfun
;
535 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
536 /* strout is safe for output to a frame (echo area) or to print_buffer. */
537 strout (XSTRING (string
)->data
,
538 XSTRING (string
)->size
,
539 XSTRING (string
)->size_byte
,
540 printcharfun
, STRING_MULTIBYTE (string
));
543 /* Otherwise, string may be relocated by printing one char.
544 So re-fetch the string address for each character. */
546 int size
= XSTRING (string
)->size
;
547 int size_byte
= XSTRING (string
)->size_byte
;
550 if (size
== size_byte
)
551 for (i
= 0; i
< size
; i
++)
552 PRINTCHAR (XSTRING (string
)->data
[i
]);
554 for (i
= 0; i
< size_byte
; i
++)
556 /* Here, we must convert each multi-byte form to the
557 corresponding character code before handing it to PRINTCHAR. */
559 int ch
= STRING_CHAR_AND_LENGTH (XSTRING (string
)->data
+ i
,
569 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
570 "Output character CHARACTER to stream PRINTCHARFUN.\n\
571 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
572 (character
, printcharfun
)
573 Lisp_Object character
, printcharfun
;
577 if (NILP (printcharfun
))
578 printcharfun
= Vstandard_output
;
579 CHECK_NUMBER (character
, 0);
581 PRINTCHAR (XINT (character
));
586 /* Used from outside of print.c to print a block of SIZE
587 single-byte chars at DATA on the default output stream.
588 Do not use this on the contents of a Lisp string. */
591 write_string (data
, size
)
596 Lisp_Object printcharfun
;
598 printcharfun
= Vstandard_output
;
601 strout (data
, size
, size
, printcharfun
, 0);
605 /* Used from outside of print.c to print a block of SIZE
606 single-byte chars at DATA on a specified stream PRINTCHARFUN.
607 Do not use this on the contents of a Lisp string. */
610 write_string_1 (data
, size
, printcharfun
)
613 Lisp_Object printcharfun
;
618 strout (data
, size
, size
, printcharfun
, 0);
626 temp_output_buffer_setup (bufname
)
629 register struct buffer
*old
= current_buffer
;
630 register Lisp_Object buf
;
632 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
634 current_buffer
->directory
= old
->directory
;
635 current_buffer
->read_only
= Qnil
;
638 XSETBUFFER (buf
, current_buffer
);
639 specbind (Qstandard_output
, buf
);
641 set_buffer_internal (old
);
645 internal_with_output_to_temp_buffer (bufname
, function
, args
)
647 Lisp_Object (*function
) ();
650 int count
= specpdl_ptr
- specpdl
;
651 Lisp_Object buf
, val
;
655 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
656 temp_output_buffer_setup (bufname
);
657 buf
= Vstandard_output
;
660 val
= (*function
) (args
);
663 temp_output_buffer_show (buf
);
666 return unbind_to (count
, val
);
669 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
671 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
672 The buffer is cleared out initially, and marked as unmodified when done.\n\
673 All output done by BODY is inserted in that buffer by default.\n\
674 The buffer is displayed in another window, but not selected.\n\
675 The value of the last form in BODY is returned.\n\
676 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
677 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
678 to get the buffer displayed. It gets one argument, the buffer to display.")
684 int count
= specpdl_ptr
- specpdl
;
685 Lisp_Object buf
, val
;
688 name
= Feval (Fcar (args
));
691 CHECK_STRING (name
, 0);
692 temp_output_buffer_setup (XSTRING (name
)->data
);
693 buf
= Vstandard_output
;
695 val
= Fprogn (Fcdr (args
));
697 temp_output_buffer_show (buf
);
699 return unbind_to (count
, val
);
701 #endif /* not standalone */
703 static void print ();
705 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
706 "Output a newline to stream PRINTCHARFUN.\n\
707 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
709 Lisp_Object printcharfun
;
713 if (NILP (printcharfun
))
714 printcharfun
= Vstandard_output
;
721 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
722 "Output the printed representation of OBJECT, any Lisp object.\n\
723 Quoting characters are printed when needed to make output that `read'\n\
724 can handle, whenever this is possible.\n\
725 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
726 (object
, printcharfun
)
727 Lisp_Object object
, printcharfun
;
731 #ifdef MAX_PRINT_CHARS
733 #endif /* MAX_PRINT_CHARS */
734 if (NILP (printcharfun
))
735 printcharfun
= Vstandard_output
;
738 print (object
, printcharfun
, 1);
743 /* a buffer which is used to hold output being built by prin1-to-string */
744 Lisp_Object Vprin1_to_string_buffer
;
746 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
747 "Return a string containing the printed representation of OBJECT,\n\
748 any Lisp object. Quoting characters are used when needed to make output\n\
749 that `read' can handle, whenever this is possible, unless the optional\n\
750 second argument NOESCAPE is non-nil.")
752 Lisp_Object object
, noescape
;
755 Lisp_Object printcharfun
;
756 struct gcpro gcpro1
, gcpro2
;
759 /* Save and restore this--we are altering a buffer
760 but we don't want to deactivate the mark just for that.
761 No need for specbind, since errors deactivate the mark. */
762 tem
= Vdeactivate_mark
;
763 GCPRO2 (object
, tem
);
765 printcharfun
= Vprin1_to_string_buffer
;
768 print (object
, printcharfun
, NILP (noescape
));
769 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
771 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
772 object
= Fbuffer_string ();
775 set_buffer_internal (old
);
777 Vdeactivate_mark
= tem
;
783 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
784 "Output the printed representation of OBJECT, any Lisp object.\n\
785 No quoting characters are used; no delimiters are printed around\n\
786 the contents of strings.\n\
787 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
788 (object
, printcharfun
)
789 Lisp_Object object
, printcharfun
;
793 if (NILP (printcharfun
))
794 printcharfun
= Vstandard_output
;
797 print (object
, printcharfun
, 0);
802 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
803 "Output the printed representation of OBJECT, with newlines around it.\n\
804 Quoting characters are printed when needed to make output that `read'\n\
805 can handle, whenever this is possible.\n\
806 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
807 (object
, printcharfun
)
808 Lisp_Object object
, printcharfun
;
813 #ifdef MAX_PRINT_CHARS
815 max_print
= MAX_PRINT_CHARS
;
816 #endif /* MAX_PRINT_CHARS */
817 if (NILP (printcharfun
))
818 printcharfun
= Vstandard_output
;
823 print (object
, printcharfun
, 1);
826 #ifdef MAX_PRINT_CHARS
829 #endif /* MAX_PRINT_CHARS */
834 /* The subroutine object for external-debugging-output is kept here
835 for the convenience of the debugger. */
836 Lisp_Object Qexternal_debugging_output
;
838 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
839 "Write CHARACTER to stderr.\n\
840 You can call print while debugging emacs, and pass it this function\n\
841 to make it write to the debugging output.\n")
843 Lisp_Object character
;
845 CHECK_NUMBER (character
, 0);
846 putc (XINT (character
), stderr
);
849 /* Send the output to a debugger (nothing happens if there isn't one). */
851 char buf
[2] = {(char) XINT (character
), '\0'};
852 OutputDebugString (buf
);
859 /* This is the interface for debugging printing. */
865 Fprin1 (arg
, Qexternal_debugging_output
);
866 fprintf (stderr
, "\r\n");
869 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
871 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
875 struct buffer
*old
= current_buffer
;
876 Lisp_Object original
, printcharfun
, value
;
879 /* If OBJ is (error STRING), just return STRING.
880 That is not only faster, it also avoids the need to allocate
881 space here when the error is due to memory full. */
882 if (CONSP (obj
) && EQ (XCONS (obj
)->car
, Qerror
)
883 && CONSP (XCONS (obj
)->cdr
)
884 && STRINGP (XCONS (XCONS (obj
)->cdr
)->car
)
885 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
886 return XCONS (XCONS (obj
)->cdr
)->car
;
888 print_error_message (obj
, Vprin1_to_string_buffer
);
890 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
891 value
= Fbuffer_string ();
895 set_buffer_internal (old
);
901 /* Print an error message for the error DATA
902 onto Lisp output stream STREAM (suitable for the print functions). */
905 print_error_message (data
, stream
)
906 Lisp_Object data
, stream
;
908 Lisp_Object errname
, errmsg
, file_error
, tail
;
912 errname
= Fcar (data
);
914 if (EQ (errname
, Qerror
))
917 if (!CONSP (data
)) data
= Qnil
;
918 errmsg
= Fcar (data
);
923 errmsg
= Fget (errname
, Qerror_message
);
924 file_error
= Fmemq (Qfile_error
,
925 Fget (errname
, Qerror_conditions
));
928 /* Print an error message including the data items. */
930 tail
= Fcdr_safe (data
);
933 /* For file-error, make error message by concatenating
934 all the data items. They are all strings. */
935 if (!NILP (file_error
) && !NILP (tail
))
936 errmsg
= XCONS (tail
)->car
, tail
= XCONS (tail
)->cdr
;
938 if (STRINGP (errmsg
))
939 Fprinc (errmsg
, stream
);
941 write_string_1 ("peculiar error", -1, stream
);
943 for (i
= 0; CONSP (tail
); tail
= Fcdr (tail
), i
++)
945 write_string_1 (i
? ", " : ": ", 2, stream
);
946 if (!NILP (file_error
))
947 Fprinc (Fcar (tail
), stream
);
949 Fprin1 (Fcar (tail
), stream
);
954 #ifdef LISP_FLOAT_TYPE
957 * The buffer should be at least as large as the max string size of the
958 * largest float, printed in the biggest notation. This is undoubtedly
959 * 20d float_output_format, with the negative of the C-constant "HUGE"
962 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
964 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
965 * case of -1e307 in 20d float_output_format. What is one to do (short of
966 * re-writing _doprnt to be more sane)?
971 float_to_string (buf
, data
)
978 /* Check for plus infinity in a way that won't lose
979 if there is no plus infinity. */
980 if (data
== data
/ 2 && data
> 1.0)
982 strcpy (buf
, "1.0e+INF");
985 /* Likewise for minus infinity. */
986 if (data
== data
/ 2 && data
< -1.0)
988 strcpy (buf
, "-1.0e+INF");
991 /* Check for NaN in a way that won't fail if there are no NaNs. */
992 if (! (data
* 0.0 >= 0.0))
994 strcpy (buf
, "0.0e+NaN");
998 if (NILP (Vfloat_output_format
)
999 || !STRINGP (Vfloat_output_format
))
1002 /* Generate the fewest number of digits that represent the
1003 floating point value without losing information.
1004 The following method is simple but a bit slow.
1005 For ideas about speeding things up, please see:
1007 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1008 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1010 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1011 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1013 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1015 sprintf (buf
, "%.*g", width
, data
);
1016 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1018 else /* oink oink */
1020 /* Check that the spec we have is fully valid.
1021 This means not only valid for printf,
1022 but meant for floats, and reasonable. */
1023 cp
= XSTRING (Vfloat_output_format
)->data
;
1032 /* Check the width specification. */
1034 if ('0' <= *cp
&& *cp
<= '9')
1038 width
= (width
* 10) + (*cp
++ - '0');
1039 while (*cp
>= '0' && *cp
<= '9');
1041 /* A precision of zero is valid only for %f. */
1043 || (width
== 0 && *cp
!= 'f'))
1047 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1053 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
1056 /* Make sure there is a decimal point with digit after, or an
1057 exponent, so that the value is readable as a float. But don't do
1058 this with "%.0f"; it's valid for that not to produce a decimal
1059 point. Note that width can be 0 only for %.0f. */
1062 for (cp
= buf
; *cp
; cp
++)
1063 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1066 if (*cp
== '.' && cp
[1] == 0)
1080 #endif /* LISP_FLOAT_TYPE */
1083 print (obj
, printcharfun
, escapeflag
)
1085 register Lisp_Object printcharfun
;
1092 #if 1 /* I'm not sure this is really worth doing. */
1093 /* Detect circularities and truncate them.
1094 No need to offer any alternative--this is better than an error. */
1095 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
1098 for (i
= 0; i
< print_depth
; i
++)
1099 if (EQ (obj
, being_printed
[i
]))
1101 sprintf (buf
, "#%d", i
);
1102 strout (buf
, -1, -1, printcharfun
, 0);
1108 being_printed
[print_depth
] = obj
;
1111 if (print_depth
> PRINT_CIRCLE
)
1112 error ("Apparently circular structure being printed");
1113 #ifdef MAX_PRINT_CHARS
1114 if (max_print
&& print_chars
> max_print
)
1119 #endif /* MAX_PRINT_CHARS */
1121 switch (XGCTYPE (obj
))
1124 if (sizeof (int) == sizeof (EMACS_INT
))
1125 sprintf (buf
, "%d", XINT (obj
));
1126 else if (sizeof (long) == sizeof (EMACS_INT
))
1127 sprintf (buf
, "%ld", XINT (obj
));
1130 strout (buf
, -1, -1, printcharfun
, 0);
1133 #ifdef LISP_FLOAT_TYPE
1136 char pigbuf
[350]; /* see comments in float_to_string */
1138 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
1139 strout (pigbuf
, -1, -1, printcharfun
, 0);
1146 print_string (obj
, printcharfun
);
1149 register int i
, i_byte
;
1150 register unsigned char c
;
1151 struct gcpro gcpro1
;
1156 #ifdef USE_TEXT_PROPERTIES
1157 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1165 size_byte
= XSTRING (obj
)->size_byte
;
1167 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1169 /* Here, we must convert each multi-byte form to the
1170 corresponding character code before handing it to PRINTCHAR. */
1174 if (STRING_MULTIBYTE (obj
))
1175 FETCH_STRING_CHAR_ADVANCE (c
, obj
, i
, i_byte
);
1177 c
= XSTRING (obj
)->data
[i_byte
++];
1181 if (c
== '\n' && print_escape_newlines
)
1186 else if (c
== '\f' && print_escape_newlines
)
1191 else if ((! SINGLE_BYTE_CHAR_P (c
)
1192 && NILP (current_buffer
->enable_multibyte_characters
)))
1194 /* When multibyte is disabled,
1195 print multibyte string chars using hex escapes. */
1196 unsigned char outbuf
[50];
1197 sprintf (outbuf
, "\\x%x", c
);
1198 strout (outbuf
, -1, -1, printcharfun
, 0);
1200 else if (SINGLE_BYTE_CHAR_P (c
)
1201 && ! ASCII_BYTE_P (c
)
1202 && ! NILP (current_buffer
->enable_multibyte_characters
))
1204 /* When multibyte is enabled,
1205 print single-byte non-ASCII string chars
1206 using octal escapes. */
1207 unsigned char outbuf
[5];
1208 sprintf (outbuf
, "\\%03o", c
);
1209 strout (outbuf
, -1, -1, printcharfun
, 0);
1213 if (c
== '\"' || c
== '\\')
1220 #ifdef USE_TEXT_PROPERTIES
1221 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1223 traverse_intervals (XSTRING (obj
)->intervals
,
1224 0, 0, print_interval
, printcharfun
);
1235 register int confusing
;
1236 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
1237 register unsigned char *end
= p
+ XSYMBOL (obj
)->name
->size_byte
;
1239 int i
, i_byte
, size_byte
;
1242 XSETSTRING (name
, XSYMBOL (obj
)->name
);
1244 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1247 /* If symbol name begins with a digit, and ends with a digit,
1248 and contains nothing but digits and `e', it could be treated
1249 as a number. So set CONFUSING.
1251 Symbols that contain periods could also be taken as numbers,
1252 but periods are always escaped, so we don't have to worry
1254 else if (*p
>= '0' && *p
<= '9'
1255 && end
[-1] >= '0' && end
[-1] <= '9')
1257 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1258 /* Needed for \2e10. */
1261 confusing
= (end
== p
);
1266 /* If we print an uninterned symbol as part of a complex object and
1267 the flag print-gensym is non-nil, prefix it with #n= to read the
1268 object back with the #n# reader syntax later if needed. */
1269 if (! NILP (Vprint_gensym
) && NILP (XSYMBOL (obj
)->obarray
))
1271 if (print_depth
> 1)
1274 tem
= Fassq (obj
, Vprint_gensym_alist
);
1278 print (XCDR (tem
), printcharfun
, escapeflag
);
1284 if (CONSP (Vprint_gensym_alist
))
1285 XSETFASTINT (tem
, XFASTINT (XCDR (XCAR (Vprint_gensym_alist
))) + 1);
1287 XSETFASTINT (tem
, 1);
1288 Vprint_gensym_alist
= Fcons (Fcons (obj
, tem
), Vprint_gensym_alist
);
1291 print (tem
, printcharfun
, escapeflag
);
1299 size_byte
= XSTRING (name
)->size_byte
;
1301 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1303 /* Here, we must convert each multi-byte form to the
1304 corresponding character code before handing it to PRINTCHAR. */
1306 if (STRING_MULTIBYTE (name
))
1307 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1309 c
= XSTRING (name
)->data
[i_byte
++];
1315 if (c
== '\"' || c
== '\\' || c
== '\''
1316 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1317 || c
== ',' || c
=='.' || c
== '`'
1318 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1320 PRINTCHAR ('\\'), confusing
= 0;
1328 /* If deeper than spec'd depth, print placeholder. */
1329 if (INTEGERP (Vprint_level
)
1330 && print_depth
> XINT (Vprint_level
))
1331 strout ("...", -1, -1, printcharfun
, 0);
1332 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1333 && (EQ (XCAR (obj
), Qquote
)))
1336 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1338 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1339 && (EQ (XCAR (obj
), Qfunction
)))
1343 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1345 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1346 && ((EQ (XCAR (obj
), Qbackquote
)
1347 || EQ (XCAR (obj
), Qcomma
)
1348 || EQ (XCAR (obj
), Qcomma_at
)
1349 || EQ (XCAR (obj
), Qcomma_dot
))))
1351 print (XCAR (obj
), printcharfun
, 0);
1352 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1359 register int max
= 0;
1361 if (INTEGERP (Vprint_length
))
1362 max
= XINT (Vprint_length
);
1363 /* Could recognize circularities in cdrs here,
1364 but that would make printing of long lists quadratic.
1365 It's not worth doing. */
1372 strout ("...", 3, 3, printcharfun
, 0);
1375 print (XCAR (obj
), printcharfun
, escapeflag
);
1381 strout (" . ", 3, 3, printcharfun
, 0);
1382 print (obj
, printcharfun
, escapeflag
);
1388 case Lisp_Vectorlike
:
1393 strout ("#<process ", -1, -1, printcharfun
, 0);
1394 print_string (XPROCESS (obj
)->name
, printcharfun
);
1398 print_string (XPROCESS (obj
)->name
, printcharfun
);
1400 else if (BOOL_VECTOR_P (obj
))
1403 register unsigned char c
;
1404 struct gcpro gcpro1
;
1406 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1412 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1413 strout (buf
, -1, -1, printcharfun
, 0);
1416 /* Don't print more characters than the specified maximum. */
1417 if (INTEGERP (Vprint_length
)
1418 && XINT (Vprint_length
) < size_in_chars
)
1419 size_in_chars
= XINT (Vprint_length
);
1421 for (i
= 0; i
< size_in_chars
; i
++)
1424 c
= XBOOL_VECTOR (obj
)->data
[i
];
1425 if (c
== '\n' && print_escape_newlines
)
1430 else if (c
== '\f' && print_escape_newlines
)
1437 if (c
== '\"' || c
== '\\')
1446 else if (SUBRP (obj
))
1448 strout ("#<subr ", -1, -1, printcharfun
, 0);
1449 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1453 else if (WINDOWP (obj
))
1455 strout ("#<window ", -1, -1, printcharfun
, 0);
1456 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1457 strout (buf
, -1, -1, printcharfun
, 0);
1458 if (!NILP (XWINDOW (obj
)->buffer
))
1460 strout (" on ", -1, -1, printcharfun
, 0);
1461 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1465 else if (BUFFERP (obj
))
1467 if (NILP (XBUFFER (obj
)->name
))
1468 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1469 else if (escapeflag
)
1471 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1472 print_string (XBUFFER (obj
)->name
, printcharfun
);
1476 print_string (XBUFFER (obj
)->name
, printcharfun
);
1478 else if (WINDOW_CONFIGURATIONP (obj
))
1480 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1482 else if (FRAMEP (obj
))
1484 strout ((FRAME_LIVE_P (XFRAME (obj
))
1485 ? "#<frame " : "#<dead frame "),
1486 -1, -1, printcharfun
, 0);
1487 print_string (XFRAME (obj
)->name
, printcharfun
);
1488 sprintf (buf
, " 0x%lx\\ ", (unsigned long) (XFRAME (obj
)));
1489 strout (buf
, -1, -1, printcharfun
, 0);
1492 #endif /* not standalone */
1495 int size
= XVECTOR (obj
)->size
;
1496 if (COMPILEDP (obj
))
1499 size
&= PSEUDOVECTOR_SIZE_MASK
;
1501 if (CHAR_TABLE_P (obj
))
1503 /* We print a char-table as if it were a vector,
1504 lumping the parent and default slots in with the
1505 character slots. But we add #^ as a prefix. */
1508 if (SUB_CHAR_TABLE_P (obj
))
1510 size
&= PSEUDOVECTOR_SIZE_MASK
;
1512 if (size
& PSEUDOVECTOR_FLAG
)
1518 register Lisp_Object tem
;
1520 /* Don't print more elements than the specified maximum. */
1521 if (INTEGERP (Vprint_length
)
1522 && XINT (Vprint_length
) < size
)
1523 size
= XINT (Vprint_length
);
1525 for (i
= 0; i
< size
; i
++)
1527 if (i
) PRINTCHAR (' ');
1528 tem
= XVECTOR (obj
)->contents
[i
];
1529 print (tem
, printcharfun
, escapeflag
);
1538 switch (XMISCTYPE (obj
))
1540 case Lisp_Misc_Marker
:
1541 strout ("#<marker ", -1, -1, printcharfun
, 0);
1542 /* Do you think this is necessary? */
1543 if (XMARKER (obj
)->insertion_type
!= 0)
1544 strout ("(before-insertion) ", -1, -1, printcharfun
, 0);
1545 if (!(XMARKER (obj
)->buffer
))
1546 strout ("in no buffer", -1, -1, printcharfun
, 0);
1549 sprintf (buf
, "at %d", marker_position (obj
));
1550 strout (buf
, -1, -1, printcharfun
, 0);
1551 strout (" in ", -1, -1, printcharfun
, 0);
1552 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1557 case Lisp_Misc_Overlay
:
1558 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1559 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1560 strout ("in no buffer", -1, -1, printcharfun
, 0);
1563 sprintf (buf
, "from %d to %d in ",
1564 marker_position (OVERLAY_START (obj
)),
1565 marker_position (OVERLAY_END (obj
)));
1566 strout (buf
, -1, -1, printcharfun
, 0);
1567 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1573 /* Remaining cases shouldn't happen in normal usage, but let's print
1574 them anyway for the benefit of the debugger. */
1575 case Lisp_Misc_Free
:
1576 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1579 case Lisp_Misc_Intfwd
:
1580 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1581 strout (buf
, -1, -1, printcharfun
, 0);
1584 case Lisp_Misc_Boolfwd
:
1585 sprintf (buf
, "#<boolfwd to %s>",
1586 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1587 strout (buf
, -1, -1, printcharfun
, 0);
1590 case Lisp_Misc_Objfwd
:
1591 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
1592 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1596 case Lisp_Misc_Buffer_Objfwd
:
1597 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
1598 print (*(Lisp_Object
*)((char *)current_buffer
1599 + XBUFFER_OBJFWD (obj
)->offset
),
1600 printcharfun
, escapeflag
);
1604 case Lisp_Misc_Kboard_Objfwd
:
1605 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
1606 print (*(Lisp_Object
*)((char *) current_kboard
1607 + XKBOARD_OBJFWD (obj
)->offset
),
1608 printcharfun
, escapeflag
);
1612 case Lisp_Misc_Buffer_Local_Value
:
1613 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
1614 goto do_buffer_local
;
1615 case Lisp_Misc_Some_Buffer_Local_Value
:
1616 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
1618 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
1619 print (XBUFFER_LOCAL_VALUE (obj
)->car
, printcharfun
, escapeflag
);
1620 strout ("[buffer] ", -1, -1, printcharfun
, 0);
1621 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1622 printcharfun
, escapeflag
);
1623 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
1624 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
)->car
,
1625 printcharfun
, escapeflag
);
1626 strout ("[default-value] ", -1, -1, printcharfun
, 0);
1627 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
)->cdr
,
1628 printcharfun
, escapeflag
);
1636 #endif /* standalone */
1641 /* We're in trouble if this happens!
1642 Probably should just abort () */
1643 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
1645 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1646 else if (VECTORLIKEP (obj
))
1647 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1649 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1650 strout (buf
, -1, -1, printcharfun
, 0);
1651 strout (" Save your buffers immediately and please report this bug>",
1652 -1, -1, printcharfun
, 0);
1659 #ifdef USE_TEXT_PROPERTIES
1661 /* Print a description of INTERVAL using PRINTCHARFUN.
1662 This is part of printing a string that has text properties. */
1665 print_interval (interval
, printcharfun
)
1667 Lisp_Object printcharfun
;
1670 print (make_number (interval
->position
), printcharfun
, 1);
1672 print (make_number (interval
->position
+ LENGTH (interval
)),
1675 print (interval
->plist
, printcharfun
, 1);
1678 #endif /* USE_TEXT_PROPERTIES */
1683 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1684 "Output stream `print' uses by default for outputting a character.\n\
1685 This may be any function of one argument.\n\
1686 It may also be a buffer (output is inserted before point)\n\
1687 or a marker (output is inserted and the marker is advanced)\n\
1688 or the symbol t (output appears in the echo area).");
1689 Vstandard_output
= Qt
;
1690 Qstandard_output
= intern ("standard-output");
1691 staticpro (&Qstandard_output
);
1693 #ifdef LISP_FLOAT_TYPE
1694 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1695 "The format descriptor string used to print floats.\n\
1696 This is a %-spec like those accepted by `printf' in C,\n\
1697 but with some restrictions. It must start with the two characters `%.'.\n\
1698 After that comes an integer precision specification,\n\
1699 and then a letter which controls the format.\n\
1700 The letters allowed are `e', `f' and `g'.\n\
1701 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1702 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1703 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1704 The precision in any of these cases is the number of digits following\n\
1705 the decimal point. With `f', a precision of 0 means to omit the\n\
1706 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1707 A value of nil means to use the shortest notation\n\
1708 that represents the number without losing information.");
1709 Vfloat_output_format
= Qnil
;
1710 Qfloat_output_format
= intern ("float-output-format");
1711 staticpro (&Qfloat_output_format
);
1712 #endif /* LISP_FLOAT_TYPE */
1714 DEFVAR_LISP ("print-length", &Vprint_length
,
1715 "Maximum length of list to print before abbreviating.\n\
1716 A value of nil means no limit.");
1717 Vprint_length
= Qnil
;
1719 DEFVAR_LISP ("print-level", &Vprint_level
,
1720 "Maximum depth of list nesting to print before abbreviating.\n\
1721 A value of nil means no limit.");
1722 Vprint_level
= Qnil
;
1724 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1725 "Non-nil means print newlines in strings as backslash-n.\n\
1726 Also print formfeeds as backslash-f.");
1727 print_escape_newlines
= 0;
1729 DEFVAR_BOOL ("print-quoted", &print_quoted
,
1730 "Non-nil means print quoted forms with reader syntax.\n\
1731 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\
1732 forms print in the new syntax.");
1735 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
1736 "Non-nil means print uninterned symbols so they will read as uninterned.\n\
1737 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\
1738 When the uninterned symbol appears within a larger data structure,\n\
1739 in addition use the #...# and #...= constructs as needed,\n\
1740 so that multiple references to the same symbol are shared once again\n\
1741 when the text is read back.\n\
1743 If the value of `print-gensym' is a cons cell, then in addition refrain from\n\
1744 clearing `print-gensym-alist' on entry to and exit from printing functions,\n\
1745 so that the use of #...# and #...= can carry over for several separately\n\
1747 Vprint_gensym
= Qnil
;
1749 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist
,
1750 "Association list of elements (GENSYM . N) to guide use of #N# and #N=.\n\
1751 In each element, GENSYM is an uninterned symbol that has been associated\n\
1752 with #N= for the specified value of N.");
1753 Vprint_gensym_alist
= Qnil
;
1755 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1756 staticpro (&Vprin1_to_string_buffer
);
1759 defsubr (&Sprin1_to_string
);
1760 defsubr (&Serror_message_string
);
1764 defsubr (&Swrite_char
);
1765 defsubr (&Sexternal_debugging_output
);
1767 Qexternal_debugging_output
= intern ("external-debugging-output");
1768 staticpro (&Qexternal_debugging_output
);
1770 Qprint_escape_newlines
= intern ("print-escape-newlines");
1771 staticpro (&Qprint_escape_newlines
);
1774 defsubr (&Swith_output_to_temp_buffer
);
1775 #endif /* not standalone */