1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 1998
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
33 #include "dispextern.h"
36 #endif /* not standalone */
38 #ifdef USE_TEXT_PROPERTIES
39 #include "intervals.h"
42 Lisp_Object Vstandard_output
, Qstandard_output
;
44 /* These are used to print like we read. */
45 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
47 #ifdef LISP_FLOAT_TYPE
48 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
50 /* Work around a problem that happens because math.h on hpux 7
51 defines two static variables--which, in Emacs, are not really static,
52 because `static' is defined as nothing. The problem is that they are
53 defined both here and in lread.c.
54 These macros prevent the name conflict. */
55 #if defined (HPUX) && !defined (HPUX8)
56 #define _MAXLDBL print_maxldbl
57 #define _NMAXLDBL print_nmaxldbl
67 /* Default to values appropriate for IEEE floating point. */
72 #define DBL_MANT_DIG 53
78 #define DBL_MIN 2.2250738585072014e-308
81 #ifdef DBL_MIN_REPLACEMENT
83 #define DBL_MIN DBL_MIN_REPLACEMENT
86 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
87 needed to express a float without losing information.
88 The general-case formula is valid for the usual case, IEEE floating point,
89 but many compilers can't optimize the formula to an integer constant,
90 so make a special case for it. */
91 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
92 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
94 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
97 #endif /* LISP_FLOAT_TYPE */
99 /* Avoid actual stack overflow in print. */
102 /* Detect most circularities to print finite output. */
103 #define PRINT_CIRCLE 200
104 Lisp_Object being_printed
[PRINT_CIRCLE
];
106 /* When printing into a buffer, first we put the text in this
107 block, then insert it all at once. */
110 /* Size allocated in print_buffer. */
111 int print_buffer_size
;
112 /* Chars stored in print_buffer. */
113 int print_buffer_pos
;
114 /* Bytes stored in print_buffer. */
115 int print_buffer_pos_byte
;
117 /* Maximum length of list to print in full; noninteger means
118 effectively infinity */
120 Lisp_Object Vprint_length
;
122 /* Maximum depth of list to print in full; noninteger means
123 effectively infinity. */
125 Lisp_Object Vprint_level
;
127 /* Nonzero means print newlines in strings as \n. */
129 int print_escape_newlines
;
131 Lisp_Object Qprint_escape_newlines
;
133 /* Nonzero means print (quote foo) forms as 'foo, etc. */
137 /* Non-nil means print #: before uninterned symbols.
138 Neither t nor nil means so that and don't clear Vprint_gensym_alist
139 on entry to and exit from print functions. */
141 Lisp_Object Vprint_gensym
;
143 /* Association list of certain objects that are `eq' in the form being
144 printed and which should be `eq' when read back in, using the #n=object
145 and #n# reader forms. Each element has the form (object . n). */
147 Lisp_Object Vprint_gensym_alist
;
149 /* Nonzero means print newline to stdout before next minibuffer message.
150 Defined in xdisp.c */
152 extern int noninteractive_need_newline
;
154 extern int minibuffer_auto_raise
;
156 #ifdef MAX_PRINT_CHARS
157 static int print_chars
;
158 static int max_print
;
159 #endif /* MAX_PRINT_CHARS */
161 void print_interval ();
164 /* Convert between chars and GLYPHs */
168 register GLYPH
*glyphs
;
178 str_to_glyph_cpy (str
, glyphs
)
182 register GLYPH
*gp
= glyphs
;
183 register char *cp
= str
;
190 str_to_glyph_ncpy (str
, glyphs
, n
)
195 register GLYPH
*gp
= glyphs
;
196 register char *cp
= str
;
203 glyph_to_str_cpy (glyphs
, str
)
207 register GLYPH
*gp
= glyphs
;
208 register char *cp
= str
;
211 *str
++ = *gp
++ & 0377;
215 /* Low level output routines for characters and strings */
217 /* Lisp functions to do output using a stream
218 must have the stream in a variable called printcharfun
219 and must start with PRINTPREPARE, end with PRINTFINISH,
220 and use PRINTDECLARE to declare common variables.
221 Use PRINTCHAR to output one character,
222 or call strout to output a block of characters.
225 #define PRINTDECLARE \
226 struct buffer *old = current_buffer; \
227 int old_point = -1, start_point; \
228 int old_point_byte, start_point_byte; \
229 int specpdl_count = specpdl_ptr - specpdl; \
230 int free_print_buffer = 0; \
233 #define PRINTPREPARE \
234 original = printcharfun; \
235 if (NILP (printcharfun)) printcharfun = Qt; \
236 if (BUFFERP (printcharfun)) \
238 if (XBUFFER (printcharfun) != current_buffer) \
239 Fset_buffer (printcharfun); \
240 printcharfun = Qnil; \
242 if (MARKERP (printcharfun)) \
244 if (!(XMARKER (original)->buffer)) \
245 error ("Marker does not point anywhere"); \
246 if (XMARKER (original)->buffer != current_buffer) \
247 set_buffer_internal (XMARKER (original)->buffer); \
249 old_point_byte = PT_BYTE; \
250 SET_PT_BOTH (marker_position (printcharfun), \
251 marker_byte_position (printcharfun)); \
253 start_point_byte = PT_BYTE; \
254 printcharfun = Qnil; \
256 if (NILP (printcharfun)) \
258 Lisp_Object string; \
259 if (print_buffer != 0) \
261 string = make_string_from_bytes (print_buffer, \
263 print_buffer_pos_byte); \
264 record_unwind_protect (print_unwind, string); \
268 print_buffer_size = 1000; \
269 print_buffer = (char *) xmalloc (print_buffer_size); \
270 free_print_buffer = 1; \
272 print_buffer_pos = 0; \
273 print_buffer_pos_byte = 0; \
275 if (!CONSP (Vprint_gensym)) \
276 Vprint_gensym_alist = Qnil
278 #define PRINTFINISH \
279 if (NILP (printcharfun)) \
280 insert_1_both (print_buffer, print_buffer_pos, \
281 print_buffer_pos_byte, 0, 1, 0); \
282 if (free_print_buffer) \
284 xfree (print_buffer); \
287 unbind_to (specpdl_count, Qnil); \
288 if (MARKERP (original)) \
289 set_marker_both (original, Qnil, PT, PT_BYTE); \
290 if (old_point >= 0) \
291 SET_PT_BOTH (old_point + (old_point >= start_point \
292 ? PT - start_point : 0), \
293 old_point_byte + (old_point_byte >= start_point_byte \
294 ? PT_BYTE - start_point_byte : 0)); \
295 if (old != current_buffer) \
296 set_buffer_internal (old); \
297 if (!CONSP (Vprint_gensym)) \
298 Vprint_gensym_alist = Qnil
300 #define PRINTCHAR(ch) printchar (ch, printcharfun)
302 /* Nonzero if there is no room to print any more characters
303 so print might as well return right away. */
305 #define PRINTFULLP() \
306 (EQ (printcharfun, Qt) && !noninteractive \
307 && printbufidx >= FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)))))
309 /* This is used to restore the saved contents of print_buffer
310 when there is a recursive call to print. */
312 print_unwind (saved_text
)
313 Lisp_Object saved_text
;
315 bcopy (XSTRING (saved_text
)->data
, print_buffer
, XSTRING (saved_text
)->size
);
318 /* Index of first unused element of FRAME_MESSAGE_BUF (mini_frame). */
319 static int printbufidx
;
328 #ifdef MAX_PRINT_CHARS
331 #endif /* MAX_PRINT_CHARS */
336 unsigned char work
[4], *str
;
339 len
= CHAR_STRING (ch
, work
, str
);
340 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
341 print_buffer
= (char *) xrealloc (print_buffer
,
342 print_buffer_size
*= 2);
343 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
344 print_buffer_pos
+= 1;
345 print_buffer_pos_byte
+= len
;
352 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
353 unsigned char work
[4], *str
;
354 int len
= CHAR_STRING (ch
, work
, str
);
361 putchar (*str
), str
++;
362 noninteractive_need_newline
= 1;
366 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
367 || !message_buf_print
)
369 message_log_maybe_newline ();
370 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
372 echo_area_glyphs_length
= 0;
373 message_buf_print
= 1;
375 if (minibuffer_auto_raise
)
377 Lisp_Object mini_window
;
379 /* Get the frame containing the minibuffer
380 that the selected frame is using. */
381 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
383 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
387 message_dolog (str
, len
, 0, len
> 1);
389 /* Convert message to multibyte if we are now adding multibyte text. */
390 if (! NILP (current_buffer
->enable_multibyte_characters
)
391 && ! message_enable_multibyte
394 int size
= count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame
),
396 unsigned char *tembuf
= (unsigned char *) alloca (size
+ 1);
397 copy_text (FRAME_MESSAGE_BUF (mini_frame
), tembuf
, printbufidx
,
400 if (printbufidx
> FRAME_MESSAGE_BUF_SIZE (mini_frame
))
401 printbufidx
= FRAME_MESSAGE_BUF_SIZE (mini_frame
);
402 bcopy (tembuf
, FRAME_MESSAGE_BUF (mini_frame
), printbufidx
);
404 message_enable_multibyte
405 = ! NILP (current_buffer
->enable_multibyte_characters
);
407 if (printbufidx
< FRAME_MESSAGE_BUF_SIZE (mini_frame
) - len
)
408 bcopy (str
, &FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
], len
),
410 FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
] = 0;
411 echo_area_glyphs_length
= printbufidx
;
415 #endif /* not standalone */
417 XSETFASTINT (ch1
, ch
);
422 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
425 Lisp_Object printcharfun
;
431 size_byte
= size
= strlen (ptr
);
433 if (EQ (printcharfun
, Qnil
))
435 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
437 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
438 print_buffer
= (char *) xrealloc (print_buffer
,
441 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
442 print_buffer_pos
+= size
;
443 print_buffer_pos_byte
+= size_byte
;
445 #ifdef MAX_PRINT_CHARS
448 #endif /* MAX_PRINT_CHARS */
451 if (EQ (printcharfun
, Qt
))
454 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
458 #ifdef MAX_PRINT_CHARS
461 #endif /* MAX_PRINT_CHARS */
465 fwrite (ptr
, 1, size_byte
, stdout
);
466 noninteractive_need_newline
= 1;
470 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
471 || !message_buf_print
)
473 message_log_maybe_newline ();
474 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
476 echo_area_glyphs_length
= 0;
477 message_buf_print
= 1;
479 if (minibuffer_auto_raise
)
481 Lisp_Object mini_window
;
483 /* Get the frame containing the minibuffer
484 that the selected frame is using. */
485 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
487 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
491 message_dolog (ptr
, size_byte
, 0, multibyte
);
492 if (size_byte
> FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1)
494 size_byte
= FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1;
495 /* Rewind incomplete multi-byte form. */
496 while (size_byte
&& (unsigned char) ptr
[size
] >= 0xA0) size
--;
498 bcopy (ptr
, &FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
], size_byte
);
499 printbufidx
+= size_byte
;
500 echo_area_glyphs_length
= printbufidx
;
501 FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
] = 0;
507 if (size
== size_byte
)
508 while (i
< size_byte
)
515 while (i
< size_byte
)
517 /* Here, we must convert each multi-byte form to the
518 corresponding character code before handing it to PRINTCHAR. */
520 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
527 /* Print the contents of a string STRING using PRINTCHARFUN.
528 It isn't safe to use strout in many cases,
529 because printing one char can relocate. */
532 print_string (string
, printcharfun
)
534 Lisp_Object printcharfun
;
536 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
537 /* strout is safe for output to a frame (echo area) or to print_buffer. */
538 strout (XSTRING (string
)->data
,
539 XSTRING (string
)->size
,
540 STRING_BYTES (XSTRING (string
)),
541 printcharfun
, STRING_MULTIBYTE (string
));
544 /* Otherwise, string may be relocated by printing one char.
545 So re-fetch the string address for each character. */
547 int size
= XSTRING (string
)->size
;
548 int size_byte
= STRING_BYTES (XSTRING (string
));
551 if (size
== size_byte
)
552 for (i
= 0; i
< size
; i
++)
553 PRINTCHAR (XSTRING (string
)->data
[i
]);
555 for (i
= 0; i
< size_byte
; i
++)
557 /* Here, we must convert each multi-byte form to the
558 corresponding character code before handing it to PRINTCHAR. */
560 int ch
= STRING_CHAR_AND_LENGTH (XSTRING (string
)->data
+ i
,
570 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
571 "Output character CHARACTER to stream PRINTCHARFUN.\n\
572 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
573 (character
, printcharfun
)
574 Lisp_Object character
, printcharfun
;
578 if (NILP (printcharfun
))
579 printcharfun
= Vstandard_output
;
580 CHECK_NUMBER (character
, 0);
582 PRINTCHAR (XINT (character
));
587 /* Used from outside of print.c to print a block of SIZE
588 single-byte chars at DATA on the default output stream.
589 Do not use this on the contents of a Lisp string. */
592 write_string (data
, size
)
597 Lisp_Object printcharfun
;
599 printcharfun
= Vstandard_output
;
602 strout (data
, size
, size
, printcharfun
, 0);
606 /* Used from outside of print.c to print a block of SIZE
607 single-byte chars at DATA on a specified stream PRINTCHARFUN.
608 Do not use this on the contents of a Lisp string. */
611 write_string_1 (data
, size
, printcharfun
)
614 Lisp_Object printcharfun
;
619 strout (data
, size
, size
, printcharfun
, 0);
627 temp_output_buffer_setup (bufname
)
630 register struct buffer
*old
= current_buffer
;
631 register Lisp_Object buf
;
633 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
635 current_buffer
->directory
= old
->directory
;
636 current_buffer
->read_only
= Qnil
;
639 XSETBUFFER (buf
, current_buffer
);
640 specbind (Qstandard_output
, buf
);
642 set_buffer_internal (old
);
646 internal_with_output_to_temp_buffer (bufname
, function
, args
)
648 Lisp_Object (*function
) ();
651 int count
= specpdl_ptr
- specpdl
;
652 Lisp_Object buf
, val
;
656 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
657 temp_output_buffer_setup (bufname
);
658 buf
= Vstandard_output
;
661 val
= (*function
) (args
);
664 temp_output_buffer_show (buf
);
667 return unbind_to (count
, val
);
670 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
672 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
673 The buffer is cleared out initially, and marked as unmodified when done.\n\
674 All output done by BODY is inserted in that buffer by default.\n\
675 The buffer is displayed in another window, but not selected.\n\
676 The value of the last form in BODY is returned.\n\
677 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
678 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
679 to get the buffer displayed. It gets one argument, the buffer to display.")
685 int count
= specpdl_ptr
- specpdl
;
686 Lisp_Object buf
, val
;
689 name
= Feval (Fcar (args
));
692 CHECK_STRING (name
, 0);
693 temp_output_buffer_setup (XSTRING (name
)->data
);
694 buf
= Vstandard_output
;
696 val
= Fprogn (Fcdr (args
));
698 temp_output_buffer_show (buf
);
700 return unbind_to (count
, val
);
702 #endif /* not standalone */
704 static void print ();
706 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
707 "Output a newline to stream PRINTCHARFUN.\n\
708 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
710 Lisp_Object printcharfun
;
714 if (NILP (printcharfun
))
715 printcharfun
= Vstandard_output
;
722 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
723 "Output the printed representation of OBJECT, any Lisp object.\n\
724 Quoting characters are printed when needed to make output that `read'\n\
725 can handle, whenever this is possible.\n\
726 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
727 (object
, printcharfun
)
728 Lisp_Object object
, printcharfun
;
732 #ifdef MAX_PRINT_CHARS
734 #endif /* MAX_PRINT_CHARS */
735 if (NILP (printcharfun
))
736 printcharfun
= Vstandard_output
;
739 print (object
, printcharfun
, 1);
744 /* a buffer which is used to hold output being built by prin1-to-string */
745 Lisp_Object Vprin1_to_string_buffer
;
747 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
748 "Return a string containing the printed representation of OBJECT,\n\
749 any Lisp object. Quoting characters are used when needed to make output\n\
750 that `read' can handle, whenever this is possible, unless the optional\n\
751 second argument NOESCAPE is non-nil.")
753 Lisp_Object object
, noescape
;
756 Lisp_Object printcharfun
;
757 struct gcpro gcpro1
, gcpro2
;
760 /* Save and restore this--we are altering a buffer
761 but we don't want to deactivate the mark just for that.
762 No need for specbind, since errors deactivate the mark. */
763 tem
= Vdeactivate_mark
;
764 GCPRO2 (object
, tem
);
766 printcharfun
= Vprin1_to_string_buffer
;
769 print (object
, printcharfun
, NILP (noescape
));
770 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
772 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
773 object
= Fbuffer_string ();
776 set_buffer_internal (old
);
778 Vdeactivate_mark
= tem
;
784 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
785 "Output the printed representation of OBJECT, any Lisp object.\n\
786 No quoting characters are used; no delimiters are printed around\n\
787 the contents of strings.\n\
788 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
789 (object
, printcharfun
)
790 Lisp_Object object
, printcharfun
;
794 if (NILP (printcharfun
))
795 printcharfun
= Vstandard_output
;
798 print (object
, printcharfun
, 0);
803 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
804 "Output the printed representation of OBJECT, with newlines around it.\n\
805 Quoting characters are printed when needed to make output that `read'\n\
806 can handle, whenever this is possible.\n\
807 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
808 (object
, printcharfun
)
809 Lisp_Object object
, printcharfun
;
814 #ifdef MAX_PRINT_CHARS
816 max_print
= MAX_PRINT_CHARS
;
817 #endif /* MAX_PRINT_CHARS */
818 if (NILP (printcharfun
))
819 printcharfun
= Vstandard_output
;
824 print (object
, printcharfun
, 1);
827 #ifdef MAX_PRINT_CHARS
830 #endif /* MAX_PRINT_CHARS */
835 /* The subroutine object for external-debugging-output is kept here
836 for the convenience of the debugger. */
837 Lisp_Object Qexternal_debugging_output
;
839 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
840 "Write CHARACTER to stderr.\n\
841 You can call print while debugging emacs, and pass it this function\n\
842 to make it write to the debugging output.\n")
844 Lisp_Object character
;
846 CHECK_NUMBER (character
, 0);
847 putc (XINT (character
), stderr
);
850 /* Send the output to a debugger (nothing happens if there isn't one). */
852 char buf
[2] = {(char) XINT (character
), '\0'};
853 OutputDebugString (buf
);
860 /* This is the interface for debugging printing. */
866 Fprin1 (arg
, Qexternal_debugging_output
);
867 fprintf (stderr
, "\r\n");
870 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
872 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
876 struct buffer
*old
= current_buffer
;
877 Lisp_Object original
, printcharfun
, value
;
880 /* If OBJ is (error STRING), just return STRING.
881 That is not only faster, it also avoids the need to allocate
882 space here when the error is due to memory full. */
883 if (CONSP (obj
) && EQ (XCONS (obj
)->car
, Qerror
)
884 && CONSP (XCONS (obj
)->cdr
)
885 && STRINGP (XCONS (XCONS (obj
)->cdr
)->car
)
886 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
887 return XCONS (XCONS (obj
)->cdr
)->car
;
889 print_error_message (obj
, Vprin1_to_string_buffer
);
891 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
892 value
= Fbuffer_string ();
896 set_buffer_internal (old
);
902 /* Print an error message for the error DATA
903 onto Lisp output stream STREAM (suitable for the print functions). */
906 print_error_message (data
, stream
)
907 Lisp_Object data
, stream
;
909 Lisp_Object errname
, errmsg
, file_error
, tail
;
913 errname
= Fcar (data
);
915 if (EQ (errname
, Qerror
))
918 if (!CONSP (data
)) data
= Qnil
;
919 errmsg
= Fcar (data
);
924 errmsg
= Fget (errname
, Qerror_message
);
925 file_error
= Fmemq (Qfile_error
,
926 Fget (errname
, Qerror_conditions
));
929 /* Print an error message including the data items. */
931 tail
= Fcdr_safe (data
);
934 /* For file-error, make error message by concatenating
935 all the data items. They are all strings. */
936 if (!NILP (file_error
) && !NILP (tail
))
937 errmsg
= XCONS (tail
)->car
, tail
= XCONS (tail
)->cdr
;
939 if (STRINGP (errmsg
))
940 Fprinc (errmsg
, stream
);
942 write_string_1 ("peculiar error", -1, stream
);
944 for (i
= 0; CONSP (tail
); tail
= Fcdr (tail
), i
++)
946 write_string_1 (i
? ", " : ": ", 2, stream
);
947 if (!NILP (file_error
))
948 Fprinc (Fcar (tail
), stream
);
950 Fprin1 (Fcar (tail
), stream
);
955 #ifdef LISP_FLOAT_TYPE
958 * The buffer should be at least as large as the max string size of the
959 * largest float, printed in the biggest notation. This is undoubtedly
960 * 20d float_output_format, with the negative of the C-constant "HUGE"
963 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
965 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
966 * case of -1e307 in 20d float_output_format. What is one to do (short of
967 * re-writing _doprnt to be more sane)?
972 float_to_string (buf
, data
)
979 /* Check for plus infinity in a way that won't lose
980 if there is no plus infinity. */
981 if (data
== data
/ 2 && data
> 1.0)
983 strcpy (buf
, "1.0e+INF");
986 /* Likewise for minus infinity. */
987 if (data
== data
/ 2 && data
< -1.0)
989 strcpy (buf
, "-1.0e+INF");
992 /* Check for NaN in a way that won't fail if there are no NaNs. */
993 if (! (data
* 0.0 >= 0.0))
995 strcpy (buf
, "0.0e+NaN");
999 if (NILP (Vfloat_output_format
)
1000 || !STRINGP (Vfloat_output_format
))
1003 /* Generate the fewest number of digits that represent the
1004 floating point value without losing information.
1005 The following method is simple but a bit slow.
1006 For ideas about speeding things up, please see:
1008 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1009 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1011 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1012 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1014 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1016 sprintf (buf
, "%.*g", width
, data
);
1017 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1019 else /* oink oink */
1021 /* Check that the spec we have is fully valid.
1022 This means not only valid for printf,
1023 but meant for floats, and reasonable. */
1024 cp
= XSTRING (Vfloat_output_format
)->data
;
1033 /* Check the width specification. */
1035 if ('0' <= *cp
&& *cp
<= '9')
1039 width
= (width
* 10) + (*cp
++ - '0');
1040 while (*cp
>= '0' && *cp
<= '9');
1042 /* A precision of zero is valid only for %f. */
1044 || (width
== 0 && *cp
!= 'f'))
1048 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1054 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
1057 /* Make sure there is a decimal point with digit after, or an
1058 exponent, so that the value is readable as a float. But don't do
1059 this with "%.0f"; it's valid for that not to produce a decimal
1060 point. Note that width can be 0 only for %.0f. */
1063 for (cp
= buf
; *cp
; cp
++)
1064 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1067 if (*cp
== '.' && cp
[1] == 0)
1081 #endif /* LISP_FLOAT_TYPE */
1084 print (obj
, printcharfun
, escapeflag
)
1086 register Lisp_Object printcharfun
;
1093 #if 1 /* I'm not sure this is really worth doing. */
1094 /* Detect circularities and truncate them.
1095 No need to offer any alternative--this is better than an error. */
1096 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
1099 for (i
= 0; i
< print_depth
; i
++)
1100 if (EQ (obj
, being_printed
[i
]))
1102 sprintf (buf
, "#%d", i
);
1103 strout (buf
, -1, -1, printcharfun
, 0);
1109 being_printed
[print_depth
] = obj
;
1112 if (print_depth
> PRINT_CIRCLE
)
1113 error ("Apparently circular structure being printed");
1114 #ifdef MAX_PRINT_CHARS
1115 if (max_print
&& print_chars
> max_print
)
1120 #endif /* MAX_PRINT_CHARS */
1122 switch (XGCTYPE (obj
))
1125 if (sizeof (int) == sizeof (EMACS_INT
))
1126 sprintf (buf
, "%d", XINT (obj
));
1127 else if (sizeof (long) == sizeof (EMACS_INT
))
1128 sprintf (buf
, "%ld", XINT (obj
));
1131 strout (buf
, -1, -1, printcharfun
, 0);
1134 #ifdef LISP_FLOAT_TYPE
1137 char pigbuf
[350]; /* see comments in float_to_string */
1139 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
1140 strout (pigbuf
, -1, -1, printcharfun
, 0);
1147 print_string (obj
, printcharfun
);
1150 register int i
, i_byte
;
1151 register unsigned char c
;
1152 struct gcpro gcpro1
;
1157 #ifdef USE_TEXT_PROPERTIES
1158 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1166 size_byte
= STRING_BYTES (XSTRING (obj
));
1168 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1170 /* Here, we must convert each multi-byte form to the
1171 corresponding character code before handing it to PRINTCHAR. */
1175 if (STRING_MULTIBYTE (obj
))
1176 FETCH_STRING_CHAR_ADVANCE (c
, obj
, i
, i_byte
);
1178 c
= XSTRING (obj
)->data
[i_byte
++];
1182 if (c
== '\n' && print_escape_newlines
)
1187 else if (c
== '\f' && print_escape_newlines
)
1192 else if ((! SINGLE_BYTE_CHAR_P (c
)
1193 && NILP (current_buffer
->enable_multibyte_characters
)))
1195 /* When multibyte is disabled,
1196 print multibyte string chars using hex escapes. */
1197 unsigned char outbuf
[50];
1198 sprintf (outbuf
, "\\x%x", c
);
1199 strout (outbuf
, -1, -1, printcharfun
, 0);
1201 else if (SINGLE_BYTE_CHAR_P (c
)
1202 && ! ASCII_BYTE_P (c
)
1203 && ! NILP (current_buffer
->enable_multibyte_characters
))
1205 /* When multibyte is enabled,
1206 print single-byte non-ASCII string chars
1207 using octal escapes. */
1208 unsigned char outbuf
[5];
1209 sprintf (outbuf
, "\\%03o", c
);
1210 strout (outbuf
, -1, -1, printcharfun
, 0);
1214 if (c
== '\"' || c
== '\\')
1221 #ifdef USE_TEXT_PROPERTIES
1222 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1224 traverse_intervals (XSTRING (obj
)->intervals
,
1225 0, 0, print_interval
, printcharfun
);
1236 register int confusing
;
1237 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
1238 register unsigned char *end
= p
+ STRING_BYTES (XSYMBOL (obj
)->name
);
1240 int i
, i_byte
, size_byte
;
1243 XSETSTRING (name
, XSYMBOL (obj
)->name
);
1245 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1248 /* If symbol name begins with a digit, and ends with a digit,
1249 and contains nothing but digits and `e', it could be treated
1250 as a number. So set CONFUSING.
1252 Symbols that contain periods could also be taken as numbers,
1253 but periods are always escaped, so we don't have to worry
1255 else if (*p
>= '0' && *p
<= '9'
1256 && end
[-1] >= '0' && end
[-1] <= '9')
1258 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1259 /* Needed for \2e10. */
1262 confusing
= (end
== p
);
1267 /* If we print an uninterned symbol as part of a complex object and
1268 the flag print-gensym is non-nil, prefix it with #n= to read the
1269 object back with the #n# reader syntax later if needed. */
1270 if (! NILP (Vprint_gensym
) && NILP (XSYMBOL (obj
)->obarray
))
1272 if (print_depth
> 1)
1275 tem
= Fassq (obj
, Vprint_gensym_alist
);
1279 print (XCDR (tem
), printcharfun
, escapeflag
);
1285 if (CONSP (Vprint_gensym_alist
))
1286 XSETFASTINT (tem
, XFASTINT (XCDR (XCAR (Vprint_gensym_alist
))) + 1);
1288 XSETFASTINT (tem
, 1);
1289 Vprint_gensym_alist
= Fcons (Fcons (obj
, tem
), Vprint_gensym_alist
);
1292 print (tem
, printcharfun
, escapeflag
);
1300 size_byte
= STRING_BYTES (XSTRING (name
));
1302 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1304 /* Here, we must convert each multi-byte form to the
1305 corresponding character code before handing it to PRINTCHAR. */
1307 if (STRING_MULTIBYTE (name
))
1308 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1310 c
= XSTRING (name
)->data
[i_byte
++];
1316 if (c
== '\"' || c
== '\\' || c
== '\''
1317 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1318 || c
== ',' || c
=='.' || c
== '`'
1319 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1321 PRINTCHAR ('\\'), confusing
= 0;
1329 /* If deeper than spec'd depth, print placeholder. */
1330 if (INTEGERP (Vprint_level
)
1331 && print_depth
> XINT (Vprint_level
))
1332 strout ("...", -1, -1, printcharfun
, 0);
1333 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1334 && (EQ (XCAR (obj
), Qquote
)))
1337 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1339 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1340 && (EQ (XCAR (obj
), Qfunction
)))
1344 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1346 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1347 && ((EQ (XCAR (obj
), Qbackquote
)
1348 || EQ (XCAR (obj
), Qcomma
)
1349 || EQ (XCAR (obj
), Qcomma_at
)
1350 || EQ (XCAR (obj
), Qcomma_dot
))))
1352 print (XCAR (obj
), printcharfun
, 0);
1353 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1360 register int max
= 0;
1362 if (INTEGERP (Vprint_length
))
1363 max
= XINT (Vprint_length
);
1364 /* Could recognize circularities in cdrs here,
1365 but that would make printing of long lists quadratic.
1366 It's not worth doing. */
1373 strout ("...", 3, 3, printcharfun
, 0);
1376 print (XCAR (obj
), printcharfun
, escapeflag
);
1382 strout (" . ", 3, 3, printcharfun
, 0);
1383 print (obj
, printcharfun
, escapeflag
);
1389 case Lisp_Vectorlike
:
1394 strout ("#<process ", -1, -1, printcharfun
, 0);
1395 print_string (XPROCESS (obj
)->name
, printcharfun
);
1399 print_string (XPROCESS (obj
)->name
, printcharfun
);
1401 else if (BOOL_VECTOR_P (obj
))
1404 register unsigned char c
;
1405 struct gcpro gcpro1
;
1407 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1413 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1414 strout (buf
, -1, -1, printcharfun
, 0);
1417 /* Don't print more characters than the specified maximum. */
1418 if (INTEGERP (Vprint_length
)
1419 && XINT (Vprint_length
) < size_in_chars
)
1420 size_in_chars
= XINT (Vprint_length
);
1422 for (i
= 0; i
< size_in_chars
; i
++)
1425 c
= XBOOL_VECTOR (obj
)->data
[i
];
1426 if (c
== '\n' && print_escape_newlines
)
1431 else if (c
== '\f' && print_escape_newlines
)
1438 if (c
== '\"' || c
== '\\')
1447 else if (SUBRP (obj
))
1449 strout ("#<subr ", -1, -1, printcharfun
, 0);
1450 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1454 else if (WINDOWP (obj
))
1456 strout ("#<window ", -1, -1, printcharfun
, 0);
1457 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1458 strout (buf
, -1, -1, printcharfun
, 0);
1459 if (!NILP (XWINDOW (obj
)->buffer
))
1461 strout (" on ", -1, -1, printcharfun
, 0);
1462 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1466 else if (BUFFERP (obj
))
1468 if (NILP (XBUFFER (obj
)->name
))
1469 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1470 else if (escapeflag
)
1472 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1473 print_string (XBUFFER (obj
)->name
, printcharfun
);
1477 print_string (XBUFFER (obj
)->name
, printcharfun
);
1479 else if (WINDOW_CONFIGURATIONP (obj
))
1481 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1483 else if (FRAMEP (obj
))
1485 strout ((FRAME_LIVE_P (XFRAME (obj
))
1486 ? "#<frame " : "#<dead frame "),
1487 -1, -1, printcharfun
, 0);
1488 print_string (XFRAME (obj
)->name
, printcharfun
);
1489 sprintf (buf
, " 0x%lx\\ ", (unsigned long) (XFRAME (obj
)));
1490 strout (buf
, -1, -1, printcharfun
, 0);
1493 #endif /* not standalone */
1496 int size
= XVECTOR (obj
)->size
;
1497 if (COMPILEDP (obj
))
1500 size
&= PSEUDOVECTOR_SIZE_MASK
;
1502 if (CHAR_TABLE_P (obj
))
1504 /* We print a char-table as if it were a vector,
1505 lumping the parent and default slots in with the
1506 character slots. But we add #^ as a prefix. */
1509 if (SUB_CHAR_TABLE_P (obj
))
1511 size
&= PSEUDOVECTOR_SIZE_MASK
;
1513 if (size
& PSEUDOVECTOR_FLAG
)
1519 register Lisp_Object tem
;
1521 /* Don't print more elements than the specified maximum. */
1522 if (INTEGERP (Vprint_length
)
1523 && XINT (Vprint_length
) < size
)
1524 size
= XINT (Vprint_length
);
1526 for (i
= 0; i
< size
; i
++)
1528 if (i
) PRINTCHAR (' ');
1529 tem
= XVECTOR (obj
)->contents
[i
];
1530 print (tem
, printcharfun
, escapeflag
);
1539 switch (XMISCTYPE (obj
))
1541 case Lisp_Misc_Marker
:
1542 strout ("#<marker ", -1, -1, printcharfun
, 0);
1543 /* Do you think this is necessary? */
1544 if (XMARKER (obj
)->insertion_type
!= 0)
1545 strout ("(before-insertion) ", -1, -1, printcharfun
, 0);
1546 if (!(XMARKER (obj
)->buffer
))
1547 strout ("in no buffer", -1, -1, printcharfun
, 0);
1550 sprintf (buf
, "at %d", marker_position (obj
));
1551 strout (buf
, -1, -1, printcharfun
, 0);
1552 strout (" in ", -1, -1, printcharfun
, 0);
1553 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1558 case Lisp_Misc_Overlay
:
1559 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1560 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1561 strout ("in no buffer", -1, -1, printcharfun
, 0);
1564 sprintf (buf
, "from %d to %d in ",
1565 marker_position (OVERLAY_START (obj
)),
1566 marker_position (OVERLAY_END (obj
)));
1567 strout (buf
, -1, -1, printcharfun
, 0);
1568 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1574 /* Remaining cases shouldn't happen in normal usage, but let's print
1575 them anyway for the benefit of the debugger. */
1576 case Lisp_Misc_Free
:
1577 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1580 case Lisp_Misc_Intfwd
:
1581 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1582 strout (buf
, -1, -1, printcharfun
, 0);
1585 case Lisp_Misc_Boolfwd
:
1586 sprintf (buf
, "#<boolfwd to %s>",
1587 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1588 strout (buf
, -1, -1, printcharfun
, 0);
1591 case Lisp_Misc_Objfwd
:
1592 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
1593 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1597 case Lisp_Misc_Buffer_Objfwd
:
1598 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
1599 print (*(Lisp_Object
*)((char *)current_buffer
1600 + XBUFFER_OBJFWD (obj
)->offset
),
1601 printcharfun
, escapeflag
);
1605 case Lisp_Misc_Kboard_Objfwd
:
1606 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
1607 print (*(Lisp_Object
*)((char *) current_kboard
1608 + XKBOARD_OBJFWD (obj
)->offset
),
1609 printcharfun
, escapeflag
);
1613 case Lisp_Misc_Buffer_Local_Value
:
1614 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
1615 goto do_buffer_local
;
1616 case Lisp_Misc_Some_Buffer_Local_Value
:
1617 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
1619 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
1620 print (XBUFFER_LOCAL_VALUE (obj
)->realvalue
, printcharfun
, escapeflag
);
1621 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
1622 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
1624 strout ("[buffer] ", -1, -1, printcharfun
, 0);
1625 print (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
1626 printcharfun
, escapeflag
);
1627 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
1629 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
1630 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
1632 strout ("[frame] ", -1, -1, printcharfun
, 0);
1633 print (XBUFFER_LOCAL_VALUE (obj
)->frame
,
1634 printcharfun
, escapeflag
);
1636 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
1637 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1638 printcharfun
, escapeflag
);
1639 strout ("[default-value] ", -1, -1, printcharfun
, 0);
1640 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
,
1641 printcharfun
, escapeflag
);
1649 #endif /* standalone */
1654 /* We're in trouble if this happens!
1655 Probably should just abort () */
1656 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
1658 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1659 else if (VECTORLIKEP (obj
))
1660 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1662 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1663 strout (buf
, -1, -1, printcharfun
, 0);
1664 strout (" Save your buffers immediately and please report this bug>",
1665 -1, -1, printcharfun
, 0);
1672 #ifdef USE_TEXT_PROPERTIES
1674 /* Print a description of INTERVAL using PRINTCHARFUN.
1675 This is part of printing a string that has text properties. */
1678 print_interval (interval
, printcharfun
)
1680 Lisp_Object printcharfun
;
1683 print (make_number (interval
->position
), printcharfun
, 1);
1685 print (make_number (interval
->position
+ LENGTH (interval
)),
1688 print (interval
->plist
, printcharfun
, 1);
1691 #endif /* USE_TEXT_PROPERTIES */
1696 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1697 "Output stream `print' uses by default for outputting a character.\n\
1698 This may be any function of one argument.\n\
1699 It may also be a buffer (output is inserted before point)\n\
1700 or a marker (output is inserted and the marker is advanced)\n\
1701 or the symbol t (output appears in the echo area).");
1702 Vstandard_output
= Qt
;
1703 Qstandard_output
= intern ("standard-output");
1704 staticpro (&Qstandard_output
);
1706 #ifdef LISP_FLOAT_TYPE
1707 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1708 "The format descriptor string used to print floats.\n\
1709 This is a %-spec like those accepted by `printf' in C,\n\
1710 but with some restrictions. It must start with the two characters `%.'.\n\
1711 After that comes an integer precision specification,\n\
1712 and then a letter which controls the format.\n\
1713 The letters allowed are `e', `f' and `g'.\n\
1714 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1715 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1716 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1717 The precision in any of these cases is the number of digits following\n\
1718 the decimal point. With `f', a precision of 0 means to omit the\n\
1719 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1720 A value of nil means to use the shortest notation\n\
1721 that represents the number without losing information.");
1722 Vfloat_output_format
= Qnil
;
1723 Qfloat_output_format
= intern ("float-output-format");
1724 staticpro (&Qfloat_output_format
);
1725 #endif /* LISP_FLOAT_TYPE */
1727 DEFVAR_LISP ("print-length", &Vprint_length
,
1728 "Maximum length of list to print before abbreviating.\n\
1729 A value of nil means no limit.");
1730 Vprint_length
= Qnil
;
1732 DEFVAR_LISP ("print-level", &Vprint_level
,
1733 "Maximum depth of list nesting to print before abbreviating.\n\
1734 A value of nil means no limit.");
1735 Vprint_level
= Qnil
;
1737 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1738 "Non-nil means print newlines in strings as backslash-n.\n\
1739 Also print formfeeds as backslash-f.");
1740 print_escape_newlines
= 0;
1742 DEFVAR_BOOL ("print-quoted", &print_quoted
,
1743 "Non-nil means print quoted forms with reader syntax.\n\
1744 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\
1745 forms print in the new syntax.");
1748 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
1749 "Non-nil means print uninterned symbols so they will read as uninterned.\n\
1750 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\
1751 When the uninterned symbol appears within a larger data structure,\n\
1752 in addition use the #...# and #...= constructs as needed,\n\
1753 so that multiple references to the same symbol are shared once again\n\
1754 when the text is read back.\n\
1756 If the value of `print-gensym' is a cons cell, then in addition refrain from\n\
1757 clearing `print-gensym-alist' on entry to and exit from printing functions,\n\
1758 so that the use of #...# and #...= can carry over for several separately\n\
1760 Vprint_gensym
= Qnil
;
1762 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist
,
1763 "Association list of elements (GENSYM . N) to guide use of #N# and #N=.\n\
1764 In each element, GENSYM is an uninterned symbol that has been associated\n\
1765 with #N= for the specified value of N.");
1766 Vprint_gensym_alist
= Qnil
;
1768 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1769 staticpro (&Vprin1_to_string_buffer
);
1772 defsubr (&Sprin1_to_string
);
1773 defsubr (&Serror_message_string
);
1777 defsubr (&Swrite_char
);
1778 defsubr (&Sexternal_debugging_output
);
1780 Qexternal_debugging_output
= intern ("external-debugging-output");
1781 staticpro (&Qexternal_debugging_output
);
1783 Qprint_escape_newlines
= intern ("print-escape-newlines");
1784 staticpro (&Qprint_escape_newlines
);
1787 defsubr (&Swith_output_to_temp_buffer
);
1788 #endif /* not standalone */