1 /* Lisp object printing and output streams.
3 Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2018 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 <https://www.gnu.org/licenses/>. */
26 #include "character.h"
33 #include "intervals.h"
34 #include "blockinput.h"
43 # include <sys/socket.h> /* for F_DUPFD_CLOEXEC */
48 /* Avoid actual stack overflow in print. */
49 static ptrdiff_t print_depth
;
51 /* Level of nesting inside outputting backquote in new style. */
52 static ptrdiff_t new_backquote_output
;
54 /* Detect most circularities to print finite output. */
55 #define PRINT_CIRCLE 200
56 static Lisp_Object being_printed
[PRINT_CIRCLE
];
58 /* Last char printed to stdout by printchar. */
59 static unsigned int printchar_stdout_last
;
61 /* When printing into a buffer, first we put the text in this
62 block, then insert it all at once. */
63 static char *print_buffer
;
65 /* Size allocated in print_buffer. */
66 static ptrdiff_t print_buffer_size
;
67 /* Chars stored in print_buffer. */
68 static ptrdiff_t print_buffer_pos
;
69 /* Bytes stored in print_buffer. */
70 static ptrdiff_t print_buffer_pos_byte
;
72 /* Vprint_number_table is a table, that keeps objects that are going to
73 be printed, to allow use of #n= and #n# to express sharing.
74 For any given object, the table can give the following values:
75 t the object will be printed only once.
76 -N the object will be printed several times and will take number N.
77 N the object has been printed so we can refer to it as #N#.
78 print_number_index holds the largest N already used.
79 N has to be striclty larger than 0 since we need to distinguish -N. */
80 static ptrdiff_t print_number_index
;
81 static void print_interval (INTERVAL interval
, Lisp_Object printcharfun
);
83 /* GDB resets this to zero on W32 to disable OutputDebugString calls. */
84 bool print_output_debug_flag EXTERNALLY_VISIBLE
= 1;
87 /* Low level output routines for characters and strings. */
89 /* Lisp functions to do output using a stream
90 must have the stream in a variable called printcharfun
91 and must start with PRINTPREPARE, end with PRINTFINISH.
92 Use printchar to output one character,
93 or call strout to output a block of characters. */
95 #define PRINTPREPARE \
96 struct buffer *old = current_buffer; \
97 ptrdiff_t old_point = -1, start_point = -1; \
98 ptrdiff_t old_point_byte = -1, start_point_byte = -1; \
99 ptrdiff_t specpdl_count = SPECPDL_INDEX (); \
100 bool free_print_buffer = 0; \
102 = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \
103 Lisp_Object original = printcharfun; \
104 if (NILP (printcharfun)) printcharfun = Qt; \
105 if (BUFFERP (printcharfun)) \
107 if (XBUFFER (printcharfun) != current_buffer) \
108 Fset_buffer (printcharfun); \
109 printcharfun = Qnil; \
111 if (MARKERP (printcharfun)) \
113 ptrdiff_t marker_pos; \
114 if (! XMARKER (printcharfun)->buffer) \
115 error ("Marker does not point anywhere"); \
116 if (XMARKER (printcharfun)->buffer != current_buffer) \
117 set_buffer_internal (XMARKER (printcharfun)->buffer); \
118 marker_pos = marker_position (printcharfun); \
119 if (marker_pos < BEGV || marker_pos > ZV) \
120 signal_error ("Marker is outside the accessible " \
121 "part of the buffer", printcharfun); \
123 old_point_byte = PT_BYTE; \
124 SET_PT_BOTH (marker_pos, \
125 marker_byte_position (printcharfun)); \
127 start_point_byte = PT_BYTE; \
128 printcharfun = Qnil; \
130 if (NILP (printcharfun)) \
132 Lisp_Object string; \
133 if (NILP (BVAR (current_buffer, enable_multibyte_characters)) \
134 && ! print_escape_multibyte) \
135 specbind (Qprint_escape_multibyte, Qt); \
136 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)) \
137 && ! print_escape_nonascii) \
138 specbind (Qprint_escape_nonascii, Qt); \
139 if (print_buffer != 0) \
141 string = make_string_from_bytes (print_buffer, \
143 print_buffer_pos_byte); \
144 record_unwind_protect (print_unwind, string); \
148 int new_size = 1000; \
149 print_buffer = xmalloc (new_size); \
150 print_buffer_size = new_size; \
151 free_print_buffer = 1; \
153 print_buffer_pos = 0; \
154 print_buffer_pos_byte = 0; \
156 if (EQ (printcharfun, Qt) && ! noninteractive) \
157 setup_echo_area_for_printing (multibyte);
159 #define PRINTFINISH \
160 if (NILP (printcharfun)) \
162 if (print_buffer_pos != print_buffer_pos_byte \
163 && NILP (BVAR (current_buffer, enable_multibyte_characters)))\
166 unsigned char *temp = SAFE_ALLOCA (print_buffer_pos + 1); \
167 copy_text ((unsigned char *) print_buffer, temp, \
168 print_buffer_pos_byte, 1, 0); \
169 insert_1_both ((char *) temp, print_buffer_pos, \
170 print_buffer_pos, 0, 1, 0); \
174 insert_1_both (print_buffer, print_buffer_pos, \
175 print_buffer_pos_byte, 0, 1, 0); \
176 signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
178 if (free_print_buffer) \
180 xfree (print_buffer); \
183 unbind_to (specpdl_count, Qnil); \
184 if (MARKERP (original)) \
185 set_marker_both (original, Qnil, PT, PT_BYTE); \
186 if (old_point >= 0) \
187 SET_PT_BOTH (old_point + (old_point >= start_point \
188 ? PT - start_point : 0), \
189 old_point_byte + (old_point_byte >= start_point_byte \
190 ? PT_BYTE - start_point_byte : 0)); \
191 set_buffer_internal (old);
193 /* This is used to restore the saved contents of print_buffer
194 when there is a recursive call to print. */
197 print_unwind (Lisp_Object saved_text
)
199 memcpy (print_buffer
, SDATA (saved_text
), SCHARS (saved_text
));
202 /* Print character CH to the stdio stream STREAM. */
205 printchar_to_stream (unsigned int ch
, FILE *stream
)
207 Lisp_Object dv UNINIT
;
208 ptrdiff_t i
= 0, n
= 1;
209 Lisp_Object coding_system
= Vlocale_coding_system
;
210 bool encode_p
= false;
212 if (!NILP (Vcoding_system_for_write
))
213 coding_system
= Vcoding_system_for_write
;
214 if (!NILP (coding_system
))
217 if (CHAR_VALID_P (ch
) && DISP_TABLE_P (Vstandard_display_table
))
219 dv
= DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table
), ch
);
229 if (ASCII_CHAR_P (ch
))
231 putc_unlocked (ch
, stream
);
233 /* Send the output to a debugger (nothing happens if there
235 if (print_output_debug_flag
&& stream
== stderr
)
236 OutputDebugString ((char []) {ch
, '\0'});
241 unsigned char mbstr
[MAX_MULTIBYTE_LENGTH
];
242 int len
= CHAR_STRING (ch
, mbstr
);
243 Lisp_Object encoded_ch
=
244 make_multibyte_string ((char *) mbstr
, 1, len
);
247 encoded_ch
= code_convert_string_norecord (encoded_ch
,
248 coding_system
, true);
249 fwrite_unlocked (SSDATA (encoded_ch
), 1, SBYTES (encoded_ch
), stream
);
251 if (print_output_debug_flag
&& stream
== stderr
)
252 OutputDebugString (SSDATA (encoded_ch
));
260 if (CHARACTERP (AREF (dv
, i
)))
264 ch
= XFASTINT (AREF (dv
, i
));
268 /* Print character CH using method FUN. FUN nil means print to
269 print_buffer. FUN t means print to echo area or stdout if
270 non-interactive. If FUN is neither nil nor t, call FUN with CH as
274 printchar (unsigned int ch
, Lisp_Object fun
)
276 if (!NILP (fun
) && !EQ (fun
, Qt
))
277 call1 (fun
, make_number (ch
));
280 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
281 int len
= CHAR_STRING (ch
, str
);
287 ptrdiff_t incr
= len
- (print_buffer_size
- print_buffer_pos_byte
);
289 print_buffer
= xpalloc (print_buffer
, &print_buffer_size
,
291 memcpy (print_buffer
+ print_buffer_pos_byte
, str
, len
);
292 print_buffer_pos
+= 1;
293 print_buffer_pos_byte
+= len
;
295 else if (noninteractive
)
297 printchar_stdout_last
= ch
;
298 if (DISP_TABLE_P (Vstandard_display_table
))
299 printchar_to_stream (ch
, stdout
);
301 fwrite_unlocked (str
, 1, len
, stdout
);
302 noninteractive_need_newline
= 1;
307 = !NILP (BVAR (current_buffer
, enable_multibyte_characters
));
309 setup_echo_area_for_printing (multibyte_p
);
311 message_dolog ((char *) str
, len
, 0, multibyte_p
);
317 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
318 method PRINTCHARFUN. PRINTCHARFUN nil means output to
319 print_buffer. PRINTCHARFUN t means output to the echo area or to
320 stdout if non-interactive. If neither nil nor t, call Lisp
321 function PRINTCHARFUN for each character printed. MULTIBYTE
322 non-zero means PTR contains multibyte characters.
324 In the case where PRINTCHARFUN is nil, it is safe for PTR to point
325 to data in a Lisp string. Otherwise that is not safe. */
328 strout (const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
,
329 Lisp_Object printcharfun
)
331 if (NILP (printcharfun
))
333 ptrdiff_t incr
= size_byte
- (print_buffer_size
- print_buffer_pos_byte
);
335 print_buffer
= xpalloc (print_buffer
, &print_buffer_size
, incr
, -1, 1);
336 memcpy (print_buffer
+ print_buffer_pos_byte
, ptr
, size_byte
);
337 print_buffer_pos
+= size
;
338 print_buffer_pos_byte
+= size_byte
;
340 else if (noninteractive
&& EQ (printcharfun
, Qt
))
342 if (DISP_TABLE_P (Vstandard_display_table
))
345 for (ptrdiff_t i
= 0; i
< size_byte
; i
+= len
)
347 int ch
= STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr
+ i
,
349 printchar_to_stream (ch
, stdout
);
353 fwrite_unlocked (ptr
, 1, size_byte
, stdout
);
355 noninteractive_need_newline
= 1;
357 else if (EQ (printcharfun
, Qt
))
359 /* Output to echo area. We're trying to avoid a little overhead
360 here, that's the reason we don't call printchar to do the
364 = !NILP (BVAR (current_buffer
, enable_multibyte_characters
));
366 setup_echo_area_for_printing (multibyte_p
);
367 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
369 if (size
== size_byte
)
371 for (i
= 0; i
< size
; ++i
)
372 insert_char ((unsigned char) *ptr
++);
377 for (i
= 0; i
< size_byte
; i
+= len
)
379 int ch
= STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr
+ i
,
387 /* PRINTCHARFUN is a Lisp function. */
390 if (size
== size_byte
)
392 while (i
< size_byte
)
395 printchar (ch
, printcharfun
);
400 while (i
< size_byte
)
402 /* Here, we must convert each multi-byte form to the
403 corresponding character code before handing it to
406 int ch
= STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr
+ i
,
408 printchar (ch
, printcharfun
);
415 /* Print the contents of a string STRING using PRINTCHARFUN.
416 It isn't safe to use strout in many cases,
417 because printing one char can relocate. */
420 print_string (Lisp_Object string
, Lisp_Object printcharfun
)
422 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
426 if (print_escape_nonascii
)
427 string
= string_escape_byte8 (string
);
429 if (STRING_MULTIBYTE (string
))
430 chars
= SCHARS (string
);
431 else if (! print_escape_nonascii
432 && (EQ (printcharfun
, Qt
)
433 ? ! NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))
434 : ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))))
436 /* If unibyte string STRING contains 8-bit codes, we must
437 convert STRING to a multibyte string containing the same
442 chars
= SBYTES (string
);
443 bytes
= count_size_as_multibyte (SDATA (string
), chars
);
446 newstr
= make_uninit_multibyte_string (chars
, bytes
);
447 memcpy (SDATA (newstr
), SDATA (string
), chars
);
448 str_to_multibyte (SDATA (newstr
), bytes
, chars
);
453 chars
= SBYTES (string
);
455 if (EQ (printcharfun
, Qt
))
457 /* Output to echo area. */
458 ptrdiff_t nbytes
= SBYTES (string
);
460 /* Copy the string contents so that relocation of STRING by
461 GC does not cause trouble. */
463 char *buffer
= SAFE_ALLOCA (nbytes
);
464 memcpy (buffer
, SDATA (string
), nbytes
);
466 strout (buffer
, chars
, nbytes
, printcharfun
);
471 /* No need to copy, since output to print_buffer can't GC. */
472 strout (SSDATA (string
), chars
, SBYTES (string
), printcharfun
);
476 /* Otherwise, string may be relocated by printing one char.
477 So re-fetch the string address for each character. */
479 ptrdiff_t size
= SCHARS (string
);
480 ptrdiff_t size_byte
= SBYTES (string
);
481 if (size
== size_byte
)
482 for (i
= 0; i
< size
; i
++)
483 printchar (SREF (string
, i
), printcharfun
);
485 for (i
= 0; i
< size_byte
; )
487 /* Here, we must convert each multi-byte form to the
488 corresponding character code before handing it to PRINTCHAR. */
490 int ch
= STRING_CHAR_AND_LENGTH (SDATA (string
) + i
, len
);
491 printchar (ch
, printcharfun
);
497 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
498 doc
: /* Output character CHARACTER to stream PRINTCHARFUN.
499 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
500 (Lisp_Object character
, Lisp_Object printcharfun
)
502 if (NILP (printcharfun
))
503 printcharfun
= Vstandard_output
;
504 CHECK_NUMBER (character
);
506 printchar (XINT (character
), printcharfun
);
511 /* Print the contents of a unibyte C string STRING using PRINTCHARFUN.
512 The caller should arrange to put this inside PRINTPREPARE and PRINTFINISH.
513 Do not use this on the contents of a Lisp string. */
516 print_c_string (char const *string
, Lisp_Object printcharfun
)
518 ptrdiff_t len
= strlen (string
);
519 strout (string
, len
, len
, printcharfun
);
522 /* Print unibyte C string at DATA on a specified stream PRINTCHARFUN.
523 Do not use this on the contents of a Lisp string. */
526 write_string (const char *data
, Lisp_Object printcharfun
)
529 print_c_string (data
, printcharfun
);
535 temp_output_buffer_setup (const char *bufname
)
537 ptrdiff_t count
= SPECPDL_INDEX ();
538 register struct buffer
*old
= current_buffer
;
539 register Lisp_Object buf
;
541 record_unwind_current_buffer ();
543 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
545 Fkill_all_local_variables ();
546 delete_all_overlays (current_buffer
);
547 bset_directory (current_buffer
, BVAR (old
, directory
));
548 bset_read_only (current_buffer
, Qnil
);
549 bset_filename (current_buffer
, Qnil
);
550 bset_undo_list (current_buffer
, Qt
);
551 eassert (current_buffer
->overlays_before
== NULL
);
552 eassert (current_buffer
->overlays_after
== NULL
);
553 bset_enable_multibyte_characters
554 (current_buffer
, BVAR (&buffer_defaults
, enable_multibyte_characters
));
555 specbind (Qinhibit_read_only
, Qt
);
556 specbind (Qinhibit_modification_hooks
, Qt
);
558 XSETBUFFER (buf
, current_buffer
);
560 run_hook (Qtemp_buffer_setup_hook
);
562 unbind_to (count
, Qnil
);
564 specbind (Qstandard_output
, buf
);
567 static void print (Lisp_Object
, Lisp_Object
, bool);
568 static void print_preprocess (Lisp_Object
);
569 static void print_preprocess_string (INTERVAL
, void *);
570 static void print_object (Lisp_Object
, Lisp_Object
, bool);
572 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 2, 0,
573 doc
: /* Output a newline to stream PRINTCHARFUN.
574 If ENSURE is non-nil only output a newline if not already at the
575 beginning of a line. Value is non-nil if a newline is printed.
576 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
577 (Lisp_Object printcharfun
, Lisp_Object ensure
)
581 if (NILP (printcharfun
))
582 printcharfun
= Vstandard_output
;
587 /* Difficult to check if at line beginning so abort. */
588 else if (FUNCTIONP (printcharfun
))
589 signal_error ("Unsupported function argument", printcharfun
);
590 else if (noninteractive
&& !NILP (printcharfun
))
591 val
= printchar_stdout_last
== 10 ? Qnil
: Qt
;
593 val
= NILP (Fbolp ()) ? Qt
: Qnil
;
596 printchar ('\n', printcharfun
);
601 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
602 doc
: /* Output the printed representation of OBJECT, any Lisp object.
603 Quoting characters are printed when needed to make output that `read'
604 can handle, whenever this is possible. For complex objects, the behavior
605 is controlled by `print-level' and `print-length', which see.
607 OBJECT is any of the Lisp data types: a number, a string, a symbol,
608 a list, a buffer, a window, a frame, etc.
610 A printed representation of an object is text which describes that object.
612 Optional argument PRINTCHARFUN is the output stream, which can be one
615 - a buffer, in which case output is inserted into that buffer at point;
616 - a marker, in which case output is inserted at marker's position;
617 - a function, in which case that function is called once for each
618 character of OBJECT's printed representation;
619 - a symbol, in which case that symbol's function definition is called; or
620 - t, in which case the output is displayed in the echo area.
622 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
624 (Lisp_Object object
, Lisp_Object printcharfun
)
626 if (NILP (printcharfun
))
627 printcharfun
= Vstandard_output
;
629 print (object
, printcharfun
, 1);
634 /* A buffer which is used to hold output being built by prin1-to-string. */
635 Lisp_Object Vprin1_to_string_buffer
;
637 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
638 doc
: /* Return a string containing the printed representation of OBJECT.
639 OBJECT can be any Lisp object. This function outputs quoting characters
640 when necessary to make output that `read' can handle, whenever possible,
641 unless the optional second argument NOESCAPE is non-nil. For complex objects,
642 the behavior is controlled by `print-level' and `print-length', which see.
644 OBJECT is any of the Lisp data types: a number, a string, a symbol,
645 a list, a buffer, a window, a frame, etc.
647 A printed representation of an object is text which describes that object. */)
648 (Lisp_Object object
, Lisp_Object noescape
)
650 ptrdiff_t count
= SPECPDL_INDEX ();
652 specbind (Qinhibit_modification_hooks
, Qt
);
654 /* Save and restore this: we are altering a buffer
655 but we don't want to deactivate the mark just for that.
656 No need for specbind, since errors deactivate the mark. */
657 Lisp_Object save_deactivate_mark
= Vdeactivate_mark
;
659 Lisp_Object printcharfun
= Vprin1_to_string_buffer
;
661 print (object
, printcharfun
, NILP (noescape
));
662 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINISH */
665 struct buffer
*previous
= current_buffer
;
666 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
667 object
= Fbuffer_string ();
668 if (SBYTES (object
) == SCHARS (object
))
669 STRING_SET_UNIBYTE (object
);
671 /* Note that this won't make prepare_to_modify_buffer call
672 ask-user-about-supersession-threat because this buffer
673 does not visit a file. */
675 set_buffer_internal (previous
);
677 Vdeactivate_mark
= save_deactivate_mark
;
679 return unbind_to (count
, object
);
682 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
683 doc
: /* Output the printed representation of OBJECT, any Lisp object.
684 No quoting characters are used; no delimiters are printed around
685 the contents of strings.
687 OBJECT is any of the Lisp data types: a number, a string, a symbol,
688 a list, a buffer, a window, a frame, etc.
690 A printed representation of an object is text which describes that object.
692 Optional argument PRINTCHARFUN is the output stream, which can be one
695 - a buffer, in which case output is inserted into that buffer at point;
696 - a marker, in which case output is inserted at marker's position;
697 - a function, in which case that function is called once for each
698 character of OBJECT's printed representation;
699 - a symbol, in which case that symbol's function definition is called; or
700 - t, in which case the output is displayed in the echo area.
702 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
704 (Lisp_Object object
, Lisp_Object printcharfun
)
706 if (NILP (printcharfun
))
707 printcharfun
= Vstandard_output
;
709 print (object
, printcharfun
, 0);
714 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
715 doc
: /* Output the printed representation of OBJECT, with newlines around it.
716 Quoting characters are printed when needed to make output that `read'
717 can handle, whenever this is possible. For complex objects, the behavior
718 is controlled by `print-level' and `print-length', which see.
720 OBJECT is any of the Lisp data types: a number, a string, a symbol,
721 a list, a buffer, a window, a frame, etc.
723 A printed representation of an object is text which describes that object.
725 Optional argument PRINTCHARFUN is the output stream, which can be one
728 - a buffer, in which case output is inserted into that buffer at point;
729 - a marker, in which case output is inserted at marker's position;
730 - a function, in which case that function is called once for each
731 character of OBJECT's printed representation;
732 - a symbol, in which case that symbol's function definition is called; or
733 - t, in which case the output is displayed in the echo area.
735 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
737 (Lisp_Object object
, Lisp_Object printcharfun
)
739 if (NILP (printcharfun
))
740 printcharfun
= Vstandard_output
;
742 printchar ('\n', printcharfun
);
743 print (object
, printcharfun
, 1);
744 printchar ('\n', printcharfun
);
749 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
750 doc
: /* Write CHARACTER to stderr.
751 You can call print while debugging emacs, and pass it this function
752 to make it write to the debugging output. */)
753 (Lisp_Object character
)
755 CHECK_NUMBER (character
);
756 printchar_to_stream (XINT (character
), stderr
);
760 /* This function is never called. Its purpose is to prevent
761 print_output_debug_flag from being optimized away. */
763 extern void debug_output_compilation_hack (bool) EXTERNALLY_VISIBLE
;
765 debug_output_compilation_hack (bool x
)
767 print_output_debug_flag
= x
;
770 DEFUN ("redirect-debugging-output", Fredirect_debugging_output
, Sredirect_debugging_output
,
772 "FDebug output file: \nP",
773 doc
: /* Redirect debugging output (stderr stream) to file FILE.
774 If FILE is nil, reset target to the initial stderr stream.
775 Optional arg APPEND non-nil (interactively, with prefix arg) means
776 append to existing target file. */)
777 (Lisp_Object file
, Lisp_Object append
)
779 /* If equal to STDERR_FILENO, stderr has not been duplicated and is OK as-is.
780 Otherwise, this is a close-on-exec duplicate of the original stderr. */
781 static int stderr_dup
= STDERR_FILENO
;
786 file
= Fexpand_file_name (file
, Qnil
);
788 if (stderr_dup
== STDERR_FILENO
)
790 int n
= fcntl (STDERR_FILENO
, F_DUPFD_CLOEXEC
, STDERR_FILENO
+ 1);
792 report_file_error ("dup", file
);
796 fd
= emacs_open (SSDATA (ENCODE_FILE (file
)),
798 | (! NILP (append
) ? O_APPEND
: O_TRUNC
)),
801 report_file_error ("Cannot open debugging output stream", file
);
804 fflush_unlocked (stderr
);
805 if (dup2 (fd
, STDERR_FILENO
) < 0)
806 report_file_error ("dup2", file
);
807 if (fd
!= stderr_dup
)
813 /* This is the interface for debugging printing. */
816 debug_print (Lisp_Object arg
)
818 Fprin1 (arg
, Qexternal_debugging_output
);
819 fprintf (stderr
, "\r\n");
822 void safe_debug_print (Lisp_Object
) EXTERNALLY_VISIBLE
;
824 safe_debug_print (Lisp_Object arg
)
826 int valid
= valid_lisp_object_p (arg
);
832 EMACS_UINT n
= XLI (arg
);
833 fprintf (stderr
, "#<%s_LISP_OBJECT 0x%08"pI
"x>\r\n",
834 !valid
? "INVALID" : "SOME",
840 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
842 doc
: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
843 See Info anchor `(elisp)Definition of signal' for some details on how this
844 error message is constructed. */)
847 struct buffer
*old
= current_buffer
;
850 /* If OBJ is (error STRING), just return STRING.
851 That is not only faster, it also avoids the need to allocate
852 space here when the error is due to memory full. */
853 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
854 && CONSP (XCDR (obj
))
855 && STRINGP (XCAR (XCDR (obj
)))
856 && NILP (XCDR (XCDR (obj
))))
857 return XCAR (XCDR (obj
));
859 print_error_message (obj
, Vprin1_to_string_buffer
, 0, Qnil
);
861 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
862 value
= Fbuffer_string ();
865 set_buffer_internal (old
);
870 /* Print an error message for the error DATA onto Lisp output stream
871 STREAM (suitable for the print functions).
872 CONTEXT is a C string describing the context of the error.
873 CALLER is the Lisp function inside which the error was signaled. */
876 print_error_message (Lisp_Object data
, Lisp_Object stream
, const char *context
,
879 Lisp_Object errname
, errmsg
, file_error
, tail
;
882 write_string (context
, stream
);
884 /* If we know from where the error was signaled, show it in
886 if (!NILP (caller
) && SYMBOLP (caller
))
888 Lisp_Object cname
= SYMBOL_NAME (caller
);
889 ptrdiff_t cnamelen
= SBYTES (cname
);
891 char *name
= SAFE_ALLOCA (cnamelen
);
892 memcpy (name
, SDATA (cname
), cnamelen
);
893 message_dolog (name
, cnamelen
, 0, STRING_MULTIBYTE (cname
));
894 message_dolog (": ", 2, 0, 0);
898 errname
= Fcar (data
);
900 if (EQ (errname
, Qerror
))
905 errmsg
= Fcar (data
);
910 Lisp_Object error_conditions
= Fget (errname
, Qerror_conditions
);
911 errmsg
= Fsubstitute_command_keys (Fget (errname
, Qerror_message
));
912 file_error
= Fmemq (Qfile_error
, error_conditions
);
915 /* Print an error message including the data items. */
917 tail
= Fcdr_safe (data
);
919 /* For file-error, make error message by concatenating
920 all the data items. They are all strings. */
921 if (!NILP (file_error
) && CONSP (tail
))
922 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
925 const char *sep
= ": ";
927 if (!STRINGP (errmsg
))
928 write_string ("peculiar error", stream
);
929 else if (SCHARS (errmsg
))
930 Fprinc (errmsg
, stream
);
934 for (; CONSP (tail
); tail
= XCDR (tail
), sep
= ", ")
939 write_string (sep
, stream
);
941 if (!NILP (file_error
)
942 || EQ (errname
, Qend_of_file
) || EQ (errname
, Quser_error
))
943 Fprinc (obj
, stream
);
945 Fprin1 (obj
, stream
);
953 * The buffer should be at least as large as the max string size of the
954 * largest float, printed in the biggest notation. This is undoubtedly
955 * 20d float_output_format, with the negative of the C-constant "HUGE"
958 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
960 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
961 * case of -1e307 in 20d float_output_format. What is one to do (short of
962 * re-writing _doprnt to be more sane)?
964 * Given the above, the buffer must be least FLOAT_TO_STRING_BUFSIZE bytes.
968 float_to_string (char *buf
, double data
)
974 /* Check for plus infinity in a way that won't lose
975 if there is no plus infinity. */
976 if (data
== data
/ 2 && data
> 1.0)
978 static char const infinity_string
[] = "1.0e+INF";
979 strcpy (buf
, infinity_string
);
980 return sizeof infinity_string
- 1;
982 /* Likewise for minus infinity. */
983 if (data
== data
/ 2 && data
< -1.0)
985 static char const minus_infinity_string
[] = "-1.0e+INF";
986 strcpy (buf
, minus_infinity_string
);
987 return sizeof minus_infinity_string
- 1;
989 /* Check for NaN in a way that won't fail if there are no NaNs. */
990 if (! (data
* 0.0 >= 0.0))
992 /* Prepend "-" if the NaN's sign bit is negative.
993 The sign bit of a double is the bit that is 1 in -0.0. */
994 static char const NaN_string
[] = "0.0e+NaN";
996 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
999 u_minus_zero
.d
= - 0.0;
1000 for (i
= 0; i
< sizeof (double); i
++)
1001 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1008 strcpy (buf
+ negative
, NaN_string
);
1009 return negative
+ sizeof NaN_string
- 1;
1012 if (NILP (Vfloat_output_format
)
1013 || !STRINGP (Vfloat_output_format
))
1016 /* Generate the fewest number of digits that represent the
1017 floating point value without losing information. */
1018 len
= dtoastr (buf
, FLOAT_TO_STRING_BUFSIZE
- 2, 0, 0, data
);
1019 /* The decimal point must be printed, or the byte compiler can
1020 get confused (Bug#8033). */
1023 else /* oink oink */
1025 /* Check that the spec we have is fully valid.
1026 This means not only valid for printf,
1027 but meant for floats, and reasonable. */
1028 cp
= SSDATA (Vfloat_output_format
);
1037 /* Check the width specification. */
1039 if ('0' <= *cp
&& *cp
<= '9')
1044 width
= (width
* 10) + (*cp
++ - '0');
1045 if (DBL_DIG
< width
)
1048 while (*cp
>= '0' && *cp
<= '9');
1050 /* A precision of zero is valid only for %f. */
1051 if (width
== 0 && *cp
!= 'f')
1055 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1061 len
= sprintf (buf
, SSDATA (Vfloat_output_format
), data
);
1064 /* Make sure there is a decimal point with digit after, or an
1065 exponent, so that the value is readable as a float. But don't do
1066 this with "%.0f"; it's valid for that not to produce a decimal
1067 point. Note that width can be 0 only for %.0f. */
1070 for (cp
= buf
; *cp
; cp
++)
1071 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1074 if (*cp
== '.' && cp
[1] == 0)
1094 print (Lisp_Object obj
, Lisp_Object printcharfun
, bool escapeflag
)
1096 new_backquote_output
= 0;
1098 /* Reset print_number_index and Vprint_number_table only when
1099 the variable Vprint_continuous_numbering is nil. Otherwise,
1100 the values of these variables will be kept between several
1102 if (NILP (Vprint_continuous_numbering
)
1103 || NILP (Vprint_number_table
))
1105 print_number_index
= 0;
1106 Vprint_number_table
= Qnil
;
1109 /* Construct Vprint_number_table for print-gensym and print-circle. */
1110 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1112 /* Construct Vprint_number_table.
1113 This increments print_number_index for the objects added. */
1115 print_preprocess (obj
);
1117 if (HASH_TABLE_P (Vprint_number_table
))
1118 { /* Remove unnecessary objects, which appear only once in OBJ;
1119 that is, whose status is Qt. */
1120 struct Lisp_Hash_Table
*h
= XHASH_TABLE (Vprint_number_table
);
1123 for (i
= 0; i
< HASH_TABLE_SIZE (h
); ++i
)
1124 if (!NILP (HASH_HASH (h
, i
))
1125 && EQ (HASH_VALUE (h
, i
), Qt
))
1126 Fremhash (HASH_KEY (h
, i
), Vprint_number_table
);
1131 print_object (obj
, printcharfun
, escapeflag
);
1134 #define PRINT_CIRCLE_CANDIDATE_P(obj) \
1135 (STRINGP (obj) || CONSP (obj) \
1136 || (VECTORLIKEP (obj) \
1137 && (VECTORP (obj) || COMPILEDP (obj) \
1138 || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \
1139 || HASH_TABLE_P (obj) || FONTP (obj) \
1140 || RECORDP (obj))) \
1141 || (! NILP (Vprint_gensym) \
1143 && !SYMBOL_INTERNED_P (obj)))
1145 /* Construct Vprint_number_table according to the structure of OBJ.
1146 OBJ itself and all its elements will be added to Vprint_number_table
1147 recursively if it is a list, vector, compiled function, char-table,
1148 string (its text properties will be traced), or a symbol that has
1149 no obarray (this is for the print-gensym feature).
1150 The status fields of Vprint_number_table mean whether each object appears
1151 more than once in OBJ: Qnil at the first time, and Qt after that. */
1153 print_preprocess (Lisp_Object obj
)
1158 Lisp_Object halftail
;
1160 /* Avoid infinite recursion for circular nested structure
1161 in the case where Vprint_circle is nil. */
1162 if (NILP (Vprint_circle
))
1164 /* Give up if we go so deep that print_object will get an error. */
1165 /* See similar code in print_object. */
1166 if (print_depth
>= PRINT_CIRCLE
)
1167 error ("Apparently circular structure being printed");
1169 for (i
= 0; i
< print_depth
; i
++)
1170 if (EQ (obj
, being_printed
[i
]))
1172 being_printed
[print_depth
] = obj
;
1179 if (PRINT_CIRCLE_CANDIDATE_P (obj
))
1181 if (!HASH_TABLE_P (Vprint_number_table
))
1182 Vprint_number_table
= CALLN (Fmake_hash_table
, QCtest
, Qeq
);
1184 /* In case print-circle is nil and print-gensym is t,
1185 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1186 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1188 Lisp_Object num
= Fgethash (obj
, Vprint_number_table
, Qnil
);
1190 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1191 always print the gensym with a number. This is a special for
1192 the lisp function byte-compile-output-docform. */
1193 || (!NILP (Vprint_continuous_numbering
)
1195 && !SYMBOL_INTERNED_P (obj
)))
1196 { /* OBJ appears more than once. Let's remember that. */
1197 if (!INTEGERP (num
))
1199 print_number_index
++;
1200 /* Negative number indicates it hasn't been printed yet. */
1201 Fputhash (obj
, make_number (- print_number_index
),
1202 Vprint_number_table
);
1208 /* OBJ is not yet recorded. Let's add to the table. */
1209 Fputhash (obj
, Qt
, Vprint_number_table
);
1212 switch (XTYPE (obj
))
1215 /* A string may have text properties, which can be circular. */
1216 traverse_intervals_noorder (string_intervals (obj
),
1217 print_preprocess_string
, NULL
);
1221 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1222 just as in print_object. */
1223 if (loop_count
&& EQ (obj
, halftail
))
1225 print_preprocess (XCAR (obj
));
1228 if (!(loop_count
& 1))
1229 halftail
= XCDR (halftail
);
1232 case Lisp_Vectorlike
:
1234 if (size
& PSEUDOVECTOR_FLAG
)
1235 size
&= PSEUDOVECTOR_SIZE_MASK
;
1236 for (i
= (SUB_CHAR_TABLE_P (obj
)
1237 ? SUB_CHAR_TABLE_OFFSET
: 0); i
< size
; i
++)
1238 print_preprocess (AREF (obj
, i
));
1239 if (HASH_TABLE_P (obj
))
1240 { /* For hash tables, the key_and_value slot is past
1241 `size' because it needs to be marked specially in case
1242 the table is weak. */
1243 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1244 print_preprocess (h
->key_and_value
);
1255 DEFUN ("print--preprocess", Fprint_preprocess
, Sprint_preprocess
, 1, 1, 0,
1256 doc
: /* Extract sharing info from OBJECT needed to print it.
1257 Fills `print-number-table'. */)
1258 (Lisp_Object object
)
1260 print_number_index
= 0;
1261 print_preprocess (object
);
1266 print_preprocess_string (INTERVAL interval
, void *arg
)
1268 print_preprocess (interval
->plist
);
1271 static void print_check_string_charset_prop (INTERVAL interval
, Lisp_Object string
);
1273 #define PRINT_STRING_NON_CHARSET_FOUND 1
1274 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
1276 /* Bitwise or of the above macros. */
1277 static int print_check_string_result
;
1280 print_check_string_charset_prop (INTERVAL interval
, Lisp_Object string
)
1284 if (NILP (interval
->plist
)
1285 || (print_check_string_result
== (PRINT_STRING_NON_CHARSET_FOUND
1286 | PRINT_STRING_UNSAFE_CHARSET_FOUND
)))
1288 for (val
= interval
->plist
; CONSP (val
) && ! EQ (XCAR (val
), Qcharset
);
1289 val
= XCDR (XCDR (val
)));
1292 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1295 if (! (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
))
1297 if (! EQ (val
, interval
->plist
)
1298 || CONSP (XCDR (XCDR (val
))))
1299 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1301 if (NILP (Vprint_charset_text_property
)
1302 || ! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1305 ptrdiff_t charpos
= interval
->position
;
1306 ptrdiff_t bytepos
= string_char_to_byte (string
, charpos
);
1307 Lisp_Object charset
;
1309 charset
= XCAR (XCDR (val
));
1310 for (i
= 0; i
< LENGTH (interval
); i
++)
1312 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1313 if (! ASCII_CHAR_P (c
)
1314 && ! EQ (CHARSET_NAME (CHAR_CHARSET (c
)), charset
))
1316 print_check_string_result
|= PRINT_STRING_UNSAFE_CHARSET_FOUND
;
1323 /* The value is (charset . nil). */
1324 static Lisp_Object print_prune_charset_plist
;
1327 print_prune_string_charset (Lisp_Object string
)
1329 print_check_string_result
= 0;
1330 traverse_intervals (string_intervals (string
), 0,
1331 print_check_string_charset_prop
, string
);
1332 if (! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1334 string
= Fcopy_sequence (string
);
1335 if (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
)
1337 if (NILP (print_prune_charset_plist
))
1338 print_prune_charset_plist
= list1 (Qcharset
);
1339 Fremove_text_properties (make_number (0),
1340 make_number (SCHARS (string
)),
1341 print_prune_charset_plist
, string
);
1344 Fset_text_properties (make_number (0), make_number (SCHARS (string
)),
1351 print_vectorlike (Lisp_Object obj
, Lisp_Object printcharfun
, bool escapeflag
,
1354 switch (PSEUDOVECTOR_TYPE (XVECTOR (obj
)))
1359 print_c_string ("#<process ", printcharfun
);
1360 print_string (XPROCESS (obj
)->name
, printcharfun
);
1361 printchar ('>', printcharfun
);
1364 print_string (XPROCESS (obj
)->name
, printcharfun
);
1367 case PVEC_BOOL_VECTOR
:
1369 EMACS_INT size
= bool_vector_size (obj
);
1370 ptrdiff_t size_in_chars
= bool_vector_bytes (size
);
1371 ptrdiff_t real_size_in_chars
= size_in_chars
;
1373 int len
= sprintf (buf
, "#&%"pI
"d\"", size
);
1374 strout (buf
, len
, len
, printcharfun
);
1376 /* Don't print more characters than the specified maximum.
1377 Negative values of print-length are invalid. Treat them
1378 like a print-length of nil. */
1379 if (NATNUMP (Vprint_length
)
1380 && XFASTINT (Vprint_length
) < size_in_chars
)
1381 size_in_chars
= XFASTINT (Vprint_length
);
1383 for (ptrdiff_t i
= 0; i
< size_in_chars
; i
++)
1386 unsigned char c
= bool_vector_uchar_data (obj
)[i
];
1387 if (c
== '\n' && print_escape_newlines
)
1388 print_c_string ("\\n", printcharfun
);
1389 else if (c
== '\f' && print_escape_newlines
)
1390 print_c_string ("\\f", printcharfun
);
1391 else if (c
> '\177')
1393 /* Use octal escapes to avoid encoding issues. */
1394 int len
= sprintf (buf
, "\\%o", c
);
1395 strout (buf
, len
, len
, printcharfun
);
1399 if (c
== '\"' || c
== '\\')
1400 printchar ('\\', printcharfun
);
1401 printchar (c
, printcharfun
);
1405 if (size_in_chars
< real_size_in_chars
)
1406 print_c_string (" ...", printcharfun
);
1407 printchar ('\"', printcharfun
);
1412 print_c_string ("#<subr ", printcharfun
);
1413 print_c_string (XSUBR (obj
)->symbol_name
, printcharfun
);
1414 printchar ('>', printcharfun
);
1417 case PVEC_XWIDGET
: case PVEC_XWIDGET_VIEW
:
1418 print_c_string ("#<xwidget ", printcharfun
);
1419 printchar ('>', printcharfun
);
1424 int len
= sprintf (buf
, "#<window %"pI
"d",
1425 XWINDOW (obj
)->sequence_number
);
1426 strout (buf
, len
, len
, printcharfun
);
1427 if (BUFFERP (XWINDOW (obj
)->contents
))
1429 print_c_string (" on ", printcharfun
);
1430 print_string (BVAR (XBUFFER (XWINDOW (obj
)->contents
), name
),
1433 printchar ('>', printcharfun
);
1439 struct terminal
*t
= XTERMINAL (obj
);
1440 int len
= sprintf (buf
, "#<terminal %d", t
->id
);
1441 strout (buf
, len
, len
, printcharfun
);
1444 print_c_string (" on ", printcharfun
);
1445 print_c_string (t
->name
, printcharfun
);
1447 printchar ('>', printcharfun
);
1451 case PVEC_HASH_TABLE
:
1453 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1454 /* Implement a readable output, e.g.:
1455 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
1456 /* Always print the size. */
1457 int len
= sprintf (buf
, "#s(hash-table size %"pD
"d", ASIZE (h
->next
));
1458 strout (buf
, len
, len
, printcharfun
);
1460 if (!NILP (h
->test
.name
))
1462 print_c_string (" test ", printcharfun
);
1463 print_object (h
->test
.name
, printcharfun
, escapeflag
);
1466 if (!NILP (h
->weak
))
1468 print_c_string (" weakness ", printcharfun
);
1469 print_object (h
->weak
, printcharfun
, escapeflag
);
1472 print_c_string (" rehash-size ", printcharfun
);
1473 print_object (Fhash_table_rehash_size (obj
),
1474 printcharfun
, escapeflag
);
1476 print_c_string (" rehash-threshold ", printcharfun
);
1477 print_object (Fhash_table_rehash_threshold (obj
),
1478 printcharfun
, escapeflag
);
1482 print_c_string (" purecopy ", printcharfun
);
1483 print_object (h
->pure
? Qt
: Qnil
, printcharfun
, escapeflag
);
1486 print_c_string (" data ", printcharfun
);
1488 /* Print the data here as a plist. */
1489 ptrdiff_t real_size
= HASH_TABLE_SIZE (h
);
1490 ptrdiff_t size
= real_size
;
1492 /* Don't print more elements than the specified maximum. */
1493 if (NATNUMP (Vprint_length
) && XFASTINT (Vprint_length
) < size
)
1494 size
= XFASTINT (Vprint_length
);
1496 printchar ('(', printcharfun
);
1497 for (ptrdiff_t i
= 0; i
< size
; i
++)
1498 if (!NILP (HASH_HASH (h
, i
)))
1500 if (i
) printchar (' ', printcharfun
);
1501 print_object (HASH_KEY (h
, i
), printcharfun
, escapeflag
);
1502 printchar (' ', printcharfun
);
1503 print_object (HASH_VALUE (h
, i
), printcharfun
, escapeflag
);
1506 if (size
< real_size
)
1507 print_c_string (" ...", printcharfun
);
1509 print_c_string ("))", printcharfun
);
1514 if (!BUFFER_LIVE_P (XBUFFER (obj
)))
1515 print_c_string ("#<killed buffer>", printcharfun
);
1516 else if (escapeflag
)
1518 print_c_string ("#<buffer ", printcharfun
);
1519 print_string (BVAR (XBUFFER (obj
), name
), printcharfun
);
1520 printchar ('>', printcharfun
);
1523 print_string (BVAR (XBUFFER (obj
), name
), printcharfun
);
1526 case PVEC_WINDOW_CONFIGURATION
:
1527 print_c_string ("#<window-configuration>", printcharfun
);
1532 void *ptr
= XFRAME (obj
);
1533 Lisp_Object frame_name
= XFRAME (obj
)->name
;
1535 print_c_string ((FRAME_LIVE_P (XFRAME (obj
))
1539 if (!STRINGP (frame_name
))
1541 /* A frame could be too young and have no name yet;
1543 if (SYMBOLP (frame_name
))
1544 frame_name
= Fsymbol_name (frame_name
);
1545 else /* can't happen: name should be either nil or string */
1546 frame_name
= build_string ("*INVALID*FRAME*NAME*");
1548 print_string (frame_name
, printcharfun
);
1549 int len
= sprintf (buf
, " %p>", ptr
);
1550 strout (buf
, len
, len
, printcharfun
);
1556 if (! FONT_OBJECT_P (obj
))
1558 if (FONT_SPEC_P (obj
))
1559 print_c_string ("#<font-spec", printcharfun
);
1561 print_c_string ("#<font-entity", printcharfun
);
1562 for (int i
= 0; i
< FONT_SPEC_MAX
; i
++)
1564 printchar (' ', printcharfun
);
1565 if (i
< FONT_WEIGHT_INDEX
|| i
> FONT_WIDTH_INDEX
)
1566 print_object (AREF (obj
, i
), printcharfun
, escapeflag
);
1568 print_object (font_style_symbolic (obj
, i
, 0),
1569 printcharfun
, escapeflag
);
1574 print_c_string ("#<font-object ", printcharfun
);
1575 print_object (AREF (obj
, FONT_NAME_INDEX
), printcharfun
,
1578 printchar ('>', printcharfun
);
1583 print_c_string ("#<thread ", printcharfun
);
1584 if (STRINGP (XTHREAD (obj
)->name
))
1585 print_string (XTHREAD (obj
)->name
, printcharfun
);
1588 int len
= sprintf (buf
, "%p", XTHREAD (obj
));
1589 strout (buf
, len
, len
, printcharfun
);
1591 printchar ('>', printcharfun
);
1595 print_c_string ("#<mutex ", printcharfun
);
1596 if (STRINGP (XMUTEX (obj
)->name
))
1597 print_string (XMUTEX (obj
)->name
, printcharfun
);
1600 int len
= sprintf (buf
, "%p", XMUTEX (obj
));
1601 strout (buf
, len
, len
, printcharfun
);
1603 printchar ('>', printcharfun
);
1607 print_c_string ("#<condvar ", printcharfun
);
1608 if (STRINGP (XCONDVAR (obj
)->name
))
1609 print_string (XCONDVAR (obj
)->name
, printcharfun
);
1612 int len
= sprintf (buf
, "%p", XCONDVAR (obj
));
1613 strout (buf
, len
, len
, printcharfun
);
1615 printchar ('>', printcharfun
);
1620 ptrdiff_t size
= PVSIZE (obj
);
1622 /* Don't print more elements than the specified maximum. */
1624 = (NATNUMP (Vprint_length
) && XFASTINT (Vprint_length
) < size
1625 ? XFASTINT (Vprint_length
) : size
);
1627 print_c_string ("#s(", printcharfun
);
1628 for (ptrdiff_t i
= 0; i
< n
; i
++)
1630 if (i
) printchar (' ', printcharfun
);
1631 print_object (AREF (obj
, i
), printcharfun
, escapeflag
);
1634 print_c_string (" ...", printcharfun
);
1635 printchar (')', printcharfun
);
1639 case PVEC_SUB_CHAR_TABLE
:
1641 case PVEC_CHAR_TABLE
:
1642 case PVEC_NORMAL_VECTOR
:
1644 ptrdiff_t size
= ASIZE (obj
);
1645 if (COMPILEDP (obj
))
1647 printchar ('#', printcharfun
);
1648 size
&= PSEUDOVECTOR_SIZE_MASK
;
1650 if (CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
))
1652 /* Print a char-table as if it were a vector,
1653 lumping the parent and default slots in with the
1654 character slots. But add #^ as a prefix. */
1656 /* Make each lowest sub_char_table start a new line.
1657 Otherwise we'll make a line extremely long, which
1658 results in slow redisplay. */
1659 if (SUB_CHAR_TABLE_P (obj
)
1660 && XSUB_CHAR_TABLE (obj
)->depth
== 3)
1661 printchar ('\n', printcharfun
);
1662 print_c_string ("#^", printcharfun
);
1663 if (SUB_CHAR_TABLE_P (obj
))
1664 printchar ('^', printcharfun
);
1665 size
&= PSEUDOVECTOR_SIZE_MASK
;
1667 if (size
& PSEUDOVECTOR_FLAG
)
1670 printchar ('[', printcharfun
);
1672 int idx
= SUB_CHAR_TABLE_P (obj
) ? SUB_CHAR_TABLE_OFFSET
: 0;
1674 ptrdiff_t real_size
= size
;
1676 /* For a sub char-table, print heading non-Lisp data first. */
1677 if (SUB_CHAR_TABLE_P (obj
))
1679 int i
= sprintf (buf
, "%d %d", XSUB_CHAR_TABLE (obj
)->depth
,
1680 XSUB_CHAR_TABLE (obj
)->min_char
);
1681 strout (buf
, i
, i
, printcharfun
);
1684 /* Don't print more elements than the specified maximum. */
1685 if (NATNUMP (Vprint_length
)
1686 && XFASTINT (Vprint_length
) < size
)
1687 size
= XFASTINT (Vprint_length
);
1689 for (int i
= idx
; i
< size
; i
++)
1691 if (i
) printchar (' ', printcharfun
);
1692 tem
= AREF (obj
, i
);
1693 print_object (tem
, printcharfun
, escapeflag
);
1695 if (size
< real_size
)
1696 print_c_string (" ...", printcharfun
);
1697 printchar (']', printcharfun
);
1702 case PVEC_MODULE_FUNCTION
:
1704 print_c_string ("#<module function ", printcharfun
);
1705 void *ptr
= XMODULE_FUNCTION (obj
)->subr
;
1706 const char *file
= NULL
;
1707 const char *symbol
= NULL
;
1708 dynlib_addr (ptr
, &file
, &symbol
);
1712 print_c_string ("at ", printcharfun
);
1713 enum { pointer_bufsize
= sizeof ptr
* 16 / CHAR_BIT
+ 2 + 1 };
1714 char buffer
[pointer_bufsize
];
1715 int needed
= snprintf (buffer
, sizeof buffer
, "%p", ptr
);
1716 const char p0x
[] = "0x";
1717 eassert (needed
<= sizeof buffer
);
1718 /* ANSI C doesn't guarantee that %p produces a string that
1719 begins with a "0x". */
1720 if (c_strncasecmp (buffer
, p0x
, sizeof (p0x
) - 1) != 0)
1721 print_c_string (p0x
, printcharfun
);
1722 print_c_string (buffer
, printcharfun
);
1725 print_c_string (symbol
, printcharfun
);
1729 print_c_string (" from ", printcharfun
);
1730 print_c_string (file
, printcharfun
);
1733 printchar ('>', printcharfun
);
1746 print_object (Lisp_Object obj
, Lisp_Object printcharfun
, bool escapeflag
)
1748 char buf
[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT
),
1749 max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t
),
1751 current_thread
->stack_top
= buf
;
1754 /* Detect circularities and truncate them. */
1755 if (NILP (Vprint_circle
))
1757 /* Simple but incomplete way. */
1760 /* See similar code in print_preprocess. */
1761 if (print_depth
>= PRINT_CIRCLE
)
1762 error ("Apparently circular structure being printed");
1764 for (i
= 0; i
< print_depth
; i
++)
1765 if (EQ (obj
, being_printed
[i
]))
1767 int len
= sprintf (buf
, "#%d", i
);
1768 strout (buf
, len
, len
, printcharfun
);
1771 being_printed
[print_depth
] = obj
;
1773 else if (PRINT_CIRCLE_CANDIDATE_P (obj
))
1775 /* With the print-circle feature. */
1776 Lisp_Object num
= Fgethash (obj
, Vprint_number_table
, Qnil
);
1779 EMACS_INT n
= XINT (num
);
1781 { /* Add a prefix #n= if OBJ has not yet been printed;
1782 that is, its status field is nil. */
1783 int len
= sprintf (buf
, "#%"pI
"d=", -n
);
1784 strout (buf
, len
, len
, printcharfun
);
1785 /* OBJ is going to be printed. Remember that fact. */
1786 Fputhash (obj
, make_number (- n
), Vprint_number_table
);
1790 /* Just print #n# if OBJ has already been printed. */
1791 int len
= sprintf (buf
, "#%"pI
"d#", n
);
1792 strout (buf
, len
, len
, printcharfun
);
1800 switch (XTYPE (obj
))
1804 int len
= sprintf (buf
, "%"pI
"d", XINT (obj
));
1805 strout (buf
, len
, len
, printcharfun
);
1811 char pigbuf
[FLOAT_TO_STRING_BUFSIZE
];
1812 int len
= float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1813 strout (pigbuf
, len
, len
, printcharfun
);
1819 print_string (obj
, printcharfun
);
1822 ptrdiff_t i
, i_byte
;
1823 ptrdiff_t size_byte
;
1824 /* True means we must ensure that the next character we output
1825 cannot be taken as part of a hex character escape. */
1826 bool need_nonhex
= false;
1827 bool multibyte
= STRING_MULTIBYTE (obj
);
1829 if (! EQ (Vprint_charset_text_property
, Qt
))
1830 obj
= print_prune_string_charset (obj
);
1832 if (string_intervals (obj
))
1833 print_c_string ("#(", printcharfun
);
1835 printchar ('\"', printcharfun
);
1836 size_byte
= SBYTES (obj
);
1838 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1840 /* Here, we must convert each multi-byte form to the
1841 corresponding character code before handing it to printchar. */
1844 FETCH_STRING_CHAR_ADVANCE (c
, obj
, i
, i_byte
);
1849 ? (CHAR_BYTE8_P (c
) && (c
= CHAR_TO_BYTE8 (c
), true))
1850 : (SINGLE_BYTE_CHAR_P (c
) && ! ASCII_CHAR_P (c
)
1851 && print_escape_nonascii
))
1853 /* When printing a raw 8-bit byte in a multibyte buffer, or
1854 (when requested) a non-ASCII character in a unibyte buffer,
1855 print single-byte non-ASCII string chars
1856 using octal escapes. */
1858 int len
= sprintf (outbuf
, "\\%03o", c
+ 0u);
1859 strout (outbuf
, len
, len
, printcharfun
);
1860 need_nonhex
= false;
1863 && ! ASCII_CHAR_P (c
) && print_escape_multibyte
)
1865 /* When requested, print multibyte chars using hex escapes. */
1866 char outbuf
[sizeof "\\x" + INT_STRLEN_BOUND (c
)];
1867 int len
= sprintf (outbuf
, "\\x%04x", c
+ 0u);
1868 strout (outbuf
, len
, len
, printcharfun
);
1873 bool still_need_nonhex
= false;
1874 /* If we just had a hex escape, and this character
1875 could be taken as part of it,
1876 output `\ ' to prevent that. */
1880 print_c_string ("\\ ", printcharfun
);
1881 printchar (c
, printcharfun
);
1883 else if (c
== '\n' && print_escape_newlines
1885 : c
== '\f' && print_escape_newlines
1887 : c
== '\0' && print_escape_control_characters
1888 ? (c
= '0', still_need_nonhex
= true)
1889 : c
== '\"' || c
== '\\')
1891 printchar ('\\', printcharfun
);
1892 printchar (c
, printcharfun
);
1894 else if (print_escape_control_characters
&& c_iscntrl (c
))
1896 char outbuf
[1 + 3 + 1];
1897 int len
= sprintf (outbuf
, "\\%03o", c
+ 0u);
1898 strout (outbuf
, len
, len
, printcharfun
);
1901 printchar (c
, printcharfun
);
1902 need_nonhex
= still_need_nonhex
;
1905 printchar ('\"', printcharfun
);
1907 if (string_intervals (obj
))
1909 traverse_intervals (string_intervals (obj
),
1910 0, print_interval
, printcharfun
);
1911 printchar (')', printcharfun
);
1919 unsigned char *p
= SDATA (SYMBOL_NAME (obj
));
1920 unsigned char *end
= p
+ SBYTES (SYMBOL_NAME (obj
));
1922 ptrdiff_t i
, i_byte
;
1923 ptrdiff_t size_byte
;
1926 name
= SYMBOL_NAME (obj
);
1928 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1931 /* If symbol name begins with a digit, and ends with a digit,
1932 and contains nothing but digits and `e', it could be treated
1933 as a number. So set CONFUSING.
1935 Symbols that contain periods could also be taken as numbers,
1936 but periods are always escaped, so we don't have to worry
1938 else if (*p
>= '0' && *p
<= '9'
1939 && end
[-1] >= '0' && end
[-1] <= '9')
1941 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1942 /* Needed for \2e10. */
1943 || *p
== 'e' || *p
== 'E'))
1945 confusing
= (end
== p
);
1950 size_byte
= SBYTES (name
);
1952 if (! NILP (Vprint_gensym
)
1953 && !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj
))
1954 print_c_string ("#:", printcharfun
);
1955 else if (size_byte
== 0)
1957 print_c_string ("##", printcharfun
);
1961 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1963 /* Here, we must convert each multi-byte form to the
1964 corresponding character code before handing it to PRINTCHAR. */
1965 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1970 if (c
== '\"' || c
== '\\' || c
== '\''
1971 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1972 || c
== ',' || c
== '.' || c
== '`'
1973 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1976 printchar ('\\', printcharfun
);
1980 printchar (c
, printcharfun
);
1986 /* If deeper than spec'd depth, print placeholder. */
1987 if (INTEGERP (Vprint_level
)
1988 && print_depth
> XINT (Vprint_level
))
1989 print_c_string ("...", printcharfun
);
1990 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1991 && EQ (XCAR (obj
), Qquote
))
1993 printchar ('\'', printcharfun
);
1994 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1996 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1997 && EQ (XCAR (obj
), Qfunction
))
1999 print_c_string ("#'", printcharfun
);
2000 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
2002 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
2003 && EQ (XCAR (obj
), Qbackquote
))
2005 printchar ('`', printcharfun
);
2006 new_backquote_output
++;
2007 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
2008 new_backquote_output
--;
2010 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
2011 && new_backquote_output
2012 && (EQ (XCAR (obj
), Qcomma
)
2013 || EQ (XCAR (obj
), Qcomma_at
)
2014 || EQ (XCAR (obj
), Qcomma_dot
)))
2016 print_object (XCAR (obj
), printcharfun
, false);
2017 new_backquote_output
--;
2018 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
2019 new_backquote_output
++;
2023 printchar ('(', printcharfun
);
2025 Lisp_Object halftail
= obj
;
2027 /* Negative values of print-length are invalid in CL.
2028 Treat them like nil, as CMUCL does. */
2029 printmax_t print_length
= (NATNUMP (Vprint_length
)
2030 ? XFASTINT (Vprint_length
)
2031 : TYPE_MAXIMUM (printmax_t
));
2036 /* Detect circular list. */
2037 if (NILP (Vprint_circle
))
2039 /* Simple but incomplete way. */
2040 if (i
!= 0 && EQ (obj
, halftail
))
2042 int len
= sprintf (buf
, " . #%"pMd
, i
/ 2);
2043 strout (buf
, len
, len
, printcharfun
);
2049 /* With the print-circle feature. */
2052 Lisp_Object num
= Fgethash (obj
, Vprint_number_table
, Qnil
);
2055 print_c_string (" . ", printcharfun
);
2056 print_object (obj
, printcharfun
, escapeflag
);
2063 printchar (' ', printcharfun
);
2065 if (print_length
<= i
)
2067 print_c_string ("...", printcharfun
);
2072 print_object (XCAR (obj
), printcharfun
, escapeflag
);
2076 halftail
= XCDR (halftail
);
2079 /* OBJ non-nil here means it's the end of a dotted list. */
2082 print_c_string (" . ", printcharfun
);
2083 print_object (obj
, printcharfun
, escapeflag
);
2087 printchar (')', printcharfun
);
2091 case Lisp_Vectorlike
:
2092 if (! print_vectorlike (obj
, printcharfun
, escapeflag
, buf
))
2097 switch (XMISCTYPE (obj
))
2099 case Lisp_Misc_Marker
:
2100 print_c_string ("#<marker ", printcharfun
);
2101 /* Do you think this is necessary? */
2102 if (XMARKER (obj
)->insertion_type
!= 0)
2103 print_c_string ("(moves after insertion) ", printcharfun
);
2104 if (! XMARKER (obj
)->buffer
)
2105 print_c_string ("in no buffer", printcharfun
);
2108 int len
= sprintf (buf
, "at %"pD
"d in ", marker_position (obj
));
2109 strout (buf
, len
, len
, printcharfun
);
2110 print_string (BVAR (XMARKER (obj
)->buffer
, name
), printcharfun
);
2112 printchar ('>', printcharfun
);
2115 case Lisp_Misc_Overlay
:
2116 print_c_string ("#<overlay ", printcharfun
);
2117 if (! XMARKER (OVERLAY_START (obj
))->buffer
)
2118 print_c_string ("in no buffer", printcharfun
);
2121 int len
= sprintf (buf
, "from %"pD
"d to %"pD
"d in ",
2122 marker_position (OVERLAY_START (obj
)),
2123 marker_position (OVERLAY_END (obj
)));
2124 strout (buf
, len
, len
, printcharfun
);
2125 print_string (BVAR (XMARKER (OVERLAY_START (obj
))->buffer
, name
),
2128 printchar ('>', printcharfun
);
2132 case Lisp_Misc_User_Ptr
:
2134 print_c_string ("#<user-ptr ", printcharfun
);
2135 int i
= sprintf (buf
, "ptr=%p finalizer=%p",
2137 XUSER_PTR (obj
)->finalizer
);
2138 strout (buf
, i
, i
, printcharfun
);
2139 printchar ('>', printcharfun
);
2144 case Lisp_Misc_Finalizer
:
2145 print_c_string ("#<finalizer", printcharfun
);
2146 if (NILP (XFINALIZER (obj
)->function
))
2147 print_c_string (" used", printcharfun
);
2148 printchar ('>', printcharfun
);
2151 /* Remaining cases shouldn't happen in normal usage, but let's
2152 print them anyway for the benefit of the debugger. */
2154 case Lisp_Misc_Free
:
2155 print_c_string ("#<misc free cell>", printcharfun
);
2158 case Lisp_Misc_Save_Value
:
2161 struct Lisp_Save_Value
*v
= XSAVE_VALUE (obj
);
2163 print_c_string ("#<save-value ", printcharfun
);
2165 if (v
->save_type
== SAVE_TYPE_MEMORY
)
2167 ptrdiff_t amount
= v
->data
[1].integer
;
2169 /* valid_lisp_object_p is reliable, so try to print up
2170 to 8 saved objects. This code is rarely used, so
2171 it's OK that valid_lisp_object_p is slow. */
2173 int limit
= min (amount
, 8);
2174 Lisp_Object
*area
= v
->data
[0].pointer
;
2176 i
= sprintf (buf
, "with %"pD
"d objects", amount
);
2177 strout (buf
, i
, i
, printcharfun
);
2179 for (i
= 0; i
< limit
; i
++)
2181 Lisp_Object maybe
= area
[i
];
2182 int valid
= valid_lisp_object_p (maybe
);
2184 printchar (' ', printcharfun
);
2186 print_object (maybe
, printcharfun
, escapeflag
);
2188 print_c_string (valid
< 0 ? "<some>" : "<invalid>",
2191 if (i
== limit
&& i
< amount
)
2192 print_c_string (" ...", printcharfun
);
2196 /* Print each slot according to its type. */
2198 for (index
= 0; index
< SAVE_VALUE_SLOTS
; index
++)
2201 printchar (' ', printcharfun
);
2203 switch (save_type (v
, index
))
2206 i
= sprintf (buf
, "<unused>");
2210 i
= sprintf (buf
, "<pointer %p>",
2211 v
->data
[index
].pointer
);
2214 case SAVE_FUNCPOINTER
:
2215 i
= sprintf (buf
, "<funcpointer %p>",
2216 ((void *) (intptr_t)
2217 v
->data
[index
].funcpointer
));
2221 i
= sprintf (buf
, "<integer %"pD
"d>",
2222 v
->data
[index
].integer
);
2226 print_object (v
->data
[index
].object
, printcharfun
,
2234 strout (buf
, i
, i
, printcharfun
);
2237 printchar ('>', printcharfun
);
2250 /* We're in trouble if this happens!
2251 Probably should just emacs_abort (). */
2252 print_c_string ("#<EMACS BUG: INVALID DATATYPE ", printcharfun
);
2254 len
= sprintf (buf
, "(MISC 0x%04x)", (unsigned) XMISCTYPE (obj
));
2255 else if (VECTORLIKEP (obj
))
2256 len
= sprintf (buf
, "(PVEC 0x%08zx)", (size_t) ASIZE (obj
));
2258 len
= sprintf (buf
, "(0x%02x)", (unsigned) XTYPE (obj
));
2259 strout (buf
, len
, len
, printcharfun
);
2260 print_c_string ((" Save your buffers immediately"
2261 " and please report this bug>"),
2270 /* Print a description of INTERVAL using PRINTCHARFUN.
2271 This is part of printing a string that has text properties. */
2274 print_interval (INTERVAL interval
, Lisp_Object printcharfun
)
2276 if (NILP (interval
->plist
))
2278 printchar (' ', printcharfun
);
2279 print_object (make_number (interval
->position
), printcharfun
, 1);
2280 printchar (' ', printcharfun
);
2281 print_object (make_number (interval
->position
+ LENGTH (interval
)),
2283 printchar (' ', printcharfun
);
2284 print_object (interval
->plist
, printcharfun
, 1);
2287 /* Initialize debug_print stuff early to have it working from the very
2291 init_print_once (void)
2293 /* The subroutine object for external-debugging-output is kept here
2294 for the convenience of the debugger. */
2295 DEFSYM (Qexternal_debugging_output
, "external-debugging-output");
2297 defsubr (&Sexternal_debugging_output
);
2301 syms_of_print (void)
2303 DEFSYM (Qtemp_buffer_setup_hook
, "temp-buffer-setup-hook");
2305 DEFVAR_LISP ("standard-output", Vstandard_output
,
2306 doc
: /* Output stream `print' uses by default for outputting a character.
2307 This may be any function of one argument.
2308 It may also be a buffer (output is inserted before point)
2309 or a marker (output is inserted and the marker is advanced)
2310 or the symbol t (output appears in the echo area). */);
2311 Vstandard_output
= Qt
;
2312 DEFSYM (Qstandard_output
, "standard-output");
2314 DEFVAR_LISP ("float-output-format", Vfloat_output_format
,
2315 doc
: /* The format descriptor string used to print floats.
2316 This is a %-spec like those accepted by `printf' in C,
2317 but with some restrictions. It must start with the two characters `%.'.
2318 After that comes an integer precision specification,
2319 and then a letter which controls the format.
2320 The letters allowed are `e', `f' and `g'.
2321 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2322 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2323 Use `g' to choose the shorter of those two formats for the number at hand.
2324 The precision in any of these cases is the number of digits following
2325 the decimal point. With `f', a precision of 0 means to omit the
2326 decimal point. 0 is not allowed with `e' or `g'.
2328 A value of nil means to use the shortest notation
2329 that represents the number without losing information. */);
2330 Vfloat_output_format
= Qnil
;
2332 DEFVAR_LISP ("print-length", Vprint_length
,
2333 doc
: /* Maximum length of list to print before abbreviating.
2334 A value of nil means no limit. See also `eval-expression-print-length'. */);
2335 Vprint_length
= Qnil
;
2337 DEFVAR_LISP ("print-level", Vprint_level
,
2338 doc
: /* Maximum depth of list nesting to print before abbreviating.
2339 A value of nil means no limit. See also `eval-expression-print-level'. */);
2340 Vprint_level
= Qnil
;
2342 DEFVAR_BOOL ("print-escape-newlines", print_escape_newlines
,
2343 doc
: /* Non-nil means print newlines in strings as `\\n'.
2344 Also print formfeeds as `\\f'. */);
2345 print_escape_newlines
= 0;
2347 DEFVAR_BOOL ("print-escape-control-characters", print_escape_control_characters
,
2348 doc
: /* Non-nil means print control characters in strings as `\\OOO'.
2349 \(OOO is the octal representation of the character code.)*/);
2350 print_escape_control_characters
= 0;
2352 DEFVAR_BOOL ("print-escape-nonascii", print_escape_nonascii
,
2353 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2354 \(OOO is the octal representation of the character code.)
2355 Only single-byte characters are affected, and only in `prin1'.
2356 When the output goes in a multibyte buffer, this feature is
2357 enabled regardless of the value of the variable. */);
2358 print_escape_nonascii
= 0;
2360 DEFVAR_BOOL ("print-escape-multibyte", print_escape_multibyte
,
2361 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2362 \(XXXX is the hex representation of the character code.)
2363 This affects only `prin1'. */);
2364 print_escape_multibyte
= 0;
2366 DEFVAR_BOOL ("print-quoted", print_quoted
,
2367 doc
: /* Non-nil means print quoted forms with reader syntax.
2368 I.e., (quote foo) prints as \\='foo, (function foo) as #\\='foo. */);
2369 print_quoted
= true;
2371 DEFVAR_LISP ("print-gensym", Vprint_gensym
,
2372 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2373 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2374 When the uninterned symbol appears within a recursive data structure,
2375 and the symbol appears more than once, in addition use the #N# and #N=
2376 constructs as needed, so that multiple references to the same symbol are
2377 shared once again when the text is read back. */);
2378 Vprint_gensym
= Qnil
;
2380 DEFVAR_LISP ("print-circle", Vprint_circle
,
2381 doc
: /* Non-nil means print recursive structures using #N= and #N# syntax.
2382 If nil, printing proceeds recursively and may lead to
2383 `max-lisp-eval-depth' being exceeded or an error may occur:
2384 \"Apparently circular structure being printed.\" Also see
2385 `print-length' and `print-level'.
2386 If non-nil, shared substructures anywhere in the structure are printed
2387 with `#N=' before the first occurrence (in the order of the print
2388 representation) and `#N#' in place of each subsequent occurrence,
2389 where N is a positive decimal integer. */);
2390 Vprint_circle
= Qnil
;
2392 DEFVAR_LISP ("print-continuous-numbering", Vprint_continuous_numbering
,
2393 doc
: /* Non-nil means number continuously across print calls.
2394 This affects the numbers printed for #N= labels and #M# references.
2395 See also `print-circle', `print-gensym', and `print-number-table'.
2396 This variable should not be set with `setq'; bind it with a `let' instead. */);
2397 Vprint_continuous_numbering
= Qnil
;
2399 DEFVAR_LISP ("print-number-table", Vprint_number_table
,
2400 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2401 The Lisp printer uses this vector to detect Lisp objects referenced more
2404 When you bind `print-continuous-numbering' to t, you should probably
2405 also bind `print-number-table' to nil. This ensures that the value of
2406 `print-number-table' can be garbage-collected once the printing is
2407 done. If all elements of `print-number-table' are nil, it means that
2408 the printing done so far has not found any shared structure or objects
2409 that need to be recorded in the table. */);
2410 Vprint_number_table
= Qnil
;
2412 DEFVAR_LISP ("print-charset-text-property", Vprint_charset_text_property
,
2413 doc
: /* A flag to control printing of `charset' text property on printing a string.
2414 The value must be nil, t, or `default'.
2416 If the value is nil, don't print the text property `charset'.
2418 If the value is t, always print the text property `charset'.
2420 If the value is `default', print the text property `charset' only when
2421 the value is different from what is guessed in the current charset
2423 Vprint_charset_text_property
= Qdefault
;
2425 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2426 staticpro (&Vprin1_to_string_buffer
);
2429 defsubr (&Sprin1_to_string
);
2430 defsubr (&Serror_message_string
);
2434 defsubr (&Swrite_char
);
2435 defsubr (&Sredirect_debugging_output
);
2436 defsubr (&Sprint_preprocess
);
2438 DEFSYM (Qprint_escape_newlines
, "print-escape-newlines");
2439 DEFSYM (Qprint_escape_multibyte
, "print-escape-multibyte");
2440 DEFSYM (Qprint_escape_nonascii
, "print-escape-nonascii");
2441 DEFSYM (Qprint_escape_control_characters
, "print-escape-control-characters");
2443 print_prune_charset_plist
= Qnil
;
2444 staticpro (&print_prune_charset_plist
);