1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997,
3 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
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
11 (at 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/>. */
27 #include "character.h"
33 #include "dispextern.h"
35 #include "intervals.h"
36 #include "blockinput.h"
37 #include "termhooks.h" /* For struct terminal. */
40 Lisp_Object Vstandard_output
, Qstandard_output
;
42 Lisp_Object Qtemp_buffer_setup_hook
;
44 /* These are used to print like we read. */
45 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
47 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
55 /* Default to values appropriate for IEEE floating point. */
60 #define DBL_MANT_DIG 53
66 #define DBL_MIN 2.2250738585072014e-308
69 #ifdef DBL_MIN_REPLACEMENT
71 #define DBL_MIN DBL_MIN_REPLACEMENT
74 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
75 needed to express a float without losing information.
76 The general-case formula is valid for the usual case, IEEE floating point,
77 but many compilers can't optimize the formula to an integer constant,
78 so make a special case for it. */
79 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
80 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
82 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
85 /* Avoid actual stack overflow in print. */
88 /* Level of nesting inside outputting backquote in new style. */
89 int new_backquote_output
;
91 /* Detect most circularities to print finite output. */
92 #define PRINT_CIRCLE 200
93 Lisp_Object being_printed
[PRINT_CIRCLE
];
95 /* When printing into a buffer, first we put the text in this
96 block, then insert it all at once. */
99 /* Size allocated in print_buffer. */
100 int print_buffer_size
;
101 /* Chars stored in print_buffer. */
102 int print_buffer_pos
;
103 /* Bytes stored in print_buffer. */
104 int print_buffer_pos_byte
;
106 /* Maximum length of list to print in full; noninteger means
107 effectively infinity */
109 Lisp_Object Vprint_length
;
111 /* Maximum depth of list to print in full; noninteger means
112 effectively infinity. */
114 Lisp_Object Vprint_level
;
116 /* Nonzero means print newlines in strings as \n. */
118 int print_escape_newlines
;
120 /* Nonzero means to print single-byte non-ascii characters in strings as
123 int print_escape_nonascii
;
125 /* Nonzero means to print multibyte characters in strings as hex escapes. */
127 int print_escape_multibyte
;
129 Lisp_Object Qprint_escape_newlines
;
130 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
132 /* Nonzero means print (quote foo) forms as 'foo, etc. */
136 /* Non-nil means print #: before uninterned symbols. */
138 Lisp_Object Vprint_gensym
;
140 /* Non-nil means print recursive structures using #n= and #n# syntax. */
142 Lisp_Object Vprint_circle
;
144 /* Non-nil means keep continuous number for #n= and #n# syntax
145 between several print functions. */
147 Lisp_Object Vprint_continuous_numbering
;
149 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
150 where OBJn are objects going to be printed, and STATn are their status,
151 which may be different meanings during process. See the comments of
152 the functions print and print_preprocess for details.
153 print_number_index keeps the last position the next object should be added,
154 twice of which is the actual vector position in Vprint_number_table. */
155 int print_number_index
;
156 Lisp_Object Vprint_number_table
;
158 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
159 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
160 See the comment of the variable Vprint_number_table. */
161 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
162 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
164 /* Nonzero means print newline to stdout before next minibuffer message.
165 Defined in xdisp.c */
167 extern int noninteractive_need_newline
;
169 extern int minibuffer_auto_raise
;
171 void print_interval (INTERVAL interval
, Lisp_Object printcharfun
);
173 /* GDB resets this to zero on W32 to disable OutputDebugString calls. */
174 int print_output_debug_flag
= 1;
177 /* Low level output routines for characters and strings */
179 /* Lisp functions to do output using a stream
180 must have the stream in a variable called printcharfun
181 and must start with PRINTPREPARE, end with PRINTFINISH,
182 and use PRINTDECLARE to declare common variables.
183 Use PRINTCHAR to output one character,
184 or call strout to output a block of characters. */
186 #define PRINTDECLARE \
187 struct buffer *old = current_buffer; \
188 int old_point = -1, start_point = -1; \
189 int old_point_byte = -1, start_point_byte = -1; \
190 int specpdl_count = SPECPDL_INDEX (); \
191 int free_print_buffer = 0; \
192 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
195 #define PRINTPREPARE \
196 original = printcharfun; \
197 if (NILP (printcharfun)) printcharfun = Qt; \
198 if (BUFFERP (printcharfun)) \
200 if (XBUFFER (printcharfun) != current_buffer) \
201 Fset_buffer (printcharfun); \
202 printcharfun = Qnil; \
204 if (MARKERP (printcharfun)) \
206 EMACS_INT marker_pos; \
207 if (! XMARKER (printcharfun)->buffer) \
208 error ("Marker does not point anywhere"); \
209 if (XMARKER (printcharfun)->buffer != current_buffer) \
210 set_buffer_internal (XMARKER (printcharfun)->buffer); \
211 marker_pos = marker_position (printcharfun); \
212 if (marker_pos < BEGV || marker_pos > ZV) \
213 error ("Marker is outside the accessible part of the buffer"); \
215 old_point_byte = PT_BYTE; \
216 SET_PT_BOTH (marker_pos, \
217 marker_byte_position (printcharfun)); \
219 start_point_byte = PT_BYTE; \
220 printcharfun = Qnil; \
222 if (NILP (printcharfun)) \
224 Lisp_Object string; \
225 if (NILP (current_buffer->enable_multibyte_characters) \
226 && ! print_escape_multibyte) \
227 specbind (Qprint_escape_multibyte, Qt); \
228 if (! NILP (current_buffer->enable_multibyte_characters) \
229 && ! print_escape_nonascii) \
230 specbind (Qprint_escape_nonascii, Qt); \
231 if (print_buffer != 0) \
233 string = make_string_from_bytes (print_buffer, \
235 print_buffer_pos_byte); \
236 record_unwind_protect (print_unwind, string); \
240 print_buffer_size = 1000; \
241 print_buffer = (char *) xmalloc (print_buffer_size); \
242 free_print_buffer = 1; \
244 print_buffer_pos = 0; \
245 print_buffer_pos_byte = 0; \
247 if (EQ (printcharfun, Qt) && ! noninteractive) \
248 setup_echo_area_for_printing (multibyte);
250 #define PRINTFINISH \
251 if (NILP (printcharfun)) \
253 if (print_buffer_pos != print_buffer_pos_byte \
254 && NILP (current_buffer->enable_multibyte_characters)) \
256 unsigned char *temp \
257 = (unsigned char *) alloca (print_buffer_pos + 1); \
258 copy_text (print_buffer, temp, print_buffer_pos_byte, \
260 insert_1_both (temp, print_buffer_pos, \
261 print_buffer_pos, 0, 1, 0); \
264 insert_1_both (print_buffer, print_buffer_pos, \
265 print_buffer_pos_byte, 0, 1, 0); \
266 signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
268 if (free_print_buffer) \
270 xfree (print_buffer); \
273 unbind_to (specpdl_count, Qnil); \
274 if (MARKERP (original)) \
275 set_marker_both (original, Qnil, PT, PT_BYTE); \
276 if (old_point >= 0) \
277 SET_PT_BOTH (old_point + (old_point >= start_point \
278 ? PT - start_point : 0), \
279 old_point_byte + (old_point_byte >= start_point_byte \
280 ? PT_BYTE - start_point_byte : 0)); \
281 if (old != current_buffer) \
282 set_buffer_internal (old);
284 #define PRINTCHAR(ch) printchar (ch, printcharfun)
286 /* This is used to restore the saved contents of print_buffer
287 when there is a recursive call to print. */
290 print_unwind (Lisp_Object saved_text
)
292 bcopy (SDATA (saved_text
), print_buffer
, SCHARS (saved_text
));
297 /* Print character CH using method FUN. FUN nil means print to
298 print_buffer. FUN t means print to echo area or stdout if
299 non-interactive. If FUN is neither nil nor t, call FUN with CH as
303 printchar (unsigned int ch
, Lisp_Object fun
)
305 if (!NILP (fun
) && !EQ (fun
, Qt
))
306 call1 (fun
, make_number (ch
));
309 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
310 int len
= CHAR_STRING (ch
, str
);
316 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
317 print_buffer
= (char *) xrealloc (print_buffer
,
318 print_buffer_size
*= 2);
319 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
320 print_buffer_pos
+= 1;
321 print_buffer_pos_byte
+= len
;
323 else if (noninteractive
)
325 fwrite (str
, 1, len
, stdout
);
326 noninteractive_need_newline
= 1;
331 = !NILP (current_buffer
->enable_multibyte_characters
);
333 setup_echo_area_for_printing (multibyte_p
);
335 message_dolog (str
, len
, 0, multibyte_p
);
341 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
342 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
343 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
344 print_buffer. PRINTCHARFUN t means output to the echo area or to
345 stdout if non-interactive. If neither nil nor t, call Lisp
346 function PRINTCHARFUN for each character printed. MULTIBYTE
347 non-zero means PTR contains multibyte characters.
349 In the case where PRINTCHARFUN is nil, it is safe for PTR to point
350 to data in a Lisp string. Otherwise that is not safe. */
353 strout (const char *ptr
, int size
, int size_byte
, Lisp_Object printcharfun
,
357 size_byte
= size
= strlen (ptr
);
359 if (NILP (printcharfun
))
361 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
363 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
364 print_buffer
= (char *) xrealloc (print_buffer
,
367 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
368 print_buffer_pos
+= size
;
369 print_buffer_pos_byte
+= size_byte
;
371 else if (noninteractive
&& EQ (printcharfun
, Qt
))
373 fwrite (ptr
, 1, size_byte
, stdout
);
374 noninteractive_need_newline
= 1;
376 else if (EQ (printcharfun
, Qt
))
378 /* Output to echo area. We're trying to avoid a little overhead
379 here, that's the reason we don't call printchar to do the
383 = !NILP (current_buffer
->enable_multibyte_characters
);
385 setup_echo_area_for_printing (multibyte_p
);
386 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
388 if (size
== size_byte
)
390 for (i
= 0; i
< size
; ++i
)
391 insert_char ((unsigned char) *ptr
++);
396 for (i
= 0; i
< size_byte
; i
+= len
)
398 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, len
);
405 /* PRINTCHARFUN is a Lisp function. */
408 if (size
== size_byte
)
410 while (i
< size_byte
)
418 while (i
< size_byte
)
420 /* Here, we must convert each multi-byte form to the
421 corresponding character code before handing it to
424 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, len
);
432 /* Print the contents of a string STRING using PRINTCHARFUN.
433 It isn't safe to use strout in many cases,
434 because printing one char can relocate. */
437 print_string (Lisp_Object string
, Lisp_Object printcharfun
)
439 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
443 if (print_escape_nonascii
)
444 string
= string_escape_byte8 (string
);
446 if (STRING_MULTIBYTE (string
))
447 chars
= SCHARS (string
);
448 else if (! print_escape_nonascii
449 && (EQ (printcharfun
, Qt
)
450 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
451 : ! NILP (current_buffer
->enable_multibyte_characters
)))
453 /* If unibyte string STRING contains 8-bit codes, we must
454 convert STRING to a multibyte string containing the same
459 chars
= SBYTES (string
);
460 bytes
= parse_str_to_multibyte (SDATA (string
), chars
);
463 newstr
= make_uninit_multibyte_string (chars
, bytes
);
464 bcopy (SDATA (string
), SDATA (newstr
), chars
);
465 str_to_multibyte (SDATA (newstr
), bytes
, chars
);
470 chars
= SBYTES (string
);
472 if (EQ (printcharfun
, Qt
))
474 /* Output to echo area. */
475 int nbytes
= SBYTES (string
);
478 /* Copy the string contents so that relocation of STRING by
479 GC does not cause trouble. */
482 SAFE_ALLOCA (buffer
, char *, nbytes
);
483 bcopy (SDATA (string
), buffer
, nbytes
);
485 strout (buffer
, chars
, SBYTES (string
),
486 printcharfun
, STRING_MULTIBYTE (string
));
491 /* No need to copy, since output to print_buffer can't GC. */
492 strout (SDATA (string
),
493 chars
, SBYTES (string
),
494 printcharfun
, STRING_MULTIBYTE (string
));
498 /* Otherwise, string may be relocated by printing one char.
499 So re-fetch the string address for each character. */
501 int size
= SCHARS (string
);
502 int size_byte
= SBYTES (string
);
505 if (size
== size_byte
)
506 for (i
= 0; i
< size
; i
++)
507 PRINTCHAR (SREF (string
, i
));
509 for (i
= 0; i
< size_byte
; )
511 /* Here, we must convert each multi-byte form to the
512 corresponding character code before handing it to PRINTCHAR. */
514 int ch
= STRING_CHAR_AND_LENGTH (SDATA (string
) + i
, len
);
522 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
523 doc
: /* Output character CHARACTER to stream PRINTCHARFUN.
524 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
525 (character
, printcharfun
)
526 Lisp_Object character
, printcharfun
;
530 if (NILP (printcharfun
))
531 printcharfun
= Vstandard_output
;
532 CHECK_NUMBER (character
);
534 PRINTCHAR (XINT (character
));
539 /* Used from outside of print.c to print a block of SIZE
540 single-byte chars at DATA on the default output stream.
541 Do not use this on the contents of a Lisp string. */
544 write_string (char *data
, int size
)
547 Lisp_Object printcharfun
;
549 printcharfun
= Vstandard_output
;
552 strout (data
, size
, size
, printcharfun
, 0);
556 /* Used from outside of print.c to print a block of SIZE
557 single-byte chars at DATA on a specified stream PRINTCHARFUN.
558 Do not use this on the contents of a Lisp string. */
561 write_string_1 (char *data
, int size
, Lisp_Object printcharfun
)
566 strout (data
, size
, size
, printcharfun
, 0);
572 temp_output_buffer_setup (const char *bufname
)
574 int count
= SPECPDL_INDEX ();
575 register struct buffer
*old
= current_buffer
;
576 register Lisp_Object buf
;
578 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
580 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
582 Fkill_all_local_variables ();
583 delete_all_overlays (current_buffer
);
584 current_buffer
->directory
= old
->directory
;
585 current_buffer
->read_only
= Qnil
;
586 current_buffer
->filename
= Qnil
;
587 current_buffer
->undo_list
= Qt
;
588 eassert (current_buffer
->overlays_before
== NULL
);
589 eassert (current_buffer
->overlays_after
== NULL
);
590 current_buffer
->enable_multibyte_characters
591 = buffer_defaults
.enable_multibyte_characters
;
592 specbind (Qinhibit_read_only
, Qt
);
593 specbind (Qinhibit_modification_hooks
, Qt
);
595 XSETBUFFER (buf
, current_buffer
);
597 Frun_hooks (1, &Qtemp_buffer_setup_hook
);
599 unbind_to (count
, Qnil
);
601 specbind (Qstandard_output
, buf
);
605 internal_with_output_to_temp_buffer (const char *bufname
, Lisp_Object (*function
) (Lisp_Object
), Lisp_Object args
)
607 int count
= SPECPDL_INDEX ();
608 Lisp_Object buf
, val
;
612 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
613 temp_output_buffer_setup (bufname
);
614 buf
= Vstandard_output
;
617 val
= (*function
) (args
);
620 temp_output_buffer_show (buf
);
623 return unbind_to (count
, val
);
626 DEFUN ("with-output-to-temp-buffer",
627 Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
629 doc
: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
631 This construct makes buffer BUFNAME empty before running BODY.
632 It does not make the buffer current for BODY.
633 Instead it binds `standard-output' to that buffer, so that output
634 generated with `prin1' and similar functions in BODY goes into
637 At the end of BODY, this marks buffer BUFNAME unmodifed and displays
638 it in a window, but does not select it. The normal way to do this is
639 by calling `display-buffer', then running `temp-buffer-show-hook'.
640 However, if `temp-buffer-show-function' is non-nil, it calls that
641 function instead (and does not run `temp-buffer-show-hook'). The
642 function gets one argument, the buffer to display.
644 The return value of `with-output-to-temp-buffer' is the value of the
645 last form in BODY. If BODY does not finish normally, the buffer
646 BUFNAME is not displayed.
648 This runs the hook `temp-buffer-setup-hook' before BODY,
649 with the buffer BUFNAME temporarily current. It runs the hook
650 `temp-buffer-show-hook' after displaying buffer BUFNAME, with that
651 buffer temporarily current, and the window that was used to display it
652 temporarily selected. But it doesn't run `temp-buffer-show-hook'
653 if it uses `temp-buffer-show-function'.
655 usage: (with-output-to-temp-buffer BUFNAME BODY...) */)
661 int count
= SPECPDL_INDEX ();
662 Lisp_Object buf
, val
;
665 name
= Feval (Fcar (args
));
667 temp_output_buffer_setup (SDATA (name
));
668 buf
= Vstandard_output
;
671 val
= Fprogn (XCDR (args
));
674 temp_output_buffer_show (buf
);
677 return unbind_to (count
, val
);
681 static void print (Lisp_Object obj
, register Lisp_Object printcharfun
, int escapeflag
);
682 static void print_preprocess (Lisp_Object obj
);
683 static void print_preprocess_string (INTERVAL interval
, Lisp_Object arg
);
684 static void print_object (Lisp_Object obj
, register Lisp_Object printcharfun
, int escapeflag
);
686 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
687 doc
: /* Output a newline to stream PRINTCHARFUN.
688 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
690 Lisp_Object printcharfun
;
694 if (NILP (printcharfun
))
695 printcharfun
= Vstandard_output
;
702 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
703 doc
: /* Output the printed representation of OBJECT, any Lisp object.
704 Quoting characters are printed when needed to make output that `read'
705 can handle, whenever this is possible. For complex objects, the behavior
706 is controlled by `print-level' and `print-length', which see.
708 OBJECT is any of the Lisp data types: a number, a string, a symbol,
709 a list, a buffer, a window, a frame, etc.
711 A printed representation of an object is text which describes that object.
713 Optional argument PRINTCHARFUN is the output stream, which can be one
716 - a buffer, in which case output is inserted into that buffer at point;
717 - a marker, in which case output is inserted at marker's position;
718 - a function, in which case that function is called once for each
719 character of OBJECT's printed representation;
720 - a symbol, in which case that symbol's function definition is called; or
721 - t, in which case the output is displayed in the echo area.
723 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
725 (object
, printcharfun
)
726 Lisp_Object object
, printcharfun
;
730 if (NILP (printcharfun
))
731 printcharfun
= Vstandard_output
;
733 print (object
, printcharfun
, 1);
738 /* a buffer which is used to hold output being built by prin1-to-string */
739 Lisp_Object Vprin1_to_string_buffer
;
741 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
742 doc
: /* Return a string containing the printed representation of OBJECT.
743 OBJECT can be any Lisp object. This function outputs quoting characters
744 when necessary to make output that `read' can handle, whenever possible,
745 unless the optional second argument NOESCAPE is non-nil. For complex objects,
746 the behavior is controlled by `print-level' and `print-length', which see.
748 OBJECT is any of the Lisp data types: a number, a string, a symbol,
749 a list, a buffer, a window, a frame, etc.
751 A printed representation of an object is text which describes that object. */)
753 Lisp_Object object
, noescape
;
755 Lisp_Object printcharfun
;
756 /* struct gcpro gcpro1, gcpro2; */
757 Lisp_Object save_deactivate_mark
;
758 int count
= SPECPDL_INDEX ();
759 struct buffer
*previous
;
761 specbind (Qinhibit_modification_hooks
, Qt
);
766 /* Save and restore this--we are altering a buffer
767 but we don't want to deactivate the mark just for that.
768 No need for specbind, since errors deactivate the mark. */
769 save_deactivate_mark
= Vdeactivate_mark
;
770 /* GCPRO2 (object, save_deactivate_mark); */
773 printcharfun
= Vprin1_to_string_buffer
;
775 print (object
, printcharfun
, NILP (noescape
));
776 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
780 previous
= current_buffer
;
781 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
782 object
= Fbuffer_string ();
783 if (SBYTES (object
) == SCHARS (object
))
784 STRING_SET_UNIBYTE (object
);
786 /* Note that this won't make prepare_to_modify_buffer call
787 ask-user-about-supersession-threat because this buffer
788 does not visit a file. */
790 set_buffer_internal (previous
);
792 Vdeactivate_mark
= save_deactivate_mark
;
796 return unbind_to (count
, object
);
799 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
800 doc
: /* Output the printed representation of OBJECT, any Lisp object.
801 No quoting characters are used; no delimiters are printed around
802 the contents of strings.
804 OBJECT is any of the Lisp data types: a number, a string, a symbol,
805 a list, a buffer, a window, a frame, etc.
807 A printed representation of an object is text which describes that object.
809 Optional argument PRINTCHARFUN is the output stream, which can be one
812 - a buffer, in which case output is inserted into that buffer at point;
813 - a marker, in which case output is inserted at marker's position;
814 - a function, in which case that function is called once for each
815 character of OBJECT's printed representation;
816 - a symbol, in which case that symbol's function definition is called; or
817 - t, in which case the output is displayed in the echo area.
819 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
821 (object
, printcharfun
)
822 Lisp_Object object
, printcharfun
;
826 if (NILP (printcharfun
))
827 printcharfun
= Vstandard_output
;
829 print (object
, printcharfun
, 0);
834 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
835 doc
: /* Output the printed representation of OBJECT, with newlines around it.
836 Quoting characters are printed when needed to make output that `read'
837 can handle, whenever this is possible. For complex objects, the behavior
838 is controlled by `print-level' and `print-length', which see.
840 OBJECT is any of the Lisp data types: a number, a string, a symbol,
841 a list, a buffer, a window, a frame, etc.
843 A printed representation of an object is text which describes that object.
845 Optional argument PRINTCHARFUN is the output stream, which can be one
848 - a buffer, in which case output is inserted into that buffer at point;
849 - a marker, in which case output is inserted at marker's position;
850 - a function, in which case that function is called once for each
851 character of OBJECT's printed representation;
852 - a symbol, in which case that symbol's function definition is called; or
853 - t, in which case the output is displayed in the echo area.
855 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
857 (object
, printcharfun
)
858 Lisp_Object object
, printcharfun
;
863 if (NILP (printcharfun
))
864 printcharfun
= Vstandard_output
;
868 print (object
, printcharfun
, 1);
875 /* The subroutine object for external-debugging-output is kept here
876 for the convenience of the debugger. */
877 Lisp_Object Qexternal_debugging_output
;
879 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
880 doc
: /* Write CHARACTER to stderr.
881 You can call print while debugging emacs, and pass it this function
882 to make it write to the debugging output. */)
884 Lisp_Object character
;
886 CHECK_NUMBER (character
);
887 putc (XINT (character
), stderr
);
890 /* Send the output to a debugger (nothing happens if there isn't one). */
891 if (print_output_debug_flag
)
893 char buf
[2] = {(char) XINT (character
), '\0'};
894 OutputDebugString (buf
);
901 /* This function is never called. Its purpose is to prevent
902 print_output_debug_flag from being optimized away. */
905 debug_output_compilation_hack (int x
)
907 print_output_debug_flag
= x
;
910 #if defined (GNU_LINUX)
912 /* This functionality is not vitally important in general, so we rely on
913 non-portable ability to use stderr as lvalue. */
915 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
917 FILE *initial_stderr_stream
= NULL
;
919 DEFUN ("redirect-debugging-output", Fredirect_debugging_output
, Sredirect_debugging_output
,
921 "FDebug output file: \nP",
922 doc
: /* Redirect debugging output (stderr stream) to file FILE.
923 If FILE is nil, reset target to the initial stderr stream.
924 Optional arg APPEND non-nil (interactively, with prefix arg) means
925 append to existing target file. */)
927 Lisp_Object file
, append
;
929 if (initial_stderr_stream
!= NULL
)
935 stderr
= initial_stderr_stream
;
936 initial_stderr_stream
= NULL
;
940 file
= Fexpand_file_name (file
, Qnil
);
941 initial_stderr_stream
= stderr
;
942 stderr
= fopen (SDATA (file
), NILP (append
) ? "w" : "a");
945 stderr
= initial_stderr_stream
;
946 initial_stderr_stream
= NULL
;
947 report_file_error ("Cannot open debugging output stream",
953 #endif /* GNU_LINUX */
956 /* This is the interface for debugging printing. */
959 debug_print (Lisp_Object arg
)
961 Fprin1 (arg
, Qexternal_debugging_output
);
962 fprintf (stderr
, "\r\n");
966 safe_debug_print (Lisp_Object arg
)
968 int valid
= valid_lisp_object_p (arg
);
973 fprintf (stderr
, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
974 !valid
? "INVALID" : "SOME",
975 (unsigned long) XHASH (arg
)
980 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
982 doc
: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
983 See Info anchor `(elisp)Definition of signal' for some details on how this
984 error message is constructed. */)
988 struct buffer
*old
= current_buffer
;
992 /* If OBJ is (error STRING), just return STRING.
993 That is not only faster, it also avoids the need to allocate
994 space here when the error is due to memory full. */
995 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
996 && CONSP (XCDR (obj
))
997 && STRINGP (XCAR (XCDR (obj
)))
998 && NILP (XCDR (XCDR (obj
))))
999 return XCAR (XCDR (obj
));
1001 print_error_message (obj
, Vprin1_to_string_buffer
, 0, Qnil
);
1003 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
1004 value
= Fbuffer_string ();
1008 set_buffer_internal (old
);
1014 /* Print an error message for the error DATA onto Lisp output stream
1015 STREAM (suitable for the print functions).
1016 CONTEXT is a C string describing the context of the error.
1017 CALLER is the Lisp function inside which the error was signaled. */
1020 print_error_message (Lisp_Object data
, Lisp_Object stream
, char *context
, Lisp_Object caller
)
1022 Lisp_Object errname
, errmsg
, file_error
, tail
;
1023 struct gcpro gcpro1
;
1027 write_string_1 (context
, -1, stream
);
1029 /* If we know from where the error was signaled, show it in
1031 if (!NILP (caller
) && SYMBOLP (caller
))
1033 Lisp_Object cname
= SYMBOL_NAME (caller
);
1034 char *name
= alloca (SBYTES (cname
));
1035 bcopy (SDATA (cname
), name
, SBYTES (cname
));
1036 message_dolog (name
, SBYTES (cname
), 0, 0);
1037 message_dolog (": ", 2, 0, 0);
1040 errname
= Fcar (data
);
1042 if (EQ (errname
, Qerror
))
1047 errmsg
= Fcar (data
);
1052 Lisp_Object error_conditions
;
1053 errmsg
= Fget (errname
, Qerror_message
);
1054 error_conditions
= Fget (errname
, Qerror_conditions
);
1055 file_error
= Fmemq (Qfile_error
, error_conditions
);
1058 /* Print an error message including the data items. */
1060 tail
= Fcdr_safe (data
);
1063 /* For file-error, make error message by concatenating
1064 all the data items. They are all strings. */
1065 if (!NILP (file_error
) && CONSP (tail
))
1066 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
1068 if (STRINGP (errmsg
))
1069 Fprinc (errmsg
, stream
);
1071 write_string_1 ("peculiar error", -1, stream
);
1073 for (i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
1077 write_string_1 (i
? ", " : ": ", 2, stream
);
1079 if (!NILP (file_error
) || EQ (errname
, Qend_of_file
))
1080 Fprinc (obj
, stream
);
1082 Fprin1 (obj
, stream
);
1091 * The buffer should be at least as large as the max string size of the
1092 * largest float, printed in the biggest notation. This is undoubtedly
1093 * 20d float_output_format, with the negative of the C-constant "HUGE"
1096 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1098 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1099 * case of -1e307 in 20d float_output_format. What is one to do (short of
1100 * re-writing _doprnt to be more sane)?
1105 float_to_string (unsigned char *buf
, double data
)
1110 /* Check for plus infinity in a way that won't lose
1111 if there is no plus infinity. */
1112 if (data
== data
/ 2 && data
> 1.0)
1114 strcpy (buf
, "1.0e+INF");
1117 /* Likewise for minus infinity. */
1118 if (data
== data
/ 2 && data
< -1.0)
1120 strcpy (buf
, "-1.0e+INF");
1123 /* Check for NaN in a way that won't fail if there are no NaNs. */
1124 if (! (data
* 0.0 >= 0.0))
1126 /* Prepend "-" if the NaN's sign bit is negative.
1127 The sign bit of a double is the bit that is 1 in -0.0. */
1129 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
1131 u_minus_zero
.d
= - 0.0;
1132 for (i
= 0; i
< sizeof (double); i
++)
1133 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1139 strcpy (buf
, "0.0e+NaN");
1143 if (NILP (Vfloat_output_format
)
1144 || !STRINGP (Vfloat_output_format
))
1147 /* Generate the fewest number of digits that represent the
1148 floating point value without losing information.
1149 The following method is simple but a bit slow.
1150 For ideas about speeding things up, please see:
1152 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1153 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1155 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1156 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1158 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1160 sprintf (buf
, "%.*g", width
, data
);
1161 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1163 else /* oink oink */
1165 /* Check that the spec we have is fully valid.
1166 This means not only valid for printf,
1167 but meant for floats, and reasonable. */
1168 cp
= SDATA (Vfloat_output_format
);
1177 /* Check the width specification. */
1179 if ('0' <= *cp
&& *cp
<= '9')
1183 width
= (width
* 10) + (*cp
++ - '0');
1184 while (*cp
>= '0' && *cp
<= '9');
1186 /* A precision of zero is valid only for %f. */
1188 || (width
== 0 && *cp
!= 'f'))
1192 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1198 sprintf (buf
, SDATA (Vfloat_output_format
), data
);
1201 /* Make sure there is a decimal point with digit after, or an
1202 exponent, so that the value is readable as a float. But don't do
1203 this with "%.0f"; it's valid for that not to produce a decimal
1204 point. Note that width can be 0 only for %.0f. */
1207 for (cp
= buf
; *cp
; cp
++)
1208 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1211 if (*cp
== '.' && cp
[1] == 0)
1228 print (Lisp_Object obj
, register Lisp_Object printcharfun
, int escapeflag
)
1230 new_backquote_output
= 0;
1232 /* Reset print_number_index and Vprint_number_table only when
1233 the variable Vprint_continuous_numbering is nil. Otherwise,
1234 the values of these variables will be kept between several
1236 if (NILP (Vprint_continuous_numbering
)
1237 || NILP (Vprint_number_table
))
1239 print_number_index
= 0;
1240 Vprint_number_table
= Qnil
;
1243 /* Construct Vprint_number_table for print-gensym and print-circle. */
1244 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1246 int i
, start
, index
;
1247 start
= index
= print_number_index
;
1248 /* Construct Vprint_number_table.
1249 This increments print_number_index for the objects added. */
1251 print_preprocess (obj
);
1253 /* Remove unnecessary objects, which appear only once in OBJ;
1254 that is, whose status is Qnil. Compactify the necessary objects. */
1255 for (i
= start
; i
< print_number_index
; i
++)
1256 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1258 PRINT_NUMBER_OBJECT (Vprint_number_table
, index
)
1259 = PRINT_NUMBER_OBJECT (Vprint_number_table
, i
);
1263 /* Clear out objects outside the active part of the table. */
1264 for (i
= index
; i
< print_number_index
; i
++)
1265 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
) = Qnil
;
1267 /* Reset the status field for the next print step. Now this
1268 field means whether the object has already been printed. */
1269 for (i
= start
; i
< print_number_index
; i
++)
1270 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qnil
;
1272 print_number_index
= index
;
1276 print_object (obj
, printcharfun
, escapeflag
);
1279 /* Construct Vprint_number_table according to the structure of OBJ.
1280 OBJ itself and all its elements will be added to Vprint_number_table
1281 recursively if it is a list, vector, compiled function, char-table,
1282 string (its text properties will be traced), or a symbol that has
1283 no obarray (this is for the print-gensym feature).
1284 The status fields of Vprint_number_table mean whether each object appears
1285 more than once in OBJ: Qnil at the first time, and Qt after that . */
1287 print_preprocess (Lisp_Object obj
)
1292 Lisp_Object halftail
;
1294 /* Give up if we go so deep that print_object will get an error. */
1295 /* See similar code in print_object. */
1296 if (print_depth
>= PRINT_CIRCLE
)
1297 error ("Apparently circular structure being printed");
1299 /* Avoid infinite recursion for circular nested structure
1300 in the case where Vprint_circle is nil. */
1301 if (NILP (Vprint_circle
))
1303 for (i
= 0; i
< print_depth
; i
++)
1304 if (EQ (obj
, being_printed
[i
]))
1306 being_printed
[print_depth
] = obj
;
1313 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1314 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
)
1315 || HASH_TABLE_P (obj
)
1316 || (! NILP (Vprint_gensym
)
1318 && !SYMBOL_INTERNED_P (obj
)))
1320 /* In case print-circle is nil and print-gensym is t,
1321 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1322 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1324 for (i
= 0; i
< print_number_index
; i
++)
1325 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1327 /* OBJ appears more than once. Let's remember that. */
1328 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1333 /* OBJ is not yet recorded. Let's add to the table. */
1334 if (print_number_index
== 0)
1336 /* Initialize the table. */
1337 Vprint_number_table
= Fmake_vector (make_number (40), Qnil
);
1339 else if (XVECTOR (Vprint_number_table
)->size
== print_number_index
* 2)
1341 /* Reallocate the table. */
1342 int i
= print_number_index
* 4;
1343 Lisp_Object old_table
= Vprint_number_table
;
1344 Vprint_number_table
= Fmake_vector (make_number (i
), Qnil
);
1345 for (i
= 0; i
< print_number_index
; i
++)
1347 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
)
1348 = PRINT_NUMBER_OBJECT (old_table
, i
);
1349 PRINT_NUMBER_STATUS (Vprint_number_table
, i
)
1350 = PRINT_NUMBER_STATUS (old_table
, i
);
1353 PRINT_NUMBER_OBJECT (Vprint_number_table
, print_number_index
) = obj
;
1354 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1355 always print the gensym with a number. This is a special for
1356 the lisp function byte-compile-output-docform. */
1357 if (!NILP (Vprint_continuous_numbering
)
1359 && !SYMBOL_INTERNED_P (obj
))
1360 PRINT_NUMBER_STATUS (Vprint_number_table
, print_number_index
) = Qt
;
1361 print_number_index
++;
1364 switch (XTYPE (obj
))
1367 /* A string may have text properties, which can be circular. */
1368 traverse_intervals_noorder (STRING_INTERVALS (obj
),
1369 print_preprocess_string
, Qnil
);
1373 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1374 just as in print_object. */
1375 if (loop_count
&& EQ (obj
, halftail
))
1377 print_preprocess (XCAR (obj
));
1380 if (!(loop_count
& 1))
1381 halftail
= XCDR (halftail
);
1384 case Lisp_Vectorlike
:
1385 size
= XVECTOR (obj
)->size
;
1386 if (size
& PSEUDOVECTOR_FLAG
)
1387 size
&= PSEUDOVECTOR_SIZE_MASK
;
1388 for (i
= 0; i
< size
; i
++)
1389 print_preprocess (XVECTOR (obj
)->contents
[i
]);
1390 if (HASH_TABLE_P (obj
))
1391 { /* For hash tables, the key_and_value slot is past
1392 `size' because it needs to be marked specially in case
1393 the table is weak. */
1394 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1395 print_preprocess (h
->key_and_value
);
1407 print_preprocess_string (INTERVAL interval
, Lisp_Object arg
)
1409 print_preprocess (interval
->plist
);
1412 /* A flag to control printing of `charset' text property.
1413 The default value is Qdefault. */
1414 Lisp_Object Vprint_charset_text_property
;
1415 extern Lisp_Object Qdefault
;
1417 static void print_check_string_charset_prop (INTERVAL interval
, Lisp_Object string
);
1419 #define PRINT_STRING_NON_CHARSET_FOUND 1
1420 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
1422 /* Bitwize or of the abobe macros. */
1423 static int print_check_string_result
;
1426 print_check_string_charset_prop (INTERVAL interval
, Lisp_Object string
)
1430 if (NILP (interval
->plist
)
1431 || (print_check_string_result
== (PRINT_STRING_NON_CHARSET_FOUND
1432 | PRINT_STRING_UNSAFE_CHARSET_FOUND
)))
1434 for (val
= interval
->plist
; CONSP (val
) && ! EQ (XCAR (val
), Qcharset
);
1435 val
= XCDR (XCDR (val
)));
1438 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1441 if (! (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
))
1443 if (! EQ (val
, interval
->plist
)
1444 || CONSP (XCDR (XCDR (val
))))
1445 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1447 if (NILP (Vprint_charset_text_property
)
1448 || ! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1451 int charpos
= interval
->position
;
1452 int bytepos
= string_char_to_byte (string
, charpos
);
1453 Lisp_Object charset
;
1455 charset
= XCAR (XCDR (val
));
1456 for (i
= 0; i
< LENGTH (interval
); i
++)
1458 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1459 if (! ASCII_CHAR_P (c
)
1460 && ! EQ (CHARSET_NAME (CHAR_CHARSET (c
)), charset
))
1462 print_check_string_result
|= PRINT_STRING_UNSAFE_CHARSET_FOUND
;
1469 /* The value is (charset . nil). */
1470 static Lisp_Object print_prune_charset_plist
;
1473 print_prune_string_charset (Lisp_Object string
)
1475 print_check_string_result
= 0;
1476 traverse_intervals (STRING_INTERVALS (string
), 0,
1477 print_check_string_charset_prop
, string
);
1478 if (! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1480 string
= Fcopy_sequence (string
);
1481 if (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
)
1483 if (NILP (print_prune_charset_plist
))
1484 print_prune_charset_plist
= Fcons (Qcharset
, Qnil
);
1485 Fremove_text_properties (make_number (0),
1486 make_number (SCHARS (string
)),
1487 print_prune_charset_plist
, string
);
1490 Fset_text_properties (make_number (0), make_number (SCHARS (string
)),
1497 print_object (Lisp_Object obj
, register Lisp_Object printcharfun
, int escapeflag
)
1503 /* See similar code in print_preprocess. */
1504 if (print_depth
>= PRINT_CIRCLE
)
1505 error ("Apparently circular structure being printed");
1507 /* Detect circularities and truncate them. */
1508 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1509 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
)
1510 || HASH_TABLE_P (obj
)
1511 || (! NILP (Vprint_gensym
)
1513 && !SYMBOL_INTERNED_P (obj
)))
1515 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1517 /* Simple but incomplete way. */
1519 for (i
= 0; i
< print_depth
; i
++)
1520 if (EQ (obj
, being_printed
[i
]))
1522 sprintf (buf
, "#%d", i
);
1523 strout (buf
, -1, -1, printcharfun
, 0);
1526 being_printed
[print_depth
] = obj
;
1530 /* With the print-circle feature. */
1532 for (i
= 0; i
< print_number_index
; i
++)
1533 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1535 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1537 /* Add a prefix #n= if OBJ has not yet been printed;
1538 that is, its status field is nil. */
1539 sprintf (buf
, "#%d=", i
+ 1);
1540 strout (buf
, -1, -1, printcharfun
, 0);
1541 /* OBJ is going to be printed. Set the status to t. */
1542 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1547 /* Just print #n# if OBJ has already been printed. */
1548 sprintf (buf
, "#%d#", i
+ 1);
1549 strout (buf
, -1, -1, printcharfun
, 0);
1558 switch (XTYPE (obj
))
1561 if (sizeof (int) == sizeof (EMACS_INT
))
1562 sprintf (buf
, "%d", (int) XINT (obj
));
1563 else if (sizeof (long) == sizeof (EMACS_INT
))
1564 sprintf (buf
, "%ld", (long) XINT (obj
));
1567 strout (buf
, -1, -1, printcharfun
, 0);
1572 char pigbuf
[350]; /* see comments in float_to_string */
1574 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1575 strout (pigbuf
, -1, -1, printcharfun
, 0);
1581 print_string (obj
, printcharfun
);
1584 register int i
, i_byte
;
1585 struct gcpro gcpro1
;
1588 /* 1 means we must ensure that the next character we output
1589 cannot be taken as part of a hex character escape. */
1590 int need_nonhex
= 0;
1591 int multibyte
= STRING_MULTIBYTE (obj
);
1595 if (! EQ (Vprint_charset_text_property
, Qt
))
1596 obj
= print_prune_string_charset (obj
);
1598 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1606 size_byte
= SBYTES (obj
);
1608 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1610 /* Here, we must convert each multi-byte form to the
1611 corresponding character code before handing it to PRINTCHAR. */
1617 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
, len
);
1625 if (c
== '\n' && print_escape_newlines
)
1630 else if (c
== '\f' && print_escape_newlines
)
1636 && (CHAR_BYTE8_P (c
)
1637 || (! ASCII_CHAR_P (c
) && print_escape_multibyte
)))
1639 /* When multibyte is disabled,
1640 print multibyte string chars using hex escapes.
1641 For a char code that could be in a unibyte string,
1642 when found in a multibyte string, always use a hex escape
1643 so it reads back as multibyte. */
1644 unsigned char outbuf
[50];
1646 if (CHAR_BYTE8_P (c
))
1647 sprintf (outbuf
, "\\%03o", CHAR_TO_BYTE8 (c
));
1650 sprintf (outbuf
, "\\x%04x", c
);
1653 strout (outbuf
, -1, -1, printcharfun
, 0);
1655 else if (! multibyte
1656 && SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1657 && print_escape_nonascii
)
1659 /* When printing in a multibyte buffer
1660 or when explicitly requested,
1661 print single-byte non-ASCII string chars
1662 using octal escapes. */
1663 unsigned char outbuf
[5];
1664 sprintf (outbuf
, "\\%03o", c
);
1665 strout (outbuf
, -1, -1, printcharfun
, 0);
1669 /* If we just had a hex escape, and this character
1670 could be taken as part of it,
1671 output `\ ' to prevent that. */
1675 if ((c
>= 'a' && c
<= 'f')
1676 || (c
>= 'A' && c
<= 'F')
1677 || (c
>= '0' && c
<= '9'))
1678 strout ("\\ ", -1, -1, printcharfun
, 0);
1681 if (c
== '\"' || c
== '\\')
1688 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1690 traverse_intervals (STRING_INTERVALS (obj
),
1691 0, print_interval
, printcharfun
);
1701 register int confusing
;
1702 register unsigned char *p
= SDATA (SYMBOL_NAME (obj
));
1703 register unsigned char *end
= p
+ SBYTES (SYMBOL_NAME (obj
));
1705 int i
, i_byte
, size_byte
;
1708 name
= SYMBOL_NAME (obj
);
1710 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1713 /* If symbol name begins with a digit, and ends with a digit,
1714 and contains nothing but digits and `e', it could be treated
1715 as a number. So set CONFUSING.
1717 Symbols that contain periods could also be taken as numbers,
1718 but periods are always escaped, so we don't have to worry
1720 else if (*p
>= '0' && *p
<= '9'
1721 && end
[-1] >= '0' && end
[-1] <= '9')
1723 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1724 /* Needed for \2e10. */
1725 || *p
== 'e' || *p
== 'E'))
1727 confusing
= (end
== p
);
1732 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1738 size_byte
= SBYTES (name
);
1740 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1742 /* Here, we must convert each multi-byte form to the
1743 corresponding character code before handing it to PRINTCHAR. */
1744 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1749 if (c
== '\"' || c
== '\\' || c
== '\''
1750 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1751 || c
== ',' || c
=='.' || c
== '`'
1752 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1754 PRINTCHAR ('\\'), confusing
= 0;
1762 /* If deeper than spec'd depth, print placeholder. */
1763 if (INTEGERP (Vprint_level
)
1764 && print_depth
> XINT (Vprint_level
))
1765 strout ("...", -1, -1, printcharfun
, 0);
1766 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1767 && (EQ (XCAR (obj
), Qquote
)))
1770 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1772 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1773 && (EQ (XCAR (obj
), Qfunction
)))
1777 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1779 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1780 && ((EQ (XCAR (obj
), Qbackquote
))))
1782 print_object (XCAR (obj
), printcharfun
, 0);
1783 new_backquote_output
++;
1784 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1785 new_backquote_output
--;
1787 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1788 && new_backquote_output
1789 && ((EQ (XCAR (obj
), Qbackquote
)
1790 || EQ (XCAR (obj
), Qcomma
)
1791 || EQ (XCAR (obj
), Qcomma_at
)
1792 || EQ (XCAR (obj
), Qcomma_dot
))))
1794 print_object (XCAR (obj
), printcharfun
, 0);
1795 new_backquote_output
--;
1796 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1797 new_backquote_output
++;
1803 /* If the first element is a backquote form,
1804 print it old-style so it won't be misunderstood. */
1805 if (print_quoted
&& CONSP (XCAR (obj
))
1806 && CONSP (XCDR (XCAR (obj
)))
1807 && NILP (XCDR (XCDR (XCAR (obj
))))
1808 && EQ (XCAR (XCAR (obj
)), Qbackquote
))
1814 print_object (Qbackquote
, printcharfun
, 0);
1817 print_object (XCAR (XCDR (tem
)), printcharfun
, 0);
1824 int print_length
, i
;
1825 Lisp_Object halftail
= obj
;
1827 /* Negative values of print-length are invalid in CL.
1828 Treat them like nil, as CMUCL does. */
1829 if (NATNUMP (Vprint_length
))
1830 print_length
= XFASTINT (Vprint_length
);
1837 /* Detect circular list. */
1838 if (NILP (Vprint_circle
))
1840 /* Simple but imcomplete way. */
1841 if (i
!= 0 && EQ (obj
, halftail
))
1843 sprintf (buf
, " . #%d", i
/ 2);
1844 strout (buf
, -1, -1, printcharfun
, 0);
1850 /* With the print-circle feature. */
1854 for (i
= 0; i
< print_number_index
; i
++)
1855 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
),
1858 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1860 strout (" . ", 3, 3, printcharfun
, 0);
1861 print_object (obj
, printcharfun
, escapeflag
);
1865 sprintf (buf
, " . #%d#", i
+ 1);
1866 strout (buf
, -1, -1, printcharfun
, 0);
1876 if (print_length
&& i
> print_length
)
1878 strout ("...", 3, 3, printcharfun
, 0);
1882 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1886 halftail
= XCDR (halftail
);
1890 /* OBJ non-nil here means it's the end of a dotted list. */
1893 strout (" . ", 3, 3, printcharfun
, 0);
1894 print_object (obj
, printcharfun
, escapeflag
);
1902 case Lisp_Vectorlike
:
1907 strout ("#<process ", -1, -1, printcharfun
, 0);
1908 print_string (XPROCESS (obj
)->name
, printcharfun
);
1912 print_string (XPROCESS (obj
)->name
, printcharfun
);
1914 else if (BOOL_VECTOR_P (obj
))
1917 register unsigned char c
;
1918 struct gcpro gcpro1
;
1920 = ((XBOOL_VECTOR (obj
)->size
+ BOOL_VECTOR_BITS_PER_CHAR
- 1)
1921 / BOOL_VECTOR_BITS_PER_CHAR
);
1927 sprintf (buf
, "%ld", (long) XBOOL_VECTOR (obj
)->size
);
1928 strout (buf
, -1, -1, printcharfun
, 0);
1931 /* Don't print more characters than the specified maximum.
1932 Negative values of print-length are invalid. Treat them
1933 like a print-length of nil. */
1934 if (NATNUMP (Vprint_length
)
1935 && XFASTINT (Vprint_length
) < size_in_chars
)
1936 size_in_chars
= XFASTINT (Vprint_length
);
1938 for (i
= 0; i
< size_in_chars
; i
++)
1941 c
= XBOOL_VECTOR (obj
)->data
[i
];
1942 if (c
== '\n' && print_escape_newlines
)
1947 else if (c
== '\f' && print_escape_newlines
)
1952 else if (c
> '\177')
1954 /* Use octal escapes to avoid encoding issues. */
1956 PRINTCHAR ('0' + ((c
>> 6) & 3));
1957 PRINTCHAR ('0' + ((c
>> 3) & 7));
1958 PRINTCHAR ('0' + (c
& 7));
1962 if (c
== '\"' || c
== '\\')
1971 else if (SUBRP (obj
))
1973 strout ("#<subr ", -1, -1, printcharfun
, 0);
1974 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1977 else if (WINDOWP (obj
))
1979 strout ("#<window ", -1, -1, printcharfun
, 0);
1980 sprintf (buf
, "%ld", (long) XFASTINT (XWINDOW (obj
)->sequence_number
));
1981 strout (buf
, -1, -1, printcharfun
, 0);
1982 if (!NILP (XWINDOW (obj
)->buffer
))
1984 strout (" on ", -1, -1, printcharfun
, 0);
1985 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1989 else if (TERMINALP (obj
))
1991 struct terminal
*t
= XTERMINAL (obj
);
1992 strout ("#<terminal ", -1, -1, printcharfun
, 0);
1993 sprintf (buf
, "%d", t
->id
);
1994 strout (buf
, -1, -1, printcharfun
, 0);
1997 strout (" on ", -1, -1, printcharfun
, 0);
1998 strout (t
->name
, -1, -1, printcharfun
, 0);
2002 else if (HASH_TABLE_P (obj
))
2004 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
2005 int i
, real_size
, size
;
2007 strout ("#<hash-table", -1, -1, printcharfun
, 0);
2008 if (SYMBOLP (h
->test
))
2012 strout (SDATA (SYMBOL_NAME (h
->test
)), -1, -1, printcharfun
, 0);
2014 strout (SDATA (SYMBOL_NAME (h
->weak
)), -1, -1, printcharfun
, 0);
2016 sprintf (buf
, "%ld/%ld", (long) h
->count
,
2017 (long) XVECTOR (h
->next
)->size
);
2018 strout (buf
, -1, -1, printcharfun
, 0);
2020 sprintf (buf
, " 0x%lx", (unsigned long) h
);
2021 strout (buf
, -1, -1, printcharfun
, 0);
2024 /* Implement a readable output, e.g.:
2025 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2026 /* Always print the size. */
2027 sprintf (buf
, "#s(hash-table size %ld",
2028 (long) XVECTOR (h
->next
)->size
);
2029 strout (buf
, -1, -1, printcharfun
, 0);
2031 if (!NILP (h
->test
))
2033 strout (" test ", -1, -1, printcharfun
, 0);
2034 print_object (h
->test
, printcharfun
, 0);
2037 if (!NILP (h
->weak
))
2039 strout (" weakness ", -1, -1, printcharfun
, 0);
2040 print_object (h
->weak
, printcharfun
, 0);
2043 if (!NILP (h
->rehash_size
))
2045 strout (" rehash-size ", -1, -1, printcharfun
, 0);
2046 print_object (h
->rehash_size
, printcharfun
, 0);
2049 if (!NILP (h
->rehash_threshold
))
2051 strout (" rehash-threshold ", -1, -1, printcharfun
, 0);
2052 print_object (h
->rehash_threshold
, printcharfun
, 0);
2055 strout (" data ", -1, -1, printcharfun
, 0);
2057 /* Print the data here as a plist. */
2058 real_size
= HASH_TABLE_SIZE (h
);
2061 /* Don't print more elements than the specified maximum. */
2062 if (NATNUMP (Vprint_length
)
2063 && XFASTINT (Vprint_length
) < size
)
2064 size
= XFASTINT (Vprint_length
);
2067 for (i
= 0; i
< size
; i
++)
2068 if (!NILP (HASH_HASH (h
, i
)))
2070 if (i
) PRINTCHAR (' ');
2071 print_object (HASH_KEY (h
, i
), printcharfun
, 1);
2073 print_object (HASH_VALUE (h
, i
), printcharfun
, 1);
2076 if (size
< real_size
)
2077 strout (" ...", 4, 4, printcharfun
, 0);
2083 else if (BUFFERP (obj
))
2085 if (NILP (XBUFFER (obj
)->name
))
2086 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
2087 else if (escapeflag
)
2089 strout ("#<buffer ", -1, -1, printcharfun
, 0);
2090 print_string (XBUFFER (obj
)->name
, printcharfun
);
2094 print_string (XBUFFER (obj
)->name
, printcharfun
);
2096 else if (WINDOW_CONFIGURATIONP (obj
))
2098 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
2100 else if (FRAMEP (obj
))
2102 strout ((FRAME_LIVE_P (XFRAME (obj
))
2103 ? "#<frame " : "#<dead frame "),
2104 -1, -1, printcharfun
, 0);
2105 print_string (XFRAME (obj
)->name
, printcharfun
);
2106 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
2107 strout (buf
, -1, -1, printcharfun
, 0);
2110 else if (FONTP (obj
))
2114 if (! FONT_OBJECT_P (obj
))
2116 if (FONT_SPEC_P (obj
))
2117 strout ("#<font-spec", -1, -1, printcharfun
, 0);
2119 strout ("#<font-entity", -1, -1, printcharfun
, 0);
2120 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2123 if (i
< FONT_WEIGHT_INDEX
|| i
> FONT_WIDTH_INDEX
)
2124 print_object (AREF (obj
, i
), printcharfun
, escapeflag
);
2126 print_object (font_style_symbolic (obj
, i
, 0),
2127 printcharfun
, escapeflag
);
2132 strout ("#<font-object ", -1, -1, printcharfun
, 0);
2133 print_object (AREF (obj
, FONT_NAME_INDEX
), printcharfun
,
2140 EMACS_INT size
= XVECTOR (obj
)->size
;
2141 if (COMPILEDP (obj
))
2144 size
&= PSEUDOVECTOR_SIZE_MASK
;
2146 if (CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
))
2148 /* We print a char-table as if it were a vector,
2149 lumping the parent and default slots in with the
2150 character slots. But we add #^ as a prefix. */
2152 /* Make each lowest sub_char_table start a new line.
2153 Otherwise we'll make a line extremely long, which
2154 results in slow redisplay. */
2155 if (SUB_CHAR_TABLE_P (obj
)
2156 && XINT (XSUB_CHAR_TABLE (obj
)->depth
) == 3)
2160 if (SUB_CHAR_TABLE_P (obj
))
2162 size
&= PSEUDOVECTOR_SIZE_MASK
;
2164 if (size
& PSEUDOVECTOR_FLAG
)
2170 register Lisp_Object tem
;
2171 int real_size
= size
;
2173 /* Don't print more elements than the specified maximum. */
2174 if (NATNUMP (Vprint_length
)
2175 && XFASTINT (Vprint_length
) < size
)
2176 size
= XFASTINT (Vprint_length
);
2178 for (i
= 0; i
< size
; i
++)
2180 if (i
) PRINTCHAR (' ');
2181 tem
= XVECTOR (obj
)->contents
[i
];
2182 print_object (tem
, printcharfun
, escapeflag
);
2184 if (size
< real_size
)
2185 strout (" ...", 4, 4, printcharfun
, 0);
2192 switch (XMISCTYPE (obj
))
2194 case Lisp_Misc_Marker
:
2195 strout ("#<marker ", -1, -1, printcharfun
, 0);
2196 /* Do you think this is necessary? */
2197 if (XMARKER (obj
)->insertion_type
!= 0)
2198 strout ("(moves after insertion) ", -1, -1, printcharfun
, 0);
2199 if (! XMARKER (obj
)->buffer
)
2200 strout ("in no buffer", -1, -1, printcharfun
, 0);
2203 sprintf (buf
, "at %d", marker_position (obj
));
2204 strout (buf
, -1, -1, printcharfun
, 0);
2205 strout (" in ", -1, -1, printcharfun
, 0);
2206 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
2211 case Lisp_Misc_Overlay
:
2212 strout ("#<overlay ", -1, -1, printcharfun
, 0);
2213 if (! XMARKER (OVERLAY_START (obj
))->buffer
)
2214 strout ("in no buffer", -1, -1, printcharfun
, 0);
2217 sprintf (buf
, "from %d to %d in ",
2218 marker_position (OVERLAY_START (obj
)),
2219 marker_position (OVERLAY_END (obj
)));
2220 strout (buf
, -1, -1, printcharfun
, 0);
2221 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
2227 /* Remaining cases shouldn't happen in normal usage, but let's print
2228 them anyway for the benefit of the debugger. */
2229 case Lisp_Misc_Free
:
2230 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
2233 case Lisp_Misc_Save_Value
:
2234 strout ("#<save_value ", -1, -1, printcharfun
, 0);
2235 sprintf(buf
, "ptr=0x%08lx int=%d",
2236 (unsigned long) XSAVE_VALUE (obj
)->pointer
,
2237 XSAVE_VALUE (obj
)->integer
);
2238 strout (buf
, -1, -1, printcharfun
, 0);
2250 /* We're in trouble if this happens!
2251 Probably should just abort () */
2252 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
2254 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
2255 else if (VECTORLIKEP (obj
))
2256 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
2258 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
2259 strout (buf
, -1, -1, printcharfun
, 0);
2260 strout (" Save your buffers immediately and please report this bug>",
2261 -1, -1, printcharfun
, 0);
2269 /* Print a description of INTERVAL using PRINTCHARFUN.
2270 This is part of printing a string that has text properties. */
2273 print_interval (INTERVAL interval
, Lisp_Object printcharfun
)
2275 if (NILP (interval
->plist
))
2278 print_object (make_number (interval
->position
), printcharfun
, 1);
2280 print_object (make_number (interval
->position
+ LENGTH (interval
)),
2283 print_object (interval
->plist
, printcharfun
, 1);
2288 syms_of_print (void)
2290 Qtemp_buffer_setup_hook
= intern_c_string ("temp-buffer-setup-hook");
2291 staticpro (&Qtemp_buffer_setup_hook
);
2293 DEFVAR_LISP ("standard-output", &Vstandard_output
,
2294 doc
: /* Output stream `print' uses by default for outputting a character.
2295 This may be any function of one argument.
2296 It may also be a buffer (output is inserted before point)
2297 or a marker (output is inserted and the marker is advanced)
2298 or the symbol t (output appears in the echo area). */);
2299 Vstandard_output
= Qt
;
2300 Qstandard_output
= intern_c_string ("standard-output");
2301 staticpro (&Qstandard_output
);
2303 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
2304 doc
: /* The format descriptor string used to print floats.
2305 This is a %-spec like those accepted by `printf' in C,
2306 but with some restrictions. It must start with the two characters `%.'.
2307 After that comes an integer precision specification,
2308 and then a letter which controls the format.
2309 The letters allowed are `e', `f' and `g'.
2310 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2311 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2312 Use `g' to choose the shorter of those two formats for the number at hand.
2313 The precision in any of these cases is the number of digits following
2314 the decimal point. With `f', a precision of 0 means to omit the
2315 decimal point. 0 is not allowed with `e' or `g'.
2317 A value of nil means to use the shortest notation
2318 that represents the number without losing information. */);
2319 Vfloat_output_format
= Qnil
;
2320 Qfloat_output_format
= intern_c_string ("float-output-format");
2321 staticpro (&Qfloat_output_format
);
2323 DEFVAR_LISP ("print-length", &Vprint_length
,
2324 doc
: /* Maximum length of list to print before abbreviating.
2325 A value of nil means no limit. See also `eval-expression-print-length'. */);
2326 Vprint_length
= Qnil
;
2328 DEFVAR_LISP ("print-level", &Vprint_level
,
2329 doc
: /* Maximum depth of list nesting to print before abbreviating.
2330 A value of nil means no limit. See also `eval-expression-print-level'. */);
2331 Vprint_level
= Qnil
;
2333 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
2334 doc
: /* Non-nil means print newlines in strings as `\\n'.
2335 Also print formfeeds as `\\f'. */);
2336 print_escape_newlines
= 0;
2338 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
2339 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2340 \(OOO is the octal representation of the character code.)
2341 Only single-byte characters are affected, and only in `prin1'.
2342 When the output goes in a multibyte buffer, this feature is
2343 enabled regardless of the value of the variable. */);
2344 print_escape_nonascii
= 0;
2346 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
2347 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2348 \(XXXX is the hex representation of the character code.)
2349 This affects only `prin1'. */);
2350 print_escape_multibyte
= 0;
2352 DEFVAR_BOOL ("print-quoted", &print_quoted
,
2353 doc
: /* Non-nil means print quoted forms with reader syntax.
2354 I.e., (quote foo) prints as 'foo, (function foo) as #'foo. */);
2357 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
2358 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2359 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2360 When the uninterned symbol appears within a recursive data structure,
2361 and the symbol appears more than once, in addition use the #N# and #N=
2362 constructs as needed, so that multiple references to the same symbol are
2363 shared once again when the text is read back. */);
2364 Vprint_gensym
= Qnil
;
2366 DEFVAR_LISP ("print-circle", &Vprint_circle
,
2367 doc
: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2368 If nil, printing proceeds recursively and may lead to
2369 `max-lisp-eval-depth' being exceeded or an error may occur:
2370 \"Apparently circular structure being printed.\" Also see
2371 `print-length' and `print-level'.
2372 If non-nil, shared substructures anywhere in the structure are printed
2373 with `#N=' before the first occurrence (in the order of the print
2374 representation) and `#N#' in place of each subsequent occurrence,
2375 where N is a positive decimal integer. */);
2376 Vprint_circle
= Qnil
;
2378 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
2379 doc
: /* *Non-nil means number continuously across print calls.
2380 This affects the numbers printed for #N= labels and #M# references.
2381 See also `print-circle', `print-gensym', and `print-number-table'.
2382 This variable should not be set with `setq'; bind it with a `let' instead. */);
2383 Vprint_continuous_numbering
= Qnil
;
2385 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
2386 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2387 The Lisp printer uses this vector to detect Lisp objects referenced more
2390 When you bind `print-continuous-numbering' to t, you should probably
2391 also bind `print-number-table' to nil. This ensures that the value of
2392 `print-number-table' can be garbage-collected once the printing is
2393 done. If all elements of `print-number-table' are nil, it means that
2394 the printing done so far has not found any shared structure or objects
2395 that need to be recorded in the table. */);
2396 Vprint_number_table
= Qnil
;
2398 DEFVAR_LISP ("print-charset-text-property", &Vprint_charset_text_property
,
2399 doc
: /* A flag to control printing of `charset' text property on printing a string.
2400 The value must be nil, t, or `default'.
2402 If the value is nil, don't print the text property `charset'.
2404 If the value is t, always print the text property `charset'.
2406 If the value is `default', print the text property `charset' only when
2407 the value is different from what is guessed in the current charset
2409 Vprint_charset_text_property
= Qdefault
;
2411 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2412 staticpro (&Vprin1_to_string_buffer
);
2415 defsubr (&Sprin1_to_string
);
2416 defsubr (&Serror_message_string
);
2420 defsubr (&Swrite_char
);
2421 defsubr (&Sexternal_debugging_output
);
2422 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2423 defsubr (&Sredirect_debugging_output
);
2426 Qexternal_debugging_output
= intern_c_string ("external-debugging-output");
2427 staticpro (&Qexternal_debugging_output
);
2429 Qprint_escape_newlines
= intern_c_string ("print-escape-newlines");
2430 staticpro (&Qprint_escape_newlines
);
2432 Qprint_escape_multibyte
= intern_c_string ("print-escape-multibyte");
2433 staticpro (&Qprint_escape_multibyte
);
2435 Qprint_escape_nonascii
= intern_c_string ("print-escape-nonascii");
2436 staticpro (&Qprint_escape_nonascii
);
2438 print_prune_charset_plist
= Qnil
;
2439 staticpro (&print_prune_charset_plist
);
2441 defsubr (&Swith_output_to_temp_buffer
);
2444 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2445 (do not change this comment) */