1 /* Lisp object printing and output streams.
3 Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2016 Free Software
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
26 #include "character.h"
33 #include "intervals.h"
34 #include "blockinput.h"
43 /* Avoid actual stack overflow in print. */
44 static ptrdiff_t print_depth
;
46 /* Level of nesting inside outputting backquote in new style. */
47 static ptrdiff_t new_backquote_output
;
49 /* Detect most circularities to print finite output. */
50 #define PRINT_CIRCLE 200
51 static Lisp_Object being_printed
[PRINT_CIRCLE
];
53 /* Last char printed to stdout by printchar. */
54 static unsigned int printchar_stdout_last
;
56 /* When printing into a buffer, first we put the text in this
57 block, then insert it all at once. */
58 static char *print_buffer
;
60 /* Size allocated in print_buffer. */
61 static ptrdiff_t print_buffer_size
;
62 /* Chars stored in print_buffer. */
63 static ptrdiff_t print_buffer_pos
;
64 /* Bytes stored in print_buffer. */
65 static ptrdiff_t print_buffer_pos_byte
;
67 /* Vprint_number_table is a table, that keeps objects that are going to
68 be printed, to allow use of #n= and #n# to express sharing.
69 For any given object, the table can give the following values:
70 t the object will be printed only once.
71 -N the object will be printed several times and will take number N.
72 N the object has been printed so we can refer to it as #N#.
73 print_number_index holds the largest N already used.
74 N has to be striclty larger than 0 since we need to distinguish -N. */
75 static ptrdiff_t print_number_index
;
76 static void print_interval (INTERVAL interval
, Lisp_Object printcharfun
);
78 /* GDB resets this to zero on W32 to disable OutputDebugString calls. */
79 bool print_output_debug_flag EXTERNALLY_VISIBLE
= 1;
82 /* Low level output routines for characters and strings. */
84 /* Lisp functions to do output using a stream
85 must have the stream in a variable called printcharfun
86 and must start with PRINTPREPARE, end with PRINTFINISH.
87 Use printchar to output one character,
88 or call strout to output a block of characters. */
90 #define PRINTPREPARE \
91 struct buffer *old = current_buffer; \
92 ptrdiff_t old_point = -1, start_point = -1; \
93 ptrdiff_t old_point_byte = -1, start_point_byte = -1; \
94 ptrdiff_t specpdl_count = SPECPDL_INDEX (); \
95 bool free_print_buffer = 0; \
97 = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \
98 Lisp_Object original = printcharfun; \
99 if (NILP (printcharfun)) printcharfun = Qt; \
100 if (BUFFERP (printcharfun)) \
102 if (XBUFFER (printcharfun) != current_buffer) \
103 Fset_buffer (printcharfun); \
104 printcharfun = Qnil; \
106 if (MARKERP (printcharfun)) \
108 ptrdiff_t marker_pos; \
109 if (! XMARKER (printcharfun)->buffer) \
110 error ("Marker does not point anywhere"); \
111 if (XMARKER (printcharfun)->buffer != current_buffer) \
112 set_buffer_internal (XMARKER (printcharfun)->buffer); \
113 marker_pos = marker_position (printcharfun); \
114 if (marker_pos < BEGV || marker_pos > ZV) \
115 signal_error ("Marker is outside the accessible " \
116 "part of the buffer", printcharfun); \
118 old_point_byte = PT_BYTE; \
119 SET_PT_BOTH (marker_pos, \
120 marker_byte_position (printcharfun)); \
122 start_point_byte = PT_BYTE; \
123 printcharfun = Qnil; \
125 if (NILP (printcharfun)) \
127 Lisp_Object string; \
128 if (NILP (BVAR (current_buffer, enable_multibyte_characters)) \
129 && ! print_escape_multibyte) \
130 specbind (Qprint_escape_multibyte, Qt); \
131 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)) \
132 && ! print_escape_nonascii) \
133 specbind (Qprint_escape_nonascii, Qt); \
134 if (print_buffer != 0) \
136 string = make_string_from_bytes (print_buffer, \
138 print_buffer_pos_byte); \
139 record_unwind_protect (print_unwind, string); \
143 int new_size = 1000; \
144 print_buffer = xmalloc (new_size); \
145 print_buffer_size = new_size; \
146 free_print_buffer = 1; \
148 print_buffer_pos = 0; \
149 print_buffer_pos_byte = 0; \
151 if (EQ (printcharfun, Qt) && ! noninteractive) \
152 setup_echo_area_for_printing (multibyte);
154 #define PRINTFINISH \
155 if (NILP (printcharfun)) \
157 if (print_buffer_pos != print_buffer_pos_byte \
158 && NILP (BVAR (current_buffer, enable_multibyte_characters)))\
161 unsigned char *temp = SAFE_ALLOCA (print_buffer_pos + 1); \
162 copy_text ((unsigned char *) print_buffer, temp, \
163 print_buffer_pos_byte, 1, 0); \
164 insert_1_both ((char *) temp, print_buffer_pos, \
165 print_buffer_pos, 0, 1, 0); \
169 insert_1_both (print_buffer, print_buffer_pos, \
170 print_buffer_pos_byte, 0, 1, 0); \
171 signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
173 if (free_print_buffer) \
175 xfree (print_buffer); \
178 unbind_to (specpdl_count, Qnil); \
179 if (MARKERP (original)) \
180 set_marker_both (original, Qnil, PT, PT_BYTE); \
181 if (old_point >= 0) \
182 SET_PT_BOTH (old_point + (old_point >= start_point \
183 ? PT - start_point : 0), \
184 old_point_byte + (old_point_byte >= start_point_byte \
185 ? PT_BYTE - start_point_byte : 0)); \
186 set_buffer_internal (old);
188 /* This is used to restore the saved contents of print_buffer
189 when there is a recursive call to print. */
192 print_unwind (Lisp_Object saved_text
)
194 memcpy (print_buffer
, SDATA (saved_text
), SCHARS (saved_text
));
197 /* Print character CH to the stdio stream STREAM. */
200 printchar_to_stream (unsigned int ch
, FILE *stream
)
202 Lisp_Object dv
IF_LINT (= Qnil
);
203 ptrdiff_t i
= 0, n
= 1;
204 Lisp_Object coding_system
= Vlocale_coding_system
;
205 bool encode_p
= false;
207 if (!NILP (Vcoding_system_for_write
))
208 coding_system
= Vcoding_system_for_write
;
209 if (!NILP (coding_system
))
212 if (CHAR_VALID_P (ch
) && DISP_TABLE_P (Vstandard_display_table
))
214 dv
= DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table
), ch
);
224 if (ASCII_CHAR_P (ch
))
228 /* Send the output to a debugger (nothing happens if there
230 if (print_output_debug_flag
&& stream
== stderr
)
231 OutputDebugString ((char []) {ch
, '\0'});
236 unsigned char mbstr
[MAX_MULTIBYTE_LENGTH
];
237 int len
= CHAR_STRING (ch
, mbstr
);
238 Lisp_Object encoded_ch
=
239 make_multibyte_string ((char *) mbstr
, 1, len
);
242 encoded_ch
= code_convert_string_norecord (encoded_ch
,
243 coding_system
, true);
244 fwrite (SSDATA (encoded_ch
), 1, SBYTES (encoded_ch
), stream
);
246 if (print_output_debug_flag
&& stream
== stderr
)
247 OutputDebugString (SSDATA (encoded_ch
));
255 if (CHARACTERP (AREF (dv
, i
)))
259 ch
= XFASTINT (AREF (dv
, i
));
263 /* Print character CH using method FUN. FUN nil means print to
264 print_buffer. FUN t means print to echo area or stdout if
265 non-interactive. If FUN is neither nil nor t, call FUN with CH as
269 printchar (unsigned int ch
, Lisp_Object fun
)
271 if (!NILP (fun
) && !EQ (fun
, Qt
))
272 call1 (fun
, make_number (ch
));
275 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
276 int len
= CHAR_STRING (ch
, str
);
282 ptrdiff_t incr
= len
- (print_buffer_size
- print_buffer_pos_byte
);
284 print_buffer
= xpalloc (print_buffer
, &print_buffer_size
,
286 memcpy (print_buffer
+ print_buffer_pos_byte
, str
, len
);
287 print_buffer_pos
+= 1;
288 print_buffer_pos_byte
+= len
;
290 else if (noninteractive
)
292 printchar_stdout_last
= ch
;
293 if (DISP_TABLE_P (Vstandard_display_table
))
294 printchar_to_stream (ch
, stdout
);
296 fwrite (str
, 1, len
, stdout
);
297 noninteractive_need_newline
= 1;
302 = !NILP (BVAR (current_buffer
, enable_multibyte_characters
));
304 setup_echo_area_for_printing (multibyte_p
);
306 message_dolog ((char *) str
, len
, 0, multibyte_p
);
312 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
313 method PRINTCHARFUN. PRINTCHARFUN nil means output to
314 print_buffer. PRINTCHARFUN t means output to the echo area or to
315 stdout if non-interactive. If neither nil nor t, call Lisp
316 function PRINTCHARFUN for each character printed. MULTIBYTE
317 non-zero means PTR contains multibyte characters.
319 In the case where PRINTCHARFUN is nil, it is safe for PTR to point
320 to data in a Lisp string. Otherwise that is not safe. */
323 strout (const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
,
324 Lisp_Object printcharfun
)
326 if (NILP (printcharfun
))
328 ptrdiff_t incr
= size_byte
- (print_buffer_size
- print_buffer_pos_byte
);
330 print_buffer
= xpalloc (print_buffer
, &print_buffer_size
, incr
, -1, 1);
331 memcpy (print_buffer
+ print_buffer_pos_byte
, ptr
, size_byte
);
332 print_buffer_pos
+= size
;
333 print_buffer_pos_byte
+= size_byte
;
335 else if (noninteractive
&& EQ (printcharfun
, Qt
))
337 if (DISP_TABLE_P (Vstandard_display_table
))
340 for (ptrdiff_t i
= 0; i
< size_byte
; i
+= len
)
342 int ch
= STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr
+ i
,
344 printchar_to_stream (ch
, stdout
);
348 fwrite (ptr
, 1, size_byte
, stdout
);
350 noninteractive_need_newline
= 1;
352 else if (EQ (printcharfun
, Qt
))
354 /* Output to echo area. We're trying to avoid a little overhead
355 here, that's the reason we don't call printchar to do the
359 = !NILP (BVAR (current_buffer
, enable_multibyte_characters
));
361 setup_echo_area_for_printing (multibyte_p
);
362 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
364 if (size
== size_byte
)
366 for (i
= 0; i
< size
; ++i
)
367 insert_char ((unsigned char) *ptr
++);
372 for (i
= 0; i
< size_byte
; i
+= len
)
374 int ch
= STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr
+ i
,
382 /* PRINTCHARFUN is a Lisp function. */
385 if (size
== size_byte
)
387 while (i
< size_byte
)
390 printchar (ch
, printcharfun
);
395 while (i
< size_byte
)
397 /* Here, we must convert each multi-byte form to the
398 corresponding character code before handing it to
401 int ch
= STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr
+ i
,
403 printchar (ch
, printcharfun
);
410 /* Print the contents of a string STRING using PRINTCHARFUN.
411 It isn't safe to use strout in many cases,
412 because printing one char can relocate. */
415 print_string (Lisp_Object string
, Lisp_Object printcharfun
)
417 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
421 if (print_escape_nonascii
)
422 string
= string_escape_byte8 (string
);
424 if (STRING_MULTIBYTE (string
))
425 chars
= SCHARS (string
);
426 else if (! print_escape_nonascii
427 && (EQ (printcharfun
, Qt
)
428 ? ! NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))
429 : ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))))
431 /* If unibyte string STRING contains 8-bit codes, we must
432 convert STRING to a multibyte string containing the same
437 chars
= SBYTES (string
);
438 bytes
= count_size_as_multibyte (SDATA (string
), chars
);
441 newstr
= make_uninit_multibyte_string (chars
, bytes
);
442 memcpy (SDATA (newstr
), SDATA (string
), chars
);
443 str_to_multibyte (SDATA (newstr
), bytes
, chars
);
448 chars
= SBYTES (string
);
450 if (EQ (printcharfun
, Qt
))
452 /* Output to echo area. */
453 ptrdiff_t nbytes
= SBYTES (string
);
455 /* Copy the string contents so that relocation of STRING by
456 GC does not cause trouble. */
458 char *buffer
= SAFE_ALLOCA (nbytes
);
459 memcpy (buffer
, SDATA (string
), nbytes
);
461 strout (buffer
, chars
, nbytes
, printcharfun
);
466 /* No need to copy, since output to print_buffer can't GC. */
467 strout (SSDATA (string
), chars
, SBYTES (string
), printcharfun
);
471 /* Otherwise, string may be relocated by printing one char.
472 So re-fetch the string address for each character. */
474 ptrdiff_t size
= SCHARS (string
);
475 ptrdiff_t size_byte
= SBYTES (string
);
476 if (size
== size_byte
)
477 for (i
= 0; i
< size
; i
++)
478 printchar (SREF (string
, i
), printcharfun
);
480 for (i
= 0; i
< size_byte
; )
482 /* Here, we must convert each multi-byte form to the
483 corresponding character code before handing it to PRINTCHAR. */
485 int ch
= STRING_CHAR_AND_LENGTH (SDATA (string
) + i
, len
);
486 printchar (ch
, printcharfun
);
492 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
493 doc
: /* Output character CHARACTER to stream PRINTCHARFUN.
494 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
495 (Lisp_Object character
, Lisp_Object printcharfun
)
497 if (NILP (printcharfun
))
498 printcharfun
= Vstandard_output
;
499 CHECK_NUMBER (character
);
501 printchar (XINT (character
), printcharfun
);
506 /* Print the contents of a unibyte C string STRING using PRINTCHARFUN.
507 The caller should arrange to put this inside PRINTPREPARE and PRINTFINISH.
508 Do not use this on the contents of a Lisp string. */
511 print_c_string (char const *string
, Lisp_Object printcharfun
)
513 ptrdiff_t len
= strlen (string
);
514 strout (string
, len
, len
, printcharfun
);
517 /* Print unibyte C string at DATA on a specified stream PRINTCHARFUN.
518 Do not use this on the contents of a Lisp string. */
521 write_string_1 (const char *data
, Lisp_Object printcharfun
)
524 print_c_string (data
, printcharfun
);
528 /* Used from outside of print.c to print a C unibyte
529 string at DATA on the default output stream.
530 Do not use this on the contents of a Lisp string. */
533 write_string (const char *data
)
535 write_string_1 (data
, Vstandard_output
);
540 temp_output_buffer_setup (const char *bufname
)
542 ptrdiff_t count
= SPECPDL_INDEX ();
543 register struct buffer
*old
= current_buffer
;
544 register Lisp_Object buf
;
546 record_unwind_current_buffer ();
548 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
550 Fkill_all_local_variables ();
551 delete_all_overlays (current_buffer
);
552 bset_directory (current_buffer
, BVAR (old
, directory
));
553 bset_read_only (current_buffer
, Qnil
);
554 bset_filename (current_buffer
, Qnil
);
555 bset_undo_list (current_buffer
, Qt
);
556 eassert (current_buffer
->overlays_before
== NULL
);
557 eassert (current_buffer
->overlays_after
== NULL
);
558 bset_enable_multibyte_characters
559 (current_buffer
, BVAR (&buffer_defaults
, enable_multibyte_characters
));
560 specbind (Qinhibit_read_only
, Qt
);
561 specbind (Qinhibit_modification_hooks
, Qt
);
563 XSETBUFFER (buf
, current_buffer
);
565 run_hook (Qtemp_buffer_setup_hook
);
567 unbind_to (count
, Qnil
);
569 specbind (Qstandard_output
, buf
);
572 static void print (Lisp_Object
, Lisp_Object
, bool);
573 static void print_preprocess (Lisp_Object
);
574 static void print_preprocess_string (INTERVAL
, Lisp_Object
);
575 static void print_object (Lisp_Object
, Lisp_Object
, bool);
577 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 2, 0,
578 doc
: /* Output a newline to stream PRINTCHARFUN.
579 If ENSURE is non-nil only output a newline if not already at the
580 beginning of a line. Value is non-nil if a newline is printed.
581 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
582 (Lisp_Object printcharfun
, Lisp_Object ensure
)
586 if (NILP (printcharfun
))
587 printcharfun
= Vstandard_output
;
592 /* Difficult to check if at line beginning so abort. */
593 else if (FUNCTIONP (printcharfun
))
594 signal_error ("Unsupported function argument", printcharfun
);
595 else if (noninteractive
&& !NILP (printcharfun
))
596 val
= printchar_stdout_last
== 10 ? Qnil
: Qt
;
598 val
= NILP (Fbolp ()) ? Qt
: Qnil
;
601 printchar ('\n', printcharfun
);
606 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
607 doc
: /* Output the printed representation of OBJECT, any Lisp object.
608 Quoting characters are printed when needed to make output that `read'
609 can handle, whenever this is possible. For complex objects, the behavior
610 is controlled by `print-level' and `print-length', which see.
612 OBJECT is any of the Lisp data types: a number, a string, a symbol,
613 a list, a buffer, a window, a frame, etc.
615 A printed representation of an object is text which describes that object.
617 Optional argument PRINTCHARFUN is the output stream, which can be one
620 - a buffer, in which case output is inserted into that buffer at point;
621 - a marker, in which case output is inserted at marker's position;
622 - a function, in which case that function is called once for each
623 character of OBJECT's printed representation;
624 - a symbol, in which case that symbol's function definition is called; or
625 - t, in which case the output is displayed in the echo area.
627 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
629 (Lisp_Object object
, Lisp_Object printcharfun
)
631 if (NILP (printcharfun
))
632 printcharfun
= Vstandard_output
;
634 print (object
, printcharfun
, 1);
639 /* a buffer which is used to hold output being built by prin1-to-string */
640 Lisp_Object Vprin1_to_string_buffer
;
642 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
643 doc
: /* Return a string containing the printed representation of OBJECT.
644 OBJECT can be any Lisp object. This function outputs quoting characters
645 when necessary to make output that `read' can handle, whenever possible,
646 unless the optional second argument NOESCAPE is non-nil. For complex objects,
647 the behavior is controlled by `print-level' and `print-length', which see.
649 OBJECT is any of the Lisp data types: a number, a string, a symbol,
650 a list, a buffer, a window, a frame, etc.
652 A printed representation of an object is text which describes that object. */)
653 (Lisp_Object object
, Lisp_Object noescape
)
655 ptrdiff_t count
= SPECPDL_INDEX ();
657 specbind (Qinhibit_modification_hooks
, Qt
);
659 /* Save and restore this: we are altering a buffer
660 but we don't want to deactivate the mark just for that.
661 No need for specbind, since errors deactivate the mark. */
662 Lisp_Object save_deactivate_mark
= Vdeactivate_mark
;
663 bool prev_abort_on_gc
= abort_on_gc
;
666 Lisp_Object printcharfun
= Vprin1_to_string_buffer
;
668 print (object
, printcharfun
, NILP (noescape
));
669 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINISH */
672 struct buffer
*previous
= current_buffer
;
673 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
674 object
= Fbuffer_string ();
675 if (SBYTES (object
) == SCHARS (object
))
676 STRING_SET_UNIBYTE (object
);
678 /* Note that this won't make prepare_to_modify_buffer call
679 ask-user-about-supersession-threat because this buffer
680 does not visit a file. */
682 set_buffer_internal (previous
);
684 Vdeactivate_mark
= save_deactivate_mark
;
686 abort_on_gc
= prev_abort_on_gc
;
687 return unbind_to (count
, object
);
690 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
691 doc
: /* Output the printed representation of OBJECT, any Lisp object.
692 No quoting characters are used; no delimiters are printed around
693 the contents of strings.
695 OBJECT is any of the Lisp data types: a number, a string, a symbol,
696 a list, a buffer, a window, a frame, etc.
698 A printed representation of an object is text which describes that object.
700 Optional argument PRINTCHARFUN is the output stream, which can be one
703 - a buffer, in which case output is inserted into that buffer at point;
704 - a marker, in which case output is inserted at marker's position;
705 - a function, in which case that function is called once for each
706 character of OBJECT's printed representation;
707 - a symbol, in which case that symbol's function definition is called; or
708 - t, in which case the output is displayed in the echo area.
710 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
712 (Lisp_Object object
, Lisp_Object printcharfun
)
714 if (NILP (printcharfun
))
715 printcharfun
= Vstandard_output
;
717 print (object
, printcharfun
, 0);
722 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
723 doc
: /* Output the printed representation of OBJECT, with newlines around it.
724 Quoting characters are printed when needed to make output that `read'
725 can handle, whenever this is possible. For complex objects, the behavior
726 is controlled by `print-level' and `print-length', which see.
728 OBJECT is any of the Lisp data types: a number, a string, a symbol,
729 a list, a buffer, a window, a frame, etc.
731 A printed representation of an object is text which describes that object.
733 Optional argument PRINTCHARFUN is the output stream, which can be one
736 - a buffer, in which case output is inserted into that buffer at point;
737 - a marker, in which case output is inserted at marker's position;
738 - a function, in which case that function is called once for each
739 character of OBJECT's printed representation;
740 - a symbol, in which case that symbol's function definition is called; or
741 - t, in which case the output is displayed in the echo area.
743 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
745 (Lisp_Object object
, Lisp_Object printcharfun
)
747 if (NILP (printcharfun
))
748 printcharfun
= Vstandard_output
;
750 printchar ('\n', printcharfun
);
751 print (object
, printcharfun
, 1);
752 printchar ('\n', printcharfun
);
757 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
758 doc
: /* Write CHARACTER to stderr.
759 You can call print while debugging emacs, and pass it this function
760 to make it write to the debugging output. */)
761 (Lisp_Object character
)
763 CHECK_NUMBER (character
);
764 printchar_to_stream (XINT (character
), stderr
);
768 /* This function is never called. Its purpose is to prevent
769 print_output_debug_flag from being optimized away. */
771 extern void debug_output_compilation_hack (bool) EXTERNALLY_VISIBLE
;
773 debug_output_compilation_hack (bool x
)
775 print_output_debug_flag
= x
;
778 DEFUN ("redirect-debugging-output", Fredirect_debugging_output
, Sredirect_debugging_output
,
780 "FDebug output file: \nP",
781 doc
: /* Redirect debugging output (stderr stream) to file FILE.
782 If FILE is nil, reset target to the initial stderr stream.
783 Optional arg APPEND non-nil (interactively, with prefix arg) means
784 append to existing target file. */)
785 (Lisp_Object file
, Lisp_Object append
)
787 /* If equal to STDERR_FILENO, stderr has not been duplicated and is OK as-is.
788 Otherwise, this is a close-on-exec duplicate of the original stderr. */
789 static int stderr_dup
= STDERR_FILENO
;
794 file
= Fexpand_file_name (file
, Qnil
);
796 if (stderr_dup
== STDERR_FILENO
)
798 int n
= fcntl (STDERR_FILENO
, F_DUPFD_CLOEXEC
, STDERR_FILENO
+ 1);
800 report_file_error ("dup", file
);
804 fd
= emacs_open (SSDATA (ENCODE_FILE (file
)),
806 | (! NILP (append
) ? O_APPEND
: O_TRUNC
)),
809 report_file_error ("Cannot open debugging output stream", file
);
813 if (dup2 (fd
, STDERR_FILENO
) < 0)
814 report_file_error ("dup2", file
);
815 if (fd
!= stderr_dup
)
821 /* This is the interface for debugging printing. */
824 debug_print (Lisp_Object arg
)
826 Fprin1 (arg
, Qexternal_debugging_output
);
827 fprintf (stderr
, "\r\n");
830 void safe_debug_print (Lisp_Object
) EXTERNALLY_VISIBLE
;
832 safe_debug_print (Lisp_Object arg
)
834 int valid
= valid_lisp_object_p (arg
);
840 EMACS_UINT n
= XLI (arg
);
841 fprintf (stderr
, "#<%s_LISP_OBJECT 0x%08"pI
"x>\r\n",
842 !valid
? "INVALID" : "SOME",
848 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
850 doc
: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
851 See Info anchor `(elisp)Definition of signal' for some details on how this
852 error message is constructed. */)
855 struct buffer
*old
= current_buffer
;
858 /* If OBJ is (error STRING), just return STRING.
859 That is not only faster, it also avoids the need to allocate
860 space here when the error is due to memory full. */
861 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
862 && CONSP (XCDR (obj
))
863 && STRINGP (XCAR (XCDR (obj
)))
864 && NILP (XCDR (XCDR (obj
))))
865 return XCAR (XCDR (obj
));
867 print_error_message (obj
, Vprin1_to_string_buffer
, 0, Qnil
);
869 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
870 value
= Fbuffer_string ();
873 set_buffer_internal (old
);
878 /* Print an error message for the error DATA onto Lisp output stream
879 STREAM (suitable for the print functions).
880 CONTEXT is a C string describing the context of the error.
881 CALLER is the Lisp function inside which the error was signaled. */
884 print_error_message (Lisp_Object data
, Lisp_Object stream
, const char *context
,
887 Lisp_Object errname
, errmsg
, file_error
, tail
;
890 write_string_1 (context
, stream
);
892 /* If we know from where the error was signaled, show it in
894 if (!NILP (caller
) && SYMBOLP (caller
))
896 Lisp_Object cname
= SYMBOL_NAME (caller
);
897 ptrdiff_t cnamelen
= SBYTES (cname
);
899 char *name
= SAFE_ALLOCA (cnamelen
);
900 memcpy (name
, SDATA (cname
), cnamelen
);
901 message_dolog (name
, cnamelen
, 0, STRING_MULTIBYTE (cname
));
902 message_dolog (": ", 2, 0, 0);
906 errname
= Fcar (data
);
908 if (EQ (errname
, Qerror
))
913 errmsg
= Fcar (data
);
918 Lisp_Object error_conditions
= Fget (errname
, Qerror_conditions
);
919 errmsg
= Fget (errname
, Qerror_message
);
920 file_error
= Fmemq (Qfile_error
, error_conditions
);
923 /* Print an error message including the data items. */
925 tail
= Fcdr_safe (data
);
927 /* For file-error, make error message by concatenating
928 all the data items. They are all strings. */
929 if (!NILP (file_error
) && CONSP (tail
))
930 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
933 const char *sep
= ": ";
935 if (!STRINGP (errmsg
))
936 write_string_1 ("peculiar error", stream
);
937 else if (SCHARS (errmsg
))
938 Fprinc (Fsubstitute_command_keys (errmsg
), stream
);
942 for (; CONSP (tail
); tail
= XCDR (tail
), sep
= ", ")
947 write_string_1 (sep
, stream
);
949 if (!NILP (file_error
)
950 || EQ (errname
, Qend_of_file
) || EQ (errname
, Quser_error
))
951 Fprinc (obj
, stream
);
953 Fprin1 (obj
, stream
);
961 * The buffer should be at least as large as the max string size of the
962 * largest float, printed in the biggest notation. This is undoubtedly
963 * 20d float_output_format, with the negative of the C-constant "HUGE"
966 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
968 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
969 * case of -1e307 in 20d float_output_format. What is one to do (short of
970 * re-writing _doprnt to be more sane)?
972 * Given the above, the buffer must be least FLOAT_TO_STRING_BUFSIZE bytes.
976 float_to_string (char *buf
, double data
)
982 /* Check for plus infinity in a way that won't lose
983 if there is no plus infinity. */
984 if (data
== data
/ 2 && data
> 1.0)
986 static char const infinity_string
[] = "1.0e+INF";
987 strcpy (buf
, infinity_string
);
988 return sizeof infinity_string
- 1;
990 /* Likewise for minus infinity. */
991 if (data
== data
/ 2 && data
< -1.0)
993 static char const minus_infinity_string
[] = "-1.0e+INF";
994 strcpy (buf
, minus_infinity_string
);
995 return sizeof minus_infinity_string
- 1;
997 /* Check for NaN in a way that won't fail if there are no NaNs. */
998 if (! (data
* 0.0 >= 0.0))
1000 /* Prepend "-" if the NaN's sign bit is negative.
1001 The sign bit of a double is the bit that is 1 in -0.0. */
1002 static char const NaN_string
[] = "0.0e+NaN";
1004 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
1007 u_minus_zero
.d
= - 0.0;
1008 for (i
= 0; i
< sizeof (double); i
++)
1009 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1016 strcpy (buf
+ negative
, NaN_string
);
1017 return negative
+ sizeof NaN_string
- 1;
1020 if (NILP (Vfloat_output_format
)
1021 || !STRINGP (Vfloat_output_format
))
1024 /* Generate the fewest number of digits that represent the
1025 floating point value without losing information. */
1026 len
= dtoastr (buf
, FLOAT_TO_STRING_BUFSIZE
- 2, 0, 0, data
);
1027 /* The decimal point must be printed, or the byte compiler can
1028 get confused (Bug#8033). */
1031 else /* oink oink */
1033 /* Check that the spec we have is fully valid.
1034 This means not only valid for printf,
1035 but meant for floats, and reasonable. */
1036 cp
= SSDATA (Vfloat_output_format
);
1045 /* Check the width specification. */
1047 if ('0' <= *cp
&& *cp
<= '9')
1052 width
= (width
* 10) + (*cp
++ - '0');
1053 if (DBL_DIG
< width
)
1056 while (*cp
>= '0' && *cp
<= '9');
1058 /* A precision of zero is valid only for %f. */
1059 if (width
== 0 && *cp
!= 'f')
1063 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1069 len
= sprintf (buf
, SSDATA (Vfloat_output_format
), data
);
1072 /* Make sure there is a decimal point with digit after, or an
1073 exponent, so that the value is readable as a float. But don't do
1074 this with "%.0f"; it's valid for that not to produce a decimal
1075 point. Note that width can be 0 only for %.0f. */
1078 for (cp
= buf
; *cp
; cp
++)
1079 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1082 if (*cp
== '.' && cp
[1] == 0)
1102 print (Lisp_Object obj
, Lisp_Object printcharfun
, bool escapeflag
)
1104 new_backquote_output
= 0;
1106 /* Reset print_number_index and Vprint_number_table only when
1107 the variable Vprint_continuous_numbering is nil. Otherwise,
1108 the values of these variables will be kept between several
1110 if (NILP (Vprint_continuous_numbering
)
1111 || NILP (Vprint_number_table
))
1113 print_number_index
= 0;
1114 Vprint_number_table
= Qnil
;
1117 /* Construct Vprint_number_table for print-gensym and print-circle. */
1118 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1120 /* Construct Vprint_number_table.
1121 This increments print_number_index for the objects added. */
1123 print_preprocess (obj
);
1125 if (HASH_TABLE_P (Vprint_number_table
))
1126 { /* Remove unnecessary objects, which appear only once in OBJ;
1127 that is, whose status is Qt. */
1128 struct Lisp_Hash_Table
*h
= XHASH_TABLE (Vprint_number_table
);
1131 for (i
= 0; i
< HASH_TABLE_SIZE (h
); ++i
)
1132 if (!NILP (HASH_HASH (h
, i
))
1133 && EQ (HASH_VALUE (h
, i
), Qt
))
1134 Fremhash (HASH_KEY (h
, i
), Vprint_number_table
);
1139 print_object (obj
, printcharfun
, escapeflag
);
1142 #define PRINT_CIRCLE_CANDIDATE_P(obj) \
1143 (STRINGP (obj) || CONSP (obj) \
1144 || (VECTORLIKEP (obj) \
1145 && (VECTORP (obj) || COMPILEDP (obj) \
1146 || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \
1147 || HASH_TABLE_P (obj) || FONTP (obj))) \
1148 || (! NILP (Vprint_gensym) \
1150 && !SYMBOL_INTERNED_P (obj)))
1152 /* Construct Vprint_number_table according to the structure of OBJ.
1153 OBJ itself and all its elements will be added to Vprint_number_table
1154 recursively if it is a list, vector, compiled function, char-table,
1155 string (its text properties will be traced), or a symbol that has
1156 no obarray (this is for the print-gensym feature).
1157 The status fields of Vprint_number_table mean whether each object appears
1158 more than once in OBJ: Qnil at the first time, and Qt after that. */
1160 print_preprocess (Lisp_Object obj
)
1165 Lisp_Object halftail
;
1167 /* Avoid infinite recursion for circular nested structure
1168 in the case where Vprint_circle is nil. */
1169 if (NILP (Vprint_circle
))
1171 /* Give up if we go so deep that print_object will get an error. */
1172 /* See similar code in print_object. */
1173 if (print_depth
>= PRINT_CIRCLE
)
1174 error ("Apparently circular structure being printed");
1176 for (i
= 0; i
< print_depth
; i
++)
1177 if (EQ (obj
, being_printed
[i
]))
1179 being_printed
[print_depth
] = obj
;
1186 if (PRINT_CIRCLE_CANDIDATE_P (obj
))
1188 if (!HASH_TABLE_P (Vprint_number_table
))
1189 Vprint_number_table
= CALLN (Fmake_hash_table
, QCtest
, Qeq
);
1191 /* In case print-circle is nil and print-gensym is t,
1192 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1193 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1195 Lisp_Object num
= Fgethash (obj
, Vprint_number_table
, Qnil
);
1197 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1198 always print the gensym with a number. This is a special for
1199 the lisp function byte-compile-output-docform. */
1200 || (!NILP (Vprint_continuous_numbering
)
1202 && !SYMBOL_INTERNED_P (obj
)))
1203 { /* OBJ appears more than once. Let's remember that. */
1204 if (!INTEGERP (num
))
1206 print_number_index
++;
1207 /* Negative number indicates it hasn't been printed yet. */
1208 Fputhash (obj
, make_number (- print_number_index
),
1209 Vprint_number_table
);
1215 /* OBJ is not yet recorded. Let's add to the table. */
1216 Fputhash (obj
, Qt
, Vprint_number_table
);
1219 switch (XTYPE (obj
))
1222 /* A string may have text properties, which can be circular. */
1223 traverse_intervals_noorder (string_intervals (obj
),
1224 print_preprocess_string
, Qnil
);
1228 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1229 just as in print_object. */
1230 if (loop_count
&& EQ (obj
, halftail
))
1232 print_preprocess (XCAR (obj
));
1235 if (!(loop_count
& 1))
1236 halftail
= XCDR (halftail
);
1239 case Lisp_Vectorlike
:
1241 if (size
& PSEUDOVECTOR_FLAG
)
1242 size
&= PSEUDOVECTOR_SIZE_MASK
;
1243 for (i
= (SUB_CHAR_TABLE_P (obj
)
1244 ? SUB_CHAR_TABLE_OFFSET
: 0); i
< size
; i
++)
1245 print_preprocess (AREF (obj
, i
));
1246 if (HASH_TABLE_P (obj
))
1247 { /* For hash tables, the key_and_value slot is past
1248 `size' because it needs to be marked specially in case
1249 the table is weak. */
1250 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1251 print_preprocess (h
->key_and_value
);
1263 print_preprocess_string (INTERVAL interval
, Lisp_Object arg
)
1265 print_preprocess (interval
->plist
);
1268 static void print_check_string_charset_prop (INTERVAL interval
, Lisp_Object string
);
1270 #define PRINT_STRING_NON_CHARSET_FOUND 1
1271 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
1273 /* Bitwise or of the above macros. */
1274 static int print_check_string_result
;
1277 print_check_string_charset_prop (INTERVAL interval
, Lisp_Object string
)
1281 if (NILP (interval
->plist
)
1282 || (print_check_string_result
== (PRINT_STRING_NON_CHARSET_FOUND
1283 | PRINT_STRING_UNSAFE_CHARSET_FOUND
)))
1285 for (val
= interval
->plist
; CONSP (val
) && ! EQ (XCAR (val
), Qcharset
);
1286 val
= XCDR (XCDR (val
)));
1289 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1292 if (! (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
))
1294 if (! EQ (val
, interval
->plist
)
1295 || CONSP (XCDR (XCDR (val
))))
1296 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1298 if (NILP (Vprint_charset_text_property
)
1299 || ! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1302 ptrdiff_t charpos
= interval
->position
;
1303 ptrdiff_t bytepos
= string_char_to_byte (string
, charpos
);
1304 Lisp_Object charset
;
1306 charset
= XCAR (XCDR (val
));
1307 for (i
= 0; i
< LENGTH (interval
); i
++)
1309 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1310 if (! ASCII_CHAR_P (c
)
1311 && ! EQ (CHARSET_NAME (CHAR_CHARSET (c
)), charset
))
1313 print_check_string_result
|= PRINT_STRING_UNSAFE_CHARSET_FOUND
;
1320 /* The value is (charset . nil). */
1321 static Lisp_Object print_prune_charset_plist
;
1324 print_prune_string_charset (Lisp_Object string
)
1326 print_check_string_result
= 0;
1327 traverse_intervals (string_intervals (string
), 0,
1328 print_check_string_charset_prop
, string
);
1329 if (! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1331 string
= Fcopy_sequence (string
);
1332 if (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
)
1334 if (NILP (print_prune_charset_plist
))
1335 print_prune_charset_plist
= list1 (Qcharset
);
1336 Fremove_text_properties (make_number (0),
1337 make_number (SCHARS (string
)),
1338 print_prune_charset_plist
, string
);
1341 Fset_text_properties (make_number (0), make_number (SCHARS (string
)),
1348 print_object (Lisp_Object obj
, Lisp_Object printcharfun
, bool escapeflag
)
1350 char buf
[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT
),
1351 max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t
),
1356 /* Detect circularities and truncate them. */
1357 if (NILP (Vprint_circle
))
1359 /* Simple but incomplete way. */
1362 /* See similar code in print_preprocess. */
1363 if (print_depth
>= PRINT_CIRCLE
)
1364 error ("Apparently circular structure being printed");
1366 for (i
= 0; i
< print_depth
; i
++)
1367 if (EQ (obj
, being_printed
[i
]))
1369 int len
= sprintf (buf
, "#%d", i
);
1370 strout (buf
, len
, len
, printcharfun
);
1373 being_printed
[print_depth
] = obj
;
1375 else if (PRINT_CIRCLE_CANDIDATE_P (obj
))
1377 /* With the print-circle feature. */
1378 Lisp_Object num
= Fgethash (obj
, Vprint_number_table
, Qnil
);
1381 EMACS_INT n
= XINT (num
);
1383 { /* Add a prefix #n= if OBJ has not yet been printed;
1384 that is, its status field is nil. */
1385 int len
= sprintf (buf
, "#%"pI
"d=", -n
);
1386 strout (buf
, len
, len
, printcharfun
);
1387 /* OBJ is going to be printed. Remember that fact. */
1388 Fputhash (obj
, make_number (- n
), Vprint_number_table
);
1392 /* Just print #n# if OBJ has already been printed. */
1393 int len
= sprintf (buf
, "#%"pI
"d#", n
);
1394 strout (buf
, len
, len
, printcharfun
);
1402 switch (XTYPE (obj
))
1406 int len
= sprintf (buf
, "%"pI
"d", XINT (obj
));
1407 strout (buf
, len
, len
, printcharfun
);
1413 char pigbuf
[FLOAT_TO_STRING_BUFSIZE
];
1414 int len
= float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1415 strout (pigbuf
, len
, len
, printcharfun
);
1421 print_string (obj
, printcharfun
);
1424 ptrdiff_t i
, i_byte
;
1425 ptrdiff_t size_byte
;
1426 /* True means we must ensure that the next character we output
1427 cannot be taken as part of a hex character escape. */
1428 bool need_nonhex
= false;
1429 bool multibyte
= STRING_MULTIBYTE (obj
);
1431 if (! EQ (Vprint_charset_text_property
, Qt
))
1432 obj
= print_prune_string_charset (obj
);
1434 if (string_intervals (obj
))
1435 print_c_string ("#(", printcharfun
);
1437 printchar ('\"', printcharfun
);
1438 size_byte
= SBYTES (obj
);
1440 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1442 /* Here, we must convert each multi-byte form to the
1443 corresponding character code before handing it to printchar. */
1446 FETCH_STRING_CHAR_ADVANCE (c
, obj
, i
, i_byte
);
1451 ? (CHAR_BYTE8_P (c
) && (c
= CHAR_TO_BYTE8 (c
), true))
1452 : (SINGLE_BYTE_CHAR_P (c
) && ! ASCII_CHAR_P (c
)
1453 && print_escape_nonascii
))
1455 /* When printing a raw 8-bit byte in a multibyte buffer, or
1456 (when requested) a non-ASCII character in a unibyte buffer,
1457 print single-byte non-ASCII string chars
1458 using octal escapes. */
1460 int len
= sprintf (outbuf
, "\\%03o", c
+ 0u);
1461 strout (outbuf
, len
, len
, printcharfun
);
1462 need_nonhex
= false;
1465 && ! ASCII_CHAR_P (c
) && print_escape_multibyte
)
1467 /* When requested, print multibyte chars using hex escapes. */
1468 char outbuf
[sizeof "\\x" + INT_STRLEN_BOUND (c
)];
1469 int len
= sprintf (outbuf
, "\\x%04x", c
+ 0u);
1470 strout (outbuf
, len
, len
, printcharfun
);
1475 /* If we just had a hex escape, and this character
1476 could be taken as part of it,
1477 output `\ ' to prevent that. */
1478 if (need_nonhex
&& c_isxdigit (c
))
1479 print_c_string ("\\ ", printcharfun
);
1481 if (c
== '\n' && print_escape_newlines
1483 : c
== '\f' && print_escape_newlines
1485 : c
== '\"' || c
== '\\')
1486 printchar ('\\', printcharfun
);
1488 printchar (c
, printcharfun
);
1489 need_nonhex
= false;
1492 printchar ('\"', printcharfun
);
1494 if (string_intervals (obj
))
1496 traverse_intervals (string_intervals (obj
),
1497 0, print_interval
, printcharfun
);
1498 printchar (')', printcharfun
);
1506 unsigned char *p
= SDATA (SYMBOL_NAME (obj
));
1507 unsigned char *end
= p
+ SBYTES (SYMBOL_NAME (obj
));
1509 ptrdiff_t i
, i_byte
;
1510 ptrdiff_t size_byte
;
1513 name
= SYMBOL_NAME (obj
);
1515 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1518 /* If symbol name begins with a digit, and ends with a digit,
1519 and contains nothing but digits and `e', it could be treated
1520 as a number. So set CONFUSING.
1522 Symbols that contain periods could also be taken as numbers,
1523 but periods are always escaped, so we don't have to worry
1525 else if (*p
>= '0' && *p
<= '9'
1526 && end
[-1] >= '0' && end
[-1] <= '9')
1528 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1529 /* Needed for \2e10. */
1530 || *p
== 'e' || *p
== 'E'))
1532 confusing
= (end
== p
);
1537 size_byte
= SBYTES (name
);
1539 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1540 print_c_string ("#:", printcharfun
);
1541 else if (size_byte
== 0)
1543 print_c_string ("##", printcharfun
);
1547 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1549 /* Here, we must convert each multi-byte form to the
1550 corresponding character code before handing it to PRINTCHAR. */
1551 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1556 if (c
== '\"' || c
== '\\' || c
== '\''
1557 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1558 || c
== ',' || c
== '.' || c
== '`'
1559 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1562 printchar ('\\', printcharfun
);
1566 printchar (c
, printcharfun
);
1572 /* If deeper than spec'd depth, print placeholder. */
1573 if (INTEGERP (Vprint_level
)
1574 && print_depth
> XINT (Vprint_level
))
1575 print_c_string ("...", printcharfun
);
1576 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1577 && EQ (XCAR (obj
), Qquote
))
1579 printchar ('\'', printcharfun
);
1580 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1582 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1583 && EQ (XCAR (obj
), Qfunction
))
1585 print_c_string ("#'", printcharfun
);
1586 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1588 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1589 && EQ (XCAR (obj
), Qbackquote
))
1591 printchar ('`', printcharfun
);
1592 new_backquote_output
++;
1593 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1594 new_backquote_output
--;
1596 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1597 && new_backquote_output
1598 && (EQ (XCAR (obj
), Qcomma
)
1599 || EQ (XCAR (obj
), Qcomma_at
)
1600 || EQ (XCAR (obj
), Qcomma_dot
)))
1602 print_object (XCAR (obj
), printcharfun
, false);
1603 new_backquote_output
--;
1604 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1605 new_backquote_output
++;
1609 printchar ('(', printcharfun
);
1611 Lisp_Object halftail
= obj
;
1613 /* Negative values of print-length are invalid in CL.
1614 Treat them like nil, as CMUCL does. */
1615 printmax_t print_length
= (NATNUMP (Vprint_length
)
1616 ? XFASTINT (Vprint_length
)
1617 : TYPE_MAXIMUM (printmax_t
));
1622 /* Detect circular list. */
1623 if (NILP (Vprint_circle
))
1625 /* Simple but incomplete way. */
1626 if (i
!= 0 && EQ (obj
, halftail
))
1628 int len
= sprintf (buf
, " . #%"pMd
, i
/ 2);
1629 strout (buf
, len
, len
, printcharfun
);
1635 /* With the print-circle feature. */
1638 Lisp_Object num
= Fgethash (obj
, Vprint_number_table
, Qnil
);
1641 print_c_string (" . ", printcharfun
);
1642 print_object (obj
, printcharfun
, escapeflag
);
1649 printchar (' ', printcharfun
);
1651 if (print_length
<= i
)
1653 print_c_string ("...", printcharfun
);
1658 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1662 halftail
= XCDR (halftail
);
1665 /* OBJ non-nil here means it's the end of a dotted list. */
1668 print_c_string (" . ", printcharfun
);
1669 print_object (obj
, printcharfun
, escapeflag
);
1673 printchar (')', printcharfun
);
1677 case Lisp_Vectorlike
:
1682 print_c_string ("#<process ", printcharfun
);
1683 print_string (XPROCESS (obj
)->name
, printcharfun
);
1684 printchar ('>', printcharfun
);
1687 print_string (XPROCESS (obj
)->name
, printcharfun
);
1689 else if (BOOL_VECTOR_P (obj
))
1693 EMACS_INT size
= bool_vector_size (obj
);
1694 ptrdiff_t size_in_chars
= bool_vector_bytes (size
);
1695 ptrdiff_t real_size_in_chars
= size_in_chars
;
1697 int len
= sprintf (buf
, "#&%"pI
"d\"", size
);
1698 strout (buf
, len
, len
, printcharfun
);
1700 /* Don't print more characters than the specified maximum.
1701 Negative values of print-length are invalid. Treat them
1702 like a print-length of nil. */
1703 if (NATNUMP (Vprint_length
)
1704 && XFASTINT (Vprint_length
) < size_in_chars
)
1705 size_in_chars
= XFASTINT (Vprint_length
);
1707 for (i
= 0; i
< size_in_chars
; i
++)
1710 c
= bool_vector_uchar_data (obj
)[i
];
1711 if (c
== '\n' && print_escape_newlines
)
1712 print_c_string ("\\n", printcharfun
);
1713 else if (c
== '\f' && print_escape_newlines
)
1714 print_c_string ("\\f", printcharfun
);
1715 else if (c
> '\177')
1717 /* Use octal escapes to avoid encoding issues. */
1718 len
= sprintf (buf
, "\\%o", c
);
1719 strout (buf
, len
, len
, printcharfun
);
1723 if (c
== '\"' || c
== '\\')
1724 printchar ('\\', printcharfun
);
1725 printchar (c
, printcharfun
);
1729 if (size_in_chars
< real_size_in_chars
)
1730 print_c_string (" ...", printcharfun
);
1731 printchar ('\"', printcharfun
);
1733 else if (SUBRP (obj
))
1735 print_c_string ("#<subr ", printcharfun
);
1736 print_c_string (XSUBR (obj
)->symbol_name
, printcharfun
);
1737 printchar ('>', printcharfun
);
1739 else if (XWIDGETP (obj
) || XWIDGET_VIEW_P (obj
))
1741 print_c_string ("#<xwidget ", printcharfun
);
1742 printchar ('>', printcharfun
);
1744 else if (WINDOWP (obj
))
1746 int len
= sprintf (buf
, "#<window %"pI
"d",
1747 XWINDOW (obj
)->sequence_number
);
1748 strout (buf
, len
, len
, printcharfun
);
1749 if (BUFFERP (XWINDOW (obj
)->contents
))
1751 print_c_string (" on ", printcharfun
);
1752 print_string (BVAR (XBUFFER (XWINDOW (obj
)->contents
), name
),
1755 printchar ('>', printcharfun
);
1757 else if (TERMINALP (obj
))
1759 struct terminal
*t
= XTERMINAL (obj
);
1760 int len
= sprintf (buf
, "#<terminal %d", t
->id
);
1761 strout (buf
, len
, len
, printcharfun
);
1764 print_c_string (" on ", printcharfun
);
1765 print_c_string (t
->name
, printcharfun
);
1767 printchar ('>', printcharfun
);
1769 else if (HASH_TABLE_P (obj
))
1771 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1773 ptrdiff_t real_size
, size
;
1777 print_c_string ("#<hash-table", printcharfun
);
1778 if (SYMBOLP (h
->test
))
1780 print_c_string (" '", printcharfun
);
1781 print_c_string (SSDATA (SYMBOL_NAME (h
->test
)), printcharfun
);
1782 printchar (' ', printcharfun
);
1783 print_c_string (SSDATA (SYMBOL_NAME (h
->weak
)), printcharfun
);
1784 len
= sprintf (buf
, " %"pD
"d/%"pD
"d", h
->count
, ASIZE (h
->next
));
1785 strout (buf
, len
, len
, printcharfun
);
1787 len
= sprintf (buf
, " %p>", ptr
);
1788 strout (buf
, len
, len
, printcharfun
);
1790 /* Implement a readable output, e.g.:
1791 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
1792 /* Always print the size. */
1793 len
= sprintf (buf
, "#s(hash-table size %"pD
"d", ASIZE (h
->next
));
1794 strout (buf
, len
, len
, printcharfun
);
1796 if (!NILP (h
->test
.name
))
1798 print_c_string (" test ", printcharfun
);
1799 print_object (h
->test
.name
, printcharfun
, escapeflag
);
1802 if (!NILP (h
->weak
))
1804 print_c_string (" weakness ", printcharfun
);
1805 print_object (h
->weak
, printcharfun
, escapeflag
);
1808 if (!NILP (h
->rehash_size
))
1810 print_c_string (" rehash-size ", printcharfun
);
1811 print_object (h
->rehash_size
, printcharfun
, escapeflag
);
1814 if (!NILP (h
->rehash_threshold
))
1816 print_c_string (" rehash-threshold ", printcharfun
);
1817 print_object (h
->rehash_threshold
, printcharfun
, escapeflag
);
1820 print_c_string (" data ", printcharfun
);
1822 /* Print the data here as a plist. */
1823 real_size
= HASH_TABLE_SIZE (h
);
1826 /* Don't print more elements than the specified maximum. */
1827 if (NATNUMP (Vprint_length
)
1828 && XFASTINT (Vprint_length
) < size
)
1829 size
= XFASTINT (Vprint_length
);
1831 printchar ('(', printcharfun
);
1832 for (i
= 0; i
< size
; i
++)
1833 if (!NILP (HASH_HASH (h
, i
)))
1835 if (i
) printchar (' ', printcharfun
);
1836 print_object (HASH_KEY (h
, i
), printcharfun
, escapeflag
);
1837 printchar (' ', printcharfun
);
1838 print_object (HASH_VALUE (h
, i
), printcharfun
, escapeflag
);
1841 if (size
< real_size
)
1842 print_c_string (" ...", printcharfun
);
1844 print_c_string ("))", printcharfun
);
1847 else if (BUFFERP (obj
))
1849 if (!BUFFER_LIVE_P (XBUFFER (obj
)))
1850 print_c_string ("#<killed buffer>", printcharfun
);
1851 else if (escapeflag
)
1853 print_c_string ("#<buffer ", printcharfun
);
1854 print_string (BVAR (XBUFFER (obj
), name
), printcharfun
);
1855 printchar ('>', printcharfun
);
1858 print_string (BVAR (XBUFFER (obj
), name
), printcharfun
);
1860 else if (WINDOW_CONFIGURATIONP (obj
))
1861 print_c_string ("#<window-configuration>", printcharfun
);
1862 else if (FRAMEP (obj
))
1865 void *ptr
= XFRAME (obj
);
1866 Lisp_Object frame_name
= XFRAME (obj
)->name
;
1868 print_c_string ((FRAME_LIVE_P (XFRAME (obj
))
1872 if (!STRINGP (frame_name
))
1874 /* A frame could be too young and have no name yet;
1876 if (SYMBOLP (frame_name
))
1877 frame_name
= Fsymbol_name (frame_name
);
1878 else /* can't happen: name should be either nil or string */
1879 frame_name
= build_string ("*INVALID*FRAME*NAME*");
1881 print_string (frame_name
, printcharfun
);
1882 len
= sprintf (buf
, " %p>", ptr
);
1883 strout (buf
, len
, len
, printcharfun
);
1885 else if (FONTP (obj
))
1889 if (! FONT_OBJECT_P (obj
))
1891 if (FONT_SPEC_P (obj
))
1892 print_c_string ("#<font-spec", printcharfun
);
1894 print_c_string ("#<font-entity", printcharfun
);
1895 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
1897 printchar (' ', printcharfun
);
1898 if (i
< FONT_WEIGHT_INDEX
|| i
> FONT_WIDTH_INDEX
)
1899 print_object (AREF (obj
, i
), printcharfun
, escapeflag
);
1901 print_object (font_style_symbolic (obj
, i
, 0),
1902 printcharfun
, escapeflag
);
1907 print_c_string ("#<font-object ", printcharfun
);
1908 print_object (AREF (obj
, FONT_NAME_INDEX
), printcharfun
,
1911 printchar ('>', printcharfun
);
1915 ptrdiff_t size
= ASIZE (obj
);
1916 if (COMPILEDP (obj
))
1918 printchar ('#', printcharfun
);
1919 size
&= PSEUDOVECTOR_SIZE_MASK
;
1921 if (CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
))
1923 /* We print a char-table as if it were a vector,
1924 lumping the parent and default slots in with the
1925 character slots. But we add #^ as a prefix. */
1927 /* Make each lowest sub_char_table start a new line.
1928 Otherwise we'll make a line extremely long, which
1929 results in slow redisplay. */
1930 if (SUB_CHAR_TABLE_P (obj
)
1931 && XSUB_CHAR_TABLE (obj
)->depth
== 3)
1932 printchar ('\n', printcharfun
);
1933 print_c_string ("#^", printcharfun
);
1934 if (SUB_CHAR_TABLE_P (obj
))
1935 printchar ('^', printcharfun
);
1936 size
&= PSEUDOVECTOR_SIZE_MASK
;
1938 if (size
& PSEUDOVECTOR_FLAG
)
1941 printchar ('[', printcharfun
);
1943 int i
, idx
= SUB_CHAR_TABLE_P (obj
) ? SUB_CHAR_TABLE_OFFSET
: 0;
1945 ptrdiff_t real_size
= size
;
1947 /* For a sub char-table, print heading non-Lisp data first. */
1948 if (SUB_CHAR_TABLE_P (obj
))
1950 i
= sprintf (buf
, "%d %d", XSUB_CHAR_TABLE (obj
)->depth
,
1951 XSUB_CHAR_TABLE (obj
)->min_char
);
1952 strout (buf
, i
, i
, printcharfun
);
1955 /* Don't print more elements than the specified maximum. */
1956 if (NATNUMP (Vprint_length
)
1957 && XFASTINT (Vprint_length
) < size
)
1958 size
= XFASTINT (Vprint_length
);
1960 for (i
= idx
; i
< size
; i
++)
1962 if (i
) printchar (' ', printcharfun
);
1963 tem
= AREF (obj
, i
);
1964 print_object (tem
, printcharfun
, escapeflag
);
1966 if (size
< real_size
)
1967 print_c_string (" ...", printcharfun
);
1969 printchar (']', printcharfun
);
1974 switch (XMISCTYPE (obj
))
1976 case Lisp_Misc_Marker
:
1977 print_c_string ("#<marker ", printcharfun
);
1978 /* Do you think this is necessary? */
1979 if (XMARKER (obj
)->insertion_type
!= 0)
1980 print_c_string ("(moves after insertion) ", printcharfun
);
1981 if (! XMARKER (obj
)->buffer
)
1982 print_c_string ("in no buffer", printcharfun
);
1985 int len
= sprintf (buf
, "at %"pD
"d in ", marker_position (obj
));
1986 strout (buf
, len
, len
, printcharfun
);
1987 print_string (BVAR (XMARKER (obj
)->buffer
, name
), printcharfun
);
1989 printchar ('>', printcharfun
);
1992 case Lisp_Misc_Overlay
:
1993 print_c_string ("#<overlay ", printcharfun
);
1994 if (! XMARKER (OVERLAY_START (obj
))->buffer
)
1995 print_c_string ("in no buffer", printcharfun
);
1998 int len
= sprintf (buf
, "from %"pD
"d to %"pD
"d in ",
1999 marker_position (OVERLAY_START (obj
)),
2000 marker_position (OVERLAY_END (obj
)));
2001 strout (buf
, len
, len
, printcharfun
);
2002 print_string (BVAR (XMARKER (OVERLAY_START (obj
))->buffer
, name
),
2005 printchar ('>', printcharfun
);
2009 case Lisp_Misc_User_Ptr
:
2011 print_c_string ("#<user-ptr ", printcharfun
);
2012 int i
= sprintf (buf
, "ptr=%p finalizer=%p",
2014 XUSER_PTR (obj
)->finalizer
);
2015 strout (buf
, i
, i
, printcharfun
);
2016 printchar ('>', printcharfun
);
2021 case Lisp_Misc_Finalizer
:
2022 print_c_string ("#<finalizer", printcharfun
);
2023 if (NILP (XFINALIZER (obj
)->function
))
2024 print_c_string (" used", printcharfun
);
2025 printchar ('>', printcharfun
);
2028 /* Remaining cases shouldn't happen in normal usage, but let's
2029 print them anyway for the benefit of the debugger. */
2031 case Lisp_Misc_Free
:
2032 print_c_string ("#<misc free cell>", printcharfun
);
2035 case Lisp_Misc_Save_Value
:
2038 struct Lisp_Save_Value
*v
= XSAVE_VALUE (obj
);
2040 print_c_string ("#<save-value ", printcharfun
);
2042 if (v
->save_type
== SAVE_TYPE_MEMORY
)
2044 ptrdiff_t amount
= v
->data
[1].integer
;
2046 /* valid_lisp_object_p is reliable, so try to print up
2047 to 8 saved objects. This code is rarely used, so
2048 it's OK that valid_lisp_object_p is slow. */
2050 int limit
= min (amount
, 8);
2051 Lisp_Object
*area
= v
->data
[0].pointer
;
2053 i
= sprintf (buf
, "with %"pD
"d objects", amount
);
2054 strout (buf
, i
, i
, printcharfun
);
2056 for (i
= 0; i
< limit
; i
++)
2058 Lisp_Object maybe
= area
[i
];
2059 int valid
= valid_lisp_object_p (maybe
);
2061 printchar (' ', printcharfun
);
2063 print_object (maybe
, printcharfun
, escapeflag
);
2065 print_c_string (valid
< 0 ? "<some>" : "<invalid>",
2068 if (i
== limit
&& i
< amount
)
2069 print_c_string (" ...", printcharfun
);
2073 /* Print each slot according to its type. */
2075 for (index
= 0; index
< SAVE_VALUE_SLOTS
; index
++)
2078 printchar (' ', printcharfun
);
2080 switch (save_type (v
, index
))
2083 i
= sprintf (buf
, "<unused>");
2087 i
= sprintf (buf
, "<pointer %p>",
2088 v
->data
[index
].pointer
);
2091 case SAVE_FUNCPOINTER
:
2092 i
= sprintf (buf
, "<funcpointer %p>",
2093 ((void *) (intptr_t)
2094 v
->data
[index
].funcpointer
));
2098 i
= sprintf (buf
, "<integer %"pD
"d>",
2099 v
->data
[index
].integer
);
2103 print_object (v
->data
[index
].object
, printcharfun
,
2111 strout (buf
, i
, i
, printcharfun
);
2114 printchar ('>', printcharfun
);
2127 /* We're in trouble if this happens!
2128 Probably should just emacs_abort (). */
2129 print_c_string ("#<EMACS BUG: INVALID DATATYPE ", printcharfun
);
2131 len
= sprintf (buf
, "(MISC 0x%04x)", (unsigned) XMISCTYPE (obj
));
2132 else if (VECTORLIKEP (obj
))
2133 len
= sprintf (buf
, "(PVEC 0x%08zx)", (size_t) ASIZE (obj
));
2135 len
= sprintf (buf
, "(0x%02x)", (unsigned) XTYPE (obj
));
2136 strout (buf
, len
, len
, printcharfun
);
2137 print_c_string ((" Save your buffers immediately"
2138 " and please report this bug>"),
2147 /* Print a description of INTERVAL using PRINTCHARFUN.
2148 This is part of printing a string that has text properties. */
2151 print_interval (INTERVAL interval
, Lisp_Object printcharfun
)
2153 if (NILP (interval
->plist
))
2155 printchar (' ', printcharfun
);
2156 print_object (make_number (interval
->position
), printcharfun
, 1);
2157 printchar (' ', printcharfun
);
2158 print_object (make_number (interval
->position
+ LENGTH (interval
)),
2160 printchar (' ', printcharfun
);
2161 print_object (interval
->plist
, printcharfun
, 1);
2164 /* Initialize debug_print stuff early to have it working from the very
2168 init_print_once (void)
2170 /* The subroutine object for external-debugging-output is kept here
2171 for the convenience of the debugger. */
2172 DEFSYM (Qexternal_debugging_output
, "external-debugging-output");
2174 defsubr (&Sexternal_debugging_output
);
2178 syms_of_print (void)
2180 DEFSYM (Qtemp_buffer_setup_hook
, "temp-buffer-setup-hook");
2182 DEFVAR_LISP ("standard-output", Vstandard_output
,
2183 doc
: /* Output stream `print' uses by default for outputting a character.
2184 This may be any function of one argument.
2185 It may also be a buffer (output is inserted before point)
2186 or a marker (output is inserted and the marker is advanced)
2187 or the symbol t (output appears in the echo area). */);
2188 Vstandard_output
= Qt
;
2189 DEFSYM (Qstandard_output
, "standard-output");
2191 DEFVAR_LISP ("float-output-format", Vfloat_output_format
,
2192 doc
: /* The format descriptor string used to print floats.
2193 This is a %-spec like those accepted by `printf' in C,
2194 but with some restrictions. It must start with the two characters `%.'.
2195 After that comes an integer precision specification,
2196 and then a letter which controls the format.
2197 The letters allowed are `e', `f' and `g'.
2198 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2199 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2200 Use `g' to choose the shorter of those two formats for the number at hand.
2201 The precision in any of these cases is the number of digits following
2202 the decimal point. With `f', a precision of 0 means to omit the
2203 decimal point. 0 is not allowed with `e' or `g'.
2205 A value of nil means to use the shortest notation
2206 that represents the number without losing information. */);
2207 Vfloat_output_format
= Qnil
;
2209 DEFVAR_LISP ("print-length", Vprint_length
,
2210 doc
: /* Maximum length of list to print before abbreviating.
2211 A value of nil means no limit. See also `eval-expression-print-length'. */);
2212 Vprint_length
= Qnil
;
2214 DEFVAR_LISP ("print-level", Vprint_level
,
2215 doc
: /* Maximum depth of list nesting to print before abbreviating.
2216 A value of nil means no limit. See also `eval-expression-print-level'. */);
2217 Vprint_level
= Qnil
;
2219 DEFVAR_BOOL ("print-escape-newlines", print_escape_newlines
,
2220 doc
: /* Non-nil means print newlines in strings as `\\n'.
2221 Also print formfeeds as `\\f'. */);
2222 print_escape_newlines
= 0;
2224 DEFVAR_BOOL ("print-escape-nonascii", print_escape_nonascii
,
2225 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2226 \(OOO is the octal representation of the character code.)
2227 Only single-byte characters are affected, and only in `prin1'.
2228 When the output goes in a multibyte buffer, this feature is
2229 enabled regardless of the value of the variable. */);
2230 print_escape_nonascii
= 0;
2232 DEFVAR_BOOL ("print-escape-multibyte", print_escape_multibyte
,
2233 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2234 \(XXXX is the hex representation of the character code.)
2235 This affects only `prin1'. */);
2236 print_escape_multibyte
= 0;
2238 DEFVAR_BOOL ("print-quoted", print_quoted
,
2239 doc
: /* Non-nil means print quoted forms with reader syntax.
2240 I.e., (quote foo) prints as \\='foo, (function foo) as #\\='foo. */);
2243 DEFVAR_LISP ("print-gensym", Vprint_gensym
,
2244 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2245 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2246 When the uninterned symbol appears within a recursive data structure,
2247 and the symbol appears more than once, in addition use the #N# and #N=
2248 constructs as needed, so that multiple references to the same symbol are
2249 shared once again when the text is read back. */);
2250 Vprint_gensym
= Qnil
;
2252 DEFVAR_LISP ("print-circle", Vprint_circle
,
2253 doc
: /* Non-nil means print recursive structures using #N= and #N# syntax.
2254 If nil, printing proceeds recursively and may lead to
2255 `max-lisp-eval-depth' being exceeded or an error may occur:
2256 \"Apparently circular structure being printed.\" Also see
2257 `print-length' and `print-level'.
2258 If non-nil, shared substructures anywhere in the structure are printed
2259 with `#N=' before the first occurrence (in the order of the print
2260 representation) and `#N#' in place of each subsequent occurrence,
2261 where N is a positive decimal integer. */);
2262 Vprint_circle
= Qnil
;
2264 DEFVAR_LISP ("print-continuous-numbering", Vprint_continuous_numbering
,
2265 doc
: /* Non-nil means number continuously across print calls.
2266 This affects the numbers printed for #N= labels and #M# references.
2267 See also `print-circle', `print-gensym', and `print-number-table'.
2268 This variable should not be set with `setq'; bind it with a `let' instead. */);
2269 Vprint_continuous_numbering
= Qnil
;
2271 DEFVAR_LISP ("print-number-table", Vprint_number_table
,
2272 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2273 The Lisp printer uses this vector to detect Lisp objects referenced more
2276 When you bind `print-continuous-numbering' to t, you should probably
2277 also bind `print-number-table' to nil. This ensures that the value of
2278 `print-number-table' can be garbage-collected once the printing is
2279 done. If all elements of `print-number-table' are nil, it means that
2280 the printing done so far has not found any shared structure or objects
2281 that need to be recorded in the table. */);
2282 Vprint_number_table
= Qnil
;
2284 DEFVAR_LISP ("print-charset-text-property", Vprint_charset_text_property
,
2285 doc
: /* A flag to control printing of `charset' text property on printing a string.
2286 The value must be nil, t, or `default'.
2288 If the value is nil, don't print the text property `charset'.
2290 If the value is t, always print the text property `charset'.
2292 If the value is `default', print the text property `charset' only when
2293 the value is different from what is guessed in the current charset
2295 Vprint_charset_text_property
= Qdefault
;
2297 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2298 staticpro (&Vprin1_to_string_buffer
);
2301 defsubr (&Sprin1_to_string
);
2302 defsubr (&Serror_message_string
);
2306 defsubr (&Swrite_char
);
2307 defsubr (&Sredirect_debugging_output
);
2309 DEFSYM (Qprint_escape_newlines
, "print-escape-newlines");
2310 DEFSYM (Qprint_escape_multibyte
, "print-escape-multibyte");
2311 DEFSYM (Qprint_escape_nonascii
, "print-escape-nonascii");
2313 print_prune_charset_plist
= Qnil
;
2314 staticpro (&print_prune_charset_plist
);