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 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/>. */
26 #include "character.h"
32 #include "dispextern.h"
34 #include "intervals.h"
35 #include "blockinput.h"
36 #include "termhooks.h" /* For struct terminal. */
39 Lisp_Object Vstandard_output
, Qstandard_output
;
41 Lisp_Object Qtemp_buffer_setup_hook
;
43 /* These are used to print like we read. */
44 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
46 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
54 /* Default to values appropriate for IEEE floating point. */
59 #define DBL_MANT_DIG 53
65 #define DBL_MIN 2.2250738585072014e-308
68 #ifdef DBL_MIN_REPLACEMENT
70 #define DBL_MIN DBL_MIN_REPLACEMENT
73 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
74 needed to express a float without losing information.
75 The general-case formula is valid for the usual case, IEEE floating point,
76 but many compilers can't optimize the formula to an integer constant,
77 so make a special case for it. */
78 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
79 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
81 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
84 /* Avoid actual stack overflow in print. */
87 /* Level of nesting inside outputting backquote in new style. */
88 int new_backquote_output
;
90 /* Detect most circularities to print finite output. */
91 #define PRINT_CIRCLE 200
92 Lisp_Object being_printed
[PRINT_CIRCLE
];
94 /* When printing into a buffer, first we put the text in this
95 block, then insert it all at once. */
98 /* Size allocated in print_buffer. */
99 int print_buffer_size
;
100 /* Chars stored in print_buffer. */
101 int print_buffer_pos
;
102 /* Bytes stored in print_buffer. */
103 int print_buffer_pos_byte
;
105 /* Maximum length of list to print in full; noninteger means
106 effectively infinity */
108 Lisp_Object Vprint_length
;
110 /* Maximum depth of list to print in full; noninteger means
111 effectively infinity. */
113 Lisp_Object Vprint_level
;
115 /* Nonzero means print newlines in strings as \n. */
117 int print_escape_newlines
;
119 /* Nonzero means to print single-byte non-ascii characters in strings as
122 int print_escape_nonascii
;
124 /* Nonzero means to print multibyte characters in strings as hex escapes. */
126 int print_escape_multibyte
;
128 Lisp_Object Qprint_escape_newlines
;
129 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
131 /* Nonzero means print (quote foo) forms as 'foo, etc. */
135 /* Non-nil means print #: before uninterned symbols. */
137 Lisp_Object Vprint_gensym
;
139 /* Non-nil means print recursive structures using #n= and #n# syntax. */
141 Lisp_Object Vprint_circle
;
143 /* Non-nil means keep continuous number for #n= and #n# syntax
144 between several print functions. */
146 Lisp_Object Vprint_continuous_numbering
;
148 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
149 where OBJn are objects going to be printed, and STATn are their status,
150 which may be different meanings during process. See the comments of
151 the functions print and print_preprocess for details.
152 print_number_index keeps the last position the next object should be added,
153 twice of which is the actual vector position in Vprint_number_table. */
154 int print_number_index
;
155 Lisp_Object Vprint_number_table
;
157 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
158 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
159 See the comment of the variable Vprint_number_table. */
160 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
161 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
163 /* Nonzero means print newline to stdout before next minibuffer message.
164 Defined in xdisp.c */
166 extern int noninteractive_need_newline
;
168 extern int minibuffer_auto_raise
;
170 #ifdef MAX_PRINT_CHARS
171 static int print_chars
;
172 static int max_print
;
173 #endif /* MAX_PRINT_CHARS */
175 void print_interval ();
177 /* GDB resets this to zero on W32 to disable OutputDebugString calls. */
178 int print_output_debug_flag
= 1;
181 /* Low level output routines for characters and strings */
183 /* Lisp functions to do output using a stream
184 must have the stream in a variable called printcharfun
185 and must start with PRINTPREPARE, end with PRINTFINISH,
186 and use PRINTDECLARE to declare common variables.
187 Use PRINTCHAR to output one character,
188 or call strout to output a block of characters. */
190 #define PRINTDECLARE \
191 struct buffer *old = current_buffer; \
192 int old_point = -1, start_point = -1; \
193 int old_point_byte = -1, start_point_byte = -1; \
194 int specpdl_count = SPECPDL_INDEX (); \
195 int free_print_buffer = 0; \
196 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
199 #define PRINTPREPARE \
200 original = printcharfun; \
201 if (NILP (printcharfun)) printcharfun = Qt; \
202 if (BUFFERP (printcharfun)) \
204 if (XBUFFER (printcharfun) != current_buffer) \
205 Fset_buffer (printcharfun); \
206 printcharfun = Qnil; \
208 if (MARKERP (printcharfun)) \
210 EMACS_INT marker_pos; \
211 if (! XMARKER (printcharfun)->buffer) \
212 error ("Marker does not point anywhere"); \
213 if (XMARKER (printcharfun)->buffer != current_buffer) \
214 set_buffer_internal (XMARKER (printcharfun)->buffer); \
215 marker_pos = marker_position (printcharfun); \
216 if (marker_pos < BEGV || marker_pos > ZV) \
217 error ("Marker is outside the accessible part of the buffer"); \
219 old_point_byte = PT_BYTE; \
220 SET_PT_BOTH (marker_pos, \
221 marker_byte_position (printcharfun)); \
223 start_point_byte = PT_BYTE; \
224 printcharfun = Qnil; \
226 if (NILP (printcharfun)) \
228 Lisp_Object string; \
229 if (NILP (current_buffer->enable_multibyte_characters) \
230 && ! print_escape_multibyte) \
231 specbind (Qprint_escape_multibyte, Qt); \
232 if (! NILP (current_buffer->enable_multibyte_characters) \
233 && ! print_escape_nonascii) \
234 specbind (Qprint_escape_nonascii, Qt); \
235 if (print_buffer != 0) \
237 string = make_string_from_bytes (print_buffer, \
239 print_buffer_pos_byte); \
240 record_unwind_protect (print_unwind, string); \
244 print_buffer_size = 1000; \
245 print_buffer = (char *) xmalloc (print_buffer_size); \
246 free_print_buffer = 1; \
248 print_buffer_pos = 0; \
249 print_buffer_pos_byte = 0; \
251 if (EQ (printcharfun, Qt) && ! noninteractive) \
252 setup_echo_area_for_printing (multibyte);
254 #define PRINTFINISH \
255 if (NILP (printcharfun)) \
257 if (print_buffer_pos != print_buffer_pos_byte \
258 && NILP (current_buffer->enable_multibyte_characters)) \
260 unsigned char *temp \
261 = (unsigned char *) alloca (print_buffer_pos + 1); \
262 copy_text (print_buffer, temp, print_buffer_pos_byte, \
264 insert_1_both (temp, print_buffer_pos, \
265 print_buffer_pos, 0, 1, 0); \
268 insert_1_both (print_buffer, print_buffer_pos, \
269 print_buffer_pos_byte, 0, 1, 0); \
270 signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
272 if (free_print_buffer) \
274 xfree (print_buffer); \
277 unbind_to (specpdl_count, Qnil); \
278 if (MARKERP (original)) \
279 set_marker_both (original, Qnil, PT, PT_BYTE); \
280 if (old_point >= 0) \
281 SET_PT_BOTH (old_point + (old_point >= start_point \
282 ? PT - start_point : 0), \
283 old_point_byte + (old_point_byte >= start_point_byte \
284 ? PT_BYTE - start_point_byte : 0)); \
285 if (old != current_buffer) \
286 set_buffer_internal (old);
288 #define PRINTCHAR(ch) printchar (ch, printcharfun)
290 /* This is used to restore the saved contents of print_buffer
291 when there is a recursive call to print. */
294 print_unwind (saved_text
)
295 Lisp_Object saved_text
;
297 bcopy (SDATA (saved_text
), print_buffer
, SCHARS (saved_text
));
302 /* Print character CH using method FUN. FUN nil means print to
303 print_buffer. FUN t means print to echo area or stdout if
304 non-interactive. If FUN is neither nil nor t, call FUN with CH as
312 #ifdef MAX_PRINT_CHARS
315 #endif /* MAX_PRINT_CHARS */
317 if (!NILP (fun
) && !EQ (fun
, Qt
))
318 call1 (fun
, make_number (ch
));
321 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
322 int len
= CHAR_STRING (ch
, str
);
328 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
329 print_buffer
= (char *) xrealloc (print_buffer
,
330 print_buffer_size
*= 2);
331 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
332 print_buffer_pos
+= 1;
333 print_buffer_pos_byte
+= len
;
335 else if (noninteractive
)
337 fwrite (str
, 1, len
, stdout
);
338 noninteractive_need_newline
= 1;
343 = !NILP (current_buffer
->enable_multibyte_characters
);
345 setup_echo_area_for_printing (multibyte_p
);
347 message_dolog (str
, len
, 0, multibyte_p
);
353 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
354 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
355 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
356 print_buffer. PRINTCHARFUN t means output to the echo area or to
357 stdout if non-interactive. If neither nil nor t, call Lisp
358 function PRINTCHARFUN for each character printed. MULTIBYTE
359 non-zero means PTR contains multibyte characters.
361 In the case where PRINTCHARFUN is nil, it is safe for PTR to point
362 to data in a Lisp string. Otherwise that is not safe. */
365 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
368 Lisp_Object printcharfun
;
372 size_byte
= size
= strlen (ptr
);
374 if (NILP (printcharfun
))
376 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
378 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
379 print_buffer
= (char *) xrealloc (print_buffer
,
382 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
383 print_buffer_pos
+= size
;
384 print_buffer_pos_byte
+= size_byte
;
386 #ifdef MAX_PRINT_CHARS
389 #endif /* MAX_PRINT_CHARS */
391 else if (noninteractive
&& EQ (printcharfun
, Qt
))
393 fwrite (ptr
, 1, size_byte
, stdout
);
394 noninteractive_need_newline
= 1;
396 else if (EQ (printcharfun
, Qt
))
398 /* Output to echo area. We're trying to avoid a little overhead
399 here, that's the reason we don't call printchar to do the
403 = !NILP (current_buffer
->enable_multibyte_characters
);
405 setup_echo_area_for_printing (multibyte_p
);
406 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
408 if (size
== size_byte
)
410 for (i
= 0; i
< size
; ++i
)
411 insert_char ((unsigned char) *ptr
++);
416 for (i
= 0; i
< size_byte
; i
+= len
)
418 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
423 #ifdef MAX_PRINT_CHARS
426 #endif /* MAX_PRINT_CHARS */
430 /* PRINTCHARFUN is a Lisp function. */
433 if (size
== size_byte
)
435 while (i
< size_byte
)
443 while (i
< size_byte
)
445 /* Here, we must convert each multi-byte form to the
446 corresponding character code before handing it to
449 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
457 /* Print the contents of a string STRING using PRINTCHARFUN.
458 It isn't safe to use strout in many cases,
459 because printing one char can relocate. */
462 print_string (string
, printcharfun
)
464 Lisp_Object printcharfun
;
466 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
470 if (print_escape_nonascii
)
471 string
= string_escape_byte8 (string
);
473 if (STRING_MULTIBYTE (string
))
474 chars
= SCHARS (string
);
475 else if (! print_escape_nonascii
476 && (EQ (printcharfun
, Qt
)
477 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
478 : ! NILP (current_buffer
->enable_multibyte_characters
)))
480 /* If unibyte string STRING contains 8-bit codes, we must
481 convert STRING to a multibyte string containing the same
486 chars
= SBYTES (string
);
487 bytes
= parse_str_to_multibyte (SDATA (string
), chars
);
490 newstr
= make_uninit_multibyte_string (chars
, bytes
);
491 bcopy (SDATA (string
), SDATA (newstr
), chars
);
492 str_to_multibyte (SDATA (newstr
), bytes
, chars
);
497 chars
= SBYTES (string
);
499 if (EQ (printcharfun
, Qt
))
501 /* Output to echo area. */
502 int nbytes
= SBYTES (string
);
505 /* Copy the string contents so that relocation of STRING by
506 GC does not cause trouble. */
509 SAFE_ALLOCA (buffer
, char *, nbytes
);
510 bcopy (SDATA (string
), buffer
, nbytes
);
512 strout (buffer
, chars
, SBYTES (string
),
513 printcharfun
, STRING_MULTIBYTE (string
));
518 /* No need to copy, since output to print_buffer can't GC. */
519 strout (SDATA (string
),
520 chars
, SBYTES (string
),
521 printcharfun
, STRING_MULTIBYTE (string
));
525 /* Otherwise, string may be relocated by printing one char.
526 So re-fetch the string address for each character. */
528 int size
= SCHARS (string
);
529 int size_byte
= SBYTES (string
);
532 if (size
== size_byte
)
533 for (i
= 0; i
< size
; i
++)
534 PRINTCHAR (SREF (string
, i
));
536 for (i
= 0; i
< size_byte
; )
538 /* Here, we must convert each multi-byte form to the
539 corresponding character code before handing it to PRINTCHAR. */
541 int ch
= STRING_CHAR_AND_LENGTH (SDATA (string
) + i
,
550 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
551 doc
: /* Output character CHARACTER to stream PRINTCHARFUN.
552 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
553 (character
, printcharfun
)
554 Lisp_Object character
, printcharfun
;
558 if (NILP (printcharfun
))
559 printcharfun
= Vstandard_output
;
560 CHECK_NUMBER (character
);
562 PRINTCHAR (XINT (character
));
567 /* Used from outside of print.c to print a block of SIZE
568 single-byte chars at DATA on the default output stream.
569 Do not use this on the contents of a Lisp string. */
572 write_string (data
, size
)
577 Lisp_Object printcharfun
;
579 printcharfun
= Vstandard_output
;
582 strout (data
, size
, size
, printcharfun
, 0);
586 /* Used from outside of print.c to print a block of SIZE
587 single-byte chars at DATA on a specified stream PRINTCHARFUN.
588 Do not use this on the contents of a Lisp string. */
591 write_string_1 (data
, size
, printcharfun
)
594 Lisp_Object printcharfun
;
599 strout (data
, size
, size
, printcharfun
, 0);
605 temp_output_buffer_setup (bufname
)
608 int count
= SPECPDL_INDEX ();
609 register struct buffer
*old
= current_buffer
;
610 register Lisp_Object buf
;
612 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
614 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
616 Fkill_all_local_variables ();
617 delete_all_overlays (current_buffer
);
618 current_buffer
->directory
= old
->directory
;
619 current_buffer
->read_only
= Qnil
;
620 current_buffer
->filename
= Qnil
;
621 current_buffer
->undo_list
= Qt
;
622 eassert (current_buffer
->overlays_before
== NULL
);
623 eassert (current_buffer
->overlays_after
== NULL
);
624 current_buffer
->enable_multibyte_characters
625 = buffer_defaults
.enable_multibyte_characters
;
626 specbind (Qinhibit_read_only
, Qt
);
627 specbind (Qinhibit_modification_hooks
, Qt
);
629 XSETBUFFER (buf
, current_buffer
);
631 Frun_hooks (1, &Qtemp_buffer_setup_hook
);
633 unbind_to (count
, Qnil
);
635 specbind (Qstandard_output
, buf
);
639 internal_with_output_to_temp_buffer (bufname
, function
, args
)
641 Lisp_Object (*function
) P_ ((Lisp_Object
));
644 int count
= SPECPDL_INDEX ();
645 Lisp_Object buf
, val
;
649 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
650 temp_output_buffer_setup (bufname
);
651 buf
= Vstandard_output
;
654 val
= (*function
) (args
);
657 temp_output_buffer_show (buf
);
660 return unbind_to (count
, val
);
663 DEFUN ("with-output-to-temp-buffer",
664 Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
666 doc
: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
668 This construct makes buffer BUFNAME empty before running BODY.
669 It does not make the buffer current for BODY.
670 Instead it binds `standard-output' to that buffer, so that output
671 generated with `prin1' and similar functions in BODY goes into
674 At the end of BODY, this marks buffer BUFNAME unmodifed and displays
675 it in a window, but does not select it. The normal way to do this is
676 by calling `display-buffer', then running `temp-buffer-show-hook'.
677 However, if `temp-buffer-show-function' is non-nil, it calls that
678 function instead (and does not run `temp-buffer-show-hook'). The
679 function gets one argument, the buffer to display.
681 The return value of `with-output-to-temp-buffer' is the value of the
682 last form in BODY. If BODY does not finish normally, the buffer
683 BUFNAME is not displayed.
685 This runs the hook `temp-buffer-setup-hook' before BODY,
686 with the buffer BUFNAME temporarily current. It runs the hook
687 `temp-buffer-show-hook' after displaying buffer BUFNAME, with that
688 buffer temporarily current, and the window that was used to display it
689 temporarily selected. But it doesn't run `temp-buffer-show-hook'
690 if it uses `temp-buffer-show-function'.
692 usage: (with-output-to-temp-buffer BUFNAME BODY...) */)
698 int count
= SPECPDL_INDEX ();
699 Lisp_Object buf
, val
;
702 name
= Feval (Fcar (args
));
704 temp_output_buffer_setup (SDATA (name
));
705 buf
= Vstandard_output
;
708 val
= Fprogn (XCDR (args
));
711 temp_output_buffer_show (buf
);
714 return unbind_to (count
, val
);
718 static void print ();
719 static void print_preprocess ();
720 static void print_preprocess_string ();
721 static void print_object ();
723 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
724 doc
: /* Output a newline to stream PRINTCHARFUN.
725 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
727 Lisp_Object printcharfun
;
731 if (NILP (printcharfun
))
732 printcharfun
= Vstandard_output
;
739 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
740 doc
: /* Output the printed representation of OBJECT, any Lisp object.
741 Quoting characters are printed when needed to make output that `read'
742 can handle, whenever this is possible. For complex objects, the behavior
743 is controlled by `print-level' and `print-length', which see.
745 OBJECT is any of the Lisp data types: a number, a string, a symbol,
746 a list, a buffer, a window, a frame, etc.
748 A printed representation of an object is text which describes that object.
750 Optional argument PRINTCHARFUN is the output stream, which can be one
753 - a buffer, in which case output is inserted into that buffer at point;
754 - a marker, in which case output is inserted at marker's position;
755 - a function, in which case that function is called once for each
756 character of OBJECT's printed representation;
757 - a symbol, in which case that symbol's function definition is called; or
758 - t, in which case the output is displayed in the echo area.
760 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
762 (object
, printcharfun
)
763 Lisp_Object object
, printcharfun
;
767 #ifdef MAX_PRINT_CHARS
769 #endif /* MAX_PRINT_CHARS */
770 if (NILP (printcharfun
))
771 printcharfun
= Vstandard_output
;
773 print (object
, printcharfun
, 1);
778 /* a buffer which is used to hold output being built by prin1-to-string */
779 Lisp_Object Vprin1_to_string_buffer
;
781 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
782 doc
: /* Return a string containing the printed representation of OBJECT.
783 OBJECT can be any Lisp object. This function outputs quoting characters
784 when necessary to make output that `read' can handle, whenever possible,
785 unless the optional second argument NOESCAPE is non-nil. For complex objects,
786 the behavior is controlled by `print-level' and `print-length', which see.
788 OBJECT is any of the Lisp data types: a number, a string, a symbol,
789 a list, a buffer, a window, a frame, etc.
791 A printed representation of an object is text which describes that object. */)
793 Lisp_Object object
, noescape
;
795 Lisp_Object printcharfun
;
796 /* struct gcpro gcpro1, gcpro2; */
797 Lisp_Object save_deactivate_mark
;
798 int count
= SPECPDL_INDEX ();
799 struct buffer
*previous
;
801 specbind (Qinhibit_modification_hooks
, Qt
);
806 /* Save and restore this--we are altering a buffer
807 but we don't want to deactivate the mark just for that.
808 No need for specbind, since errors deactivate the mark. */
809 save_deactivate_mark
= Vdeactivate_mark
;
810 /* GCPRO2 (object, save_deactivate_mark); */
813 printcharfun
= Vprin1_to_string_buffer
;
815 print (object
, printcharfun
, NILP (noescape
));
816 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
820 previous
= current_buffer
;
821 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
822 object
= Fbuffer_string ();
823 if (SBYTES (object
) == SCHARS (object
))
824 STRING_SET_UNIBYTE (object
);
826 /* Note that this won't make prepare_to_modify_buffer call
827 ask-user-about-supersession-threat because this buffer
828 does not visit a file. */
830 set_buffer_internal (previous
);
832 Vdeactivate_mark
= save_deactivate_mark
;
836 return unbind_to (count
, object
);
839 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
840 doc
: /* Output the printed representation of OBJECT, any Lisp object.
841 No quoting characters are used; no delimiters are printed around
842 the contents of strings.
844 OBJECT is any of the Lisp data types: a number, a string, a symbol,
845 a list, a buffer, a window, a frame, etc.
847 A printed representation of an object is text which describes that object.
849 Optional argument PRINTCHARFUN is the output stream, which can be one
852 - a buffer, in which case output is inserted into that buffer at point;
853 - a marker, in which case output is inserted at marker's position;
854 - a function, in which case that function is called once for each
855 character of OBJECT's printed representation;
856 - a symbol, in which case that symbol's function definition is called; or
857 - t, in which case the output is displayed in the echo area.
859 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
861 (object
, printcharfun
)
862 Lisp_Object object
, printcharfun
;
866 if (NILP (printcharfun
))
867 printcharfun
= Vstandard_output
;
869 print (object
, printcharfun
, 0);
874 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
875 doc
: /* Output the printed representation of OBJECT, with newlines around it.
876 Quoting characters are printed when needed to make output that `read'
877 can handle, whenever this is possible. For complex objects, the behavior
878 is controlled by `print-level' and `print-length', which see.
880 OBJECT is any of the Lisp data types: a number, a string, a symbol,
881 a list, a buffer, a window, a frame, etc.
883 A printed representation of an object is text which describes that object.
885 Optional argument PRINTCHARFUN is the output stream, which can be one
888 - a buffer, in which case output is inserted into that buffer at point;
889 - a marker, in which case output is inserted at marker's position;
890 - a function, in which case that function is called once for each
891 character of OBJECT's printed representation;
892 - a symbol, in which case that symbol's function definition is called; or
893 - t, in which case the output is displayed in the echo area.
895 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
897 (object
, printcharfun
)
898 Lisp_Object object
, printcharfun
;
903 #ifdef MAX_PRINT_CHARS
905 max_print
= MAX_PRINT_CHARS
;
906 #endif /* MAX_PRINT_CHARS */
907 if (NILP (printcharfun
))
908 printcharfun
= Vstandard_output
;
912 print (object
, printcharfun
, 1);
915 #ifdef MAX_PRINT_CHARS
918 #endif /* MAX_PRINT_CHARS */
923 /* The subroutine object for external-debugging-output is kept here
924 for the convenience of the debugger. */
925 Lisp_Object Qexternal_debugging_output
;
927 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
928 doc
: /* Write CHARACTER to stderr.
929 You can call print while debugging emacs, and pass it this function
930 to make it write to the debugging output. */)
932 Lisp_Object character
;
934 CHECK_NUMBER (character
);
935 putc (XINT (character
), stderr
);
938 /* Send the output to a debugger (nothing happens if there isn't one). */
939 if (print_output_debug_flag
)
941 char buf
[2] = {(char) XINT (character
), '\0'};
942 OutputDebugString (buf
);
949 /* This function is never called. Its purpose is to prevent
950 print_output_debug_flag from being optimized away. */
953 debug_output_compilation_hack (x
)
956 print_output_debug_flag
= x
;
959 #if defined (GNU_LINUX)
961 /* This functionality is not vitally important in general, so we rely on
962 non-portable ability to use stderr as lvalue. */
964 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
966 FILE *initial_stderr_stream
= NULL
;
968 DEFUN ("redirect-debugging-output", Fredirect_debugging_output
, Sredirect_debugging_output
,
970 "FDebug output file: \nP",
971 doc
: /* Redirect debugging output (stderr stream) to file FILE.
972 If FILE is nil, reset target to the initial stderr stream.
973 Optional arg APPEND non-nil (interactively, with prefix arg) means
974 append to existing target file. */)
976 Lisp_Object file
, append
;
978 if (initial_stderr_stream
!= NULL
)
984 stderr
= initial_stderr_stream
;
985 initial_stderr_stream
= NULL
;
989 file
= Fexpand_file_name (file
, Qnil
);
990 initial_stderr_stream
= stderr
;
991 stderr
= fopen (SDATA (file
), NILP (append
) ? "w" : "a");
994 stderr
= initial_stderr_stream
;
995 initial_stderr_stream
= NULL
;
996 report_file_error ("Cannot open debugging output stream",
1002 #endif /* GNU_LINUX */
1005 /* This is the interface for debugging printing. */
1011 Fprin1 (arg
, Qexternal_debugging_output
);
1012 fprintf (stderr
, "\r\n");
1016 safe_debug_print (arg
)
1019 int valid
= valid_lisp_object_p (arg
);
1024 fprintf (stderr
, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
1025 !valid
? "INVALID" : "SOME",
1026 (unsigned long) XHASH (arg
)
1031 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
1033 doc
: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
1034 See Info anchor `(elisp)Definition of signal' for some details on how this
1035 error message is constructed. */)
1039 struct buffer
*old
= current_buffer
;
1041 struct gcpro gcpro1
;
1043 /* If OBJ is (error STRING), just return STRING.
1044 That is not only faster, it also avoids the need to allocate
1045 space here when the error is due to memory full. */
1046 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
1047 && CONSP (XCDR (obj
))
1048 && STRINGP (XCAR (XCDR (obj
)))
1049 && NILP (XCDR (XCDR (obj
))))
1050 return XCAR (XCDR (obj
));
1052 print_error_message (obj
, Vprin1_to_string_buffer
, 0, Qnil
);
1054 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
1055 value
= Fbuffer_string ();
1059 set_buffer_internal (old
);
1065 /* Print an error message for the error DATA onto Lisp output stream
1066 STREAM (suitable for the print functions).
1067 CONTEXT is a C string describing the context of the error.
1068 CALLER is the Lisp function inside which the error was signaled. */
1071 print_error_message (data
, stream
, context
, caller
)
1072 Lisp_Object data
, stream
;
1076 Lisp_Object errname
, errmsg
, file_error
, tail
;
1077 struct gcpro gcpro1
;
1081 write_string_1 (context
, -1, stream
);
1083 /* If we know from where the error was signaled, show it in
1085 if (!NILP (caller
) && SYMBOLP (caller
))
1087 Lisp_Object cname
= SYMBOL_NAME (caller
);
1088 char *name
= alloca (SBYTES (cname
));
1089 bcopy (SDATA (cname
), name
, SBYTES (cname
));
1090 message_dolog (name
, SBYTES (cname
), 0, 0);
1091 message_dolog (": ", 2, 0, 0);
1094 errname
= Fcar (data
);
1096 if (EQ (errname
, Qerror
))
1101 errmsg
= Fcar (data
);
1106 Lisp_Object error_conditions
;
1107 errmsg
= Fget (errname
, Qerror_message
);
1108 error_conditions
= Fget (errname
, Qerror_conditions
);
1109 file_error
= Fmemq (Qfile_error
, error_conditions
);
1112 /* Print an error message including the data items. */
1114 tail
= Fcdr_safe (data
);
1117 /* For file-error, make error message by concatenating
1118 all the data items. They are all strings. */
1119 if (!NILP (file_error
) && CONSP (tail
))
1120 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
1122 if (STRINGP (errmsg
))
1123 Fprinc (errmsg
, stream
);
1125 write_string_1 ("peculiar error", -1, stream
);
1127 for (i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
1131 write_string_1 (i
? ", " : ": ", 2, stream
);
1133 if (!NILP (file_error
) || EQ (errname
, Qend_of_file
))
1134 Fprinc (obj
, stream
);
1136 Fprin1 (obj
, stream
);
1145 * The buffer should be at least as large as the max string size of the
1146 * largest float, printed in the biggest notation. This is undoubtedly
1147 * 20d float_output_format, with the negative of the C-constant "HUGE"
1150 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1152 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1153 * case of -1e307 in 20d float_output_format. What is one to do (short of
1154 * re-writing _doprnt to be more sane)?
1159 float_to_string (buf
, data
)
1166 /* Check for plus infinity in a way that won't lose
1167 if there is no plus infinity. */
1168 if (data
== data
/ 2 && data
> 1.0)
1170 strcpy (buf
, "1.0e+INF");
1173 /* Likewise for minus infinity. */
1174 if (data
== data
/ 2 && data
< -1.0)
1176 strcpy (buf
, "-1.0e+INF");
1179 /* Check for NaN in a way that won't fail if there are no NaNs. */
1180 if (! (data
* 0.0 >= 0.0))
1182 /* Prepend "-" if the NaN's sign bit is negative.
1183 The sign bit of a double is the bit that is 1 in -0.0. */
1185 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
1187 u_minus_zero
.d
= - 0.0;
1188 for (i
= 0; i
< sizeof (double); i
++)
1189 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1195 strcpy (buf
, "0.0e+NaN");
1199 if (NILP (Vfloat_output_format
)
1200 || !STRINGP (Vfloat_output_format
))
1203 /* Generate the fewest number of digits that represent the
1204 floating point value without losing information.
1205 The following method is simple but a bit slow.
1206 For ideas about speeding things up, please see:
1208 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1209 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1211 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1212 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1214 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1216 sprintf (buf
, "%.*g", width
, data
);
1217 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1219 else /* oink oink */
1221 /* Check that the spec we have is fully valid.
1222 This means not only valid for printf,
1223 but meant for floats, and reasonable. */
1224 cp
= SDATA (Vfloat_output_format
);
1233 /* Check the width specification. */
1235 if ('0' <= *cp
&& *cp
<= '9')
1239 width
= (width
* 10) + (*cp
++ - '0');
1240 while (*cp
>= '0' && *cp
<= '9');
1242 /* A precision of zero is valid only for %f. */
1244 || (width
== 0 && *cp
!= 'f'))
1248 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1254 sprintf (buf
, SDATA (Vfloat_output_format
), data
);
1257 /* Make sure there is a decimal point with digit after, or an
1258 exponent, so that the value is readable as a float. But don't do
1259 this with "%.0f"; it's valid for that not to produce a decimal
1260 point. Note that width can be 0 only for %.0f. */
1263 for (cp
= buf
; *cp
; cp
++)
1264 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1267 if (*cp
== '.' && cp
[1] == 0)
1284 print (obj
, printcharfun
, escapeflag
)
1286 register Lisp_Object printcharfun
;
1289 new_backquote_output
= 0;
1291 /* Reset print_number_index and Vprint_number_table only when
1292 the variable Vprint_continuous_numbering is nil. Otherwise,
1293 the values of these variables will be kept between several
1295 if (NILP (Vprint_continuous_numbering
)
1296 || NILP (Vprint_number_table
))
1298 print_number_index
= 0;
1299 Vprint_number_table
= Qnil
;
1302 /* Construct Vprint_number_table for print-gensym and print-circle. */
1303 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1305 int i
, start
, index
;
1306 start
= index
= print_number_index
;
1307 /* Construct Vprint_number_table.
1308 This increments print_number_index for the objects added. */
1310 print_preprocess (obj
);
1312 /* Remove unnecessary objects, which appear only once in OBJ;
1313 that is, whose status is Qnil. Compactify the necessary objects. */
1314 for (i
= start
; i
< print_number_index
; i
++)
1315 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1317 PRINT_NUMBER_OBJECT (Vprint_number_table
, index
)
1318 = PRINT_NUMBER_OBJECT (Vprint_number_table
, i
);
1322 /* Clear out objects outside the active part of the table. */
1323 for (i
= index
; i
< print_number_index
; i
++)
1324 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
) = Qnil
;
1326 /* Reset the status field for the next print step. Now this
1327 field means whether the object has already been printed. */
1328 for (i
= start
; i
< print_number_index
; i
++)
1329 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qnil
;
1331 print_number_index
= index
;
1335 print_object (obj
, printcharfun
, escapeflag
);
1338 /* Construct Vprint_number_table according to the structure of OBJ.
1339 OBJ itself and all its elements will be added to Vprint_number_table
1340 recursively if it is a list, vector, compiled function, char-table,
1341 string (its text properties will be traced), or a symbol that has
1342 no obarray (this is for the print-gensym feature).
1343 The status fields of Vprint_number_table mean whether each object appears
1344 more than once in OBJ: Qnil at the first time, and Qt after that . */
1346 print_preprocess (obj
)
1352 Lisp_Object halftail
;
1354 /* Give up if we go so deep that print_object will get an error. */
1355 /* See similar code in print_object. */
1356 if (print_depth
>= PRINT_CIRCLE
)
1357 error ("Apparently circular structure being printed");
1359 /* Avoid infinite recursion for circular nested structure
1360 in the case where Vprint_circle is nil. */
1361 if (NILP (Vprint_circle
))
1363 for (i
= 0; i
< print_depth
; i
++)
1364 if (EQ (obj
, being_printed
[i
]))
1366 being_printed
[print_depth
] = obj
;
1373 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1374 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
)
1375 || (! NILP (Vprint_gensym
)
1377 && !SYMBOL_INTERNED_P (obj
)))
1379 /* In case print-circle is nil and print-gensym is t,
1380 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1381 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1383 for (i
= 0; i
< print_number_index
; i
++)
1384 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1386 /* OBJ appears more than once. Let's remember that. */
1387 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1392 /* OBJ is not yet recorded. Let's add to the table. */
1393 if (print_number_index
== 0)
1395 /* Initialize the table. */
1396 Vprint_number_table
= Fmake_vector (make_number (40), Qnil
);
1398 else if (XVECTOR (Vprint_number_table
)->size
== print_number_index
* 2)
1400 /* Reallocate the table. */
1401 int i
= print_number_index
* 4;
1402 Lisp_Object old_table
= Vprint_number_table
;
1403 Vprint_number_table
= Fmake_vector (make_number (i
), Qnil
);
1404 for (i
= 0; i
< print_number_index
; i
++)
1406 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
)
1407 = PRINT_NUMBER_OBJECT (old_table
, i
);
1408 PRINT_NUMBER_STATUS (Vprint_number_table
, i
)
1409 = PRINT_NUMBER_STATUS (old_table
, i
);
1412 PRINT_NUMBER_OBJECT (Vprint_number_table
, print_number_index
) = obj
;
1413 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1414 always print the gensym with a number. This is a special for
1415 the lisp function byte-compile-output-docform. */
1416 if (!NILP (Vprint_continuous_numbering
)
1418 && !SYMBOL_INTERNED_P (obj
))
1419 PRINT_NUMBER_STATUS (Vprint_number_table
, print_number_index
) = Qt
;
1420 print_number_index
++;
1423 switch (XTYPE (obj
))
1426 /* A string may have text properties, which can be circular. */
1427 traverse_intervals_noorder (STRING_INTERVALS (obj
),
1428 print_preprocess_string
, Qnil
);
1432 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1433 just as in print_object. */
1434 if (loop_count
&& EQ (obj
, halftail
))
1436 print_preprocess (XCAR (obj
));
1439 if (!(loop_count
& 1))
1440 halftail
= XCDR (halftail
);
1443 case Lisp_Vectorlike
:
1444 size
= XVECTOR (obj
)->size
;
1445 if (size
& PSEUDOVECTOR_FLAG
)
1446 size
&= PSEUDOVECTOR_SIZE_MASK
;
1447 for (i
= 0; i
< size
; i
++)
1448 print_preprocess (XVECTOR (obj
)->contents
[i
]);
1459 print_preprocess_string (interval
, arg
)
1463 print_preprocess (interval
->plist
);
1466 /* A flag to control printing of `charset' text property.
1467 The default value is Qdefault. */
1468 Lisp_Object Vprint_charset_text_property
;
1469 extern Lisp_Object Qdefault
;
1471 static void print_check_string_charset_prop ();
1473 #define PRINT_STRING_NON_CHARSET_FOUND 1
1474 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
1476 /* Bitwize or of the abobe macros. */
1477 static int print_check_string_result
;
1480 print_check_string_charset_prop (interval
, string
)
1486 if (NILP (interval
->plist
)
1487 || (print_check_string_result
== (PRINT_STRING_NON_CHARSET_FOUND
1488 | PRINT_STRING_UNSAFE_CHARSET_FOUND
)))
1490 for (val
= interval
->plist
; CONSP (val
) && ! EQ (XCAR (val
), Qcharset
);
1491 val
= XCDR (XCDR (val
)));
1494 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1497 if (! (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
))
1499 if (! EQ (val
, interval
->plist
)
1500 || CONSP (XCDR (XCDR (val
))))
1501 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1503 if (NILP (Vprint_charset_text_property
)
1504 || ! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1507 int charpos
= interval
->position
;
1508 int bytepos
= string_char_to_byte (string
, charpos
);
1509 Lisp_Object charset
;
1511 charset
= XCAR (XCDR (val
));
1512 for (i
= 0; i
< LENGTH (interval
); i
++)
1514 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1515 if (! ASCII_CHAR_P (c
)
1516 && ! EQ (CHARSET_NAME (CHAR_CHARSET (c
)), charset
))
1518 print_check_string_result
|= PRINT_STRING_UNSAFE_CHARSET_FOUND
;
1525 /* The value is (charset . nil). */
1526 static Lisp_Object print_prune_charset_plist
;
1529 print_prune_string_charset (string
)
1532 print_check_string_result
= 0;
1533 traverse_intervals (STRING_INTERVALS (string
), 0,
1534 print_check_string_charset_prop
, string
);
1535 if (! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1537 string
= Fcopy_sequence (string
);
1538 if (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
)
1540 if (NILP (print_prune_charset_plist
))
1541 print_prune_charset_plist
= Fcons (Qcharset
, Qnil
);
1542 Fremove_text_properties (make_number (0),
1543 make_number (SCHARS (string
)),
1544 print_prune_charset_plist
, string
);
1547 Fset_text_properties (make_number (0), make_number (SCHARS (string
)),
1554 print_object (obj
, printcharfun
, escapeflag
)
1556 register Lisp_Object printcharfun
;
1563 /* Detect circularities and truncate them. */
1564 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1565 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
)
1566 || (! NILP (Vprint_gensym
)
1568 && !SYMBOL_INTERNED_P (obj
)))
1570 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1572 /* Simple but incomplete way. */
1574 for (i
= 0; i
< print_depth
; i
++)
1575 if (EQ (obj
, being_printed
[i
]))
1577 sprintf (buf
, "#%d", i
);
1578 strout (buf
, -1, -1, printcharfun
, 0);
1581 being_printed
[print_depth
] = obj
;
1585 /* With the print-circle feature. */
1587 for (i
= 0; i
< print_number_index
; i
++)
1588 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1590 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1592 /* Add a prefix #n= if OBJ has not yet been printed;
1593 that is, its status field is nil. */
1594 sprintf (buf
, "#%d=", i
+ 1);
1595 strout (buf
, -1, -1, printcharfun
, 0);
1596 /* OBJ is going to be printed. Set the status to t. */
1597 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1602 /* Just print #n# if OBJ has already been printed. */
1603 sprintf (buf
, "#%d#", i
+ 1);
1604 strout (buf
, -1, -1, printcharfun
, 0);
1613 /* See similar code in print_preprocess. */
1614 if (print_depth
> PRINT_CIRCLE
)
1615 error ("Apparently circular structure being printed");
1616 #ifdef MAX_PRINT_CHARS
1617 if (max_print
&& print_chars
> max_print
)
1622 #endif /* MAX_PRINT_CHARS */
1624 switch (XTYPE (obj
))
1627 if (sizeof (int) == sizeof (EMACS_INT
))
1628 sprintf (buf
, "%d", (int) XINT (obj
));
1629 else if (sizeof (long) == sizeof (EMACS_INT
))
1630 sprintf (buf
, "%ld", (long) XINT (obj
));
1633 strout (buf
, -1, -1, printcharfun
, 0);
1638 char pigbuf
[350]; /* see comments in float_to_string */
1640 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1641 strout (pigbuf
, -1, -1, printcharfun
, 0);
1647 print_string (obj
, printcharfun
);
1650 register int i
, i_byte
;
1651 struct gcpro gcpro1
;
1654 /* 1 means we must ensure that the next character we output
1655 cannot be taken as part of a hex character escape. */
1656 int need_nonhex
= 0;
1657 int multibyte
= STRING_MULTIBYTE (obj
);
1661 if (! EQ (Vprint_charset_text_property
, Qt
))
1662 obj
= print_prune_string_charset (obj
);
1664 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1672 size_byte
= SBYTES (obj
);
1674 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1676 /* Here, we must convert each multi-byte form to the
1677 corresponding character code before handing it to PRINTCHAR. */
1683 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
,
1684 size_byte
- i_byte
, len
);
1692 if (c
== '\n' && print_escape_newlines
)
1697 else if (c
== '\f' && print_escape_newlines
)
1703 && (CHAR_BYTE8_P (c
)
1704 || (! ASCII_CHAR_P (c
) && print_escape_multibyte
)))
1706 /* When multibyte is disabled,
1707 print multibyte string chars using hex escapes.
1708 For a char code that could be in a unibyte string,
1709 when found in a multibyte string, always use a hex escape
1710 so it reads back as multibyte. */
1711 unsigned char outbuf
[50];
1713 if (CHAR_BYTE8_P (c
))
1714 sprintf (outbuf
, "\\%03o", CHAR_TO_BYTE8 (c
));
1717 sprintf (outbuf
, "\\x%04x", c
);
1720 strout (outbuf
, -1, -1, printcharfun
, 0);
1722 else if (! multibyte
1723 && SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1724 && print_escape_nonascii
)
1726 /* When printing in a multibyte buffer
1727 or when explicitly requested,
1728 print single-byte non-ASCII string chars
1729 using octal escapes. */
1730 unsigned char outbuf
[5];
1731 sprintf (outbuf
, "\\%03o", c
);
1732 strout (outbuf
, -1, -1, printcharfun
, 0);
1736 /* If we just had a hex escape, and this character
1737 could be taken as part of it,
1738 output `\ ' to prevent that. */
1742 if ((c
>= 'a' && c
<= 'f')
1743 || (c
>= 'A' && c
<= 'F')
1744 || (c
>= '0' && c
<= '9'))
1745 strout ("\\ ", -1, -1, printcharfun
, 0);
1748 if (c
== '\"' || c
== '\\')
1755 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1757 traverse_intervals (STRING_INTERVALS (obj
),
1758 0, print_interval
, printcharfun
);
1768 register int confusing
;
1769 register unsigned char *p
= SDATA (SYMBOL_NAME (obj
));
1770 register unsigned char *end
= p
+ SBYTES (SYMBOL_NAME (obj
));
1772 int i
, i_byte
, size_byte
;
1775 name
= SYMBOL_NAME (obj
);
1777 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1780 /* If symbol name begins with a digit, and ends with a digit,
1781 and contains nothing but digits and `e', it could be treated
1782 as a number. So set CONFUSING.
1784 Symbols that contain periods could also be taken as numbers,
1785 but periods are always escaped, so we don't have to worry
1787 else if (*p
>= '0' && *p
<= '9'
1788 && end
[-1] >= '0' && end
[-1] <= '9')
1790 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1791 /* Needed for \2e10. */
1794 confusing
= (end
== p
);
1799 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1805 size_byte
= SBYTES (name
);
1807 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1809 /* Here, we must convert each multi-byte form to the
1810 corresponding character code before handing it to PRINTCHAR. */
1811 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1816 if (c
== '\"' || c
== '\\' || c
== '\''
1817 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1818 || c
== ',' || c
=='.' || c
== '`'
1819 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1821 PRINTCHAR ('\\'), confusing
= 0;
1829 /* If deeper than spec'd depth, print placeholder. */
1830 if (INTEGERP (Vprint_level
)
1831 && print_depth
> XINT (Vprint_level
))
1832 strout ("...", -1, -1, printcharfun
, 0);
1833 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1834 && (EQ (XCAR (obj
), Qquote
)))
1837 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1839 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1840 && (EQ (XCAR (obj
), Qfunction
)))
1844 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1846 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1847 && ((EQ (XCAR (obj
), Qbackquote
))))
1849 print_object (XCAR (obj
), printcharfun
, 0);
1850 new_backquote_output
++;
1851 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1852 new_backquote_output
--;
1854 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1855 && new_backquote_output
1856 && ((EQ (XCAR (obj
), Qbackquote
)
1857 || EQ (XCAR (obj
), Qcomma
)
1858 || EQ (XCAR (obj
), Qcomma_at
)
1859 || EQ (XCAR (obj
), Qcomma_dot
))))
1861 print_object (XCAR (obj
), printcharfun
, 0);
1862 new_backquote_output
--;
1863 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1864 new_backquote_output
++;
1870 /* If the first element is a backquote form,
1871 print it old-style so it won't be misunderstood. */
1872 if (print_quoted
&& CONSP (XCAR (obj
))
1873 && CONSP (XCDR (XCAR (obj
)))
1874 && NILP (XCDR (XCDR (XCAR (obj
))))
1875 && EQ (XCAR (XCAR (obj
)), Qbackquote
))
1881 print_object (Qbackquote
, printcharfun
, 0);
1884 print_object (XCAR (XCDR (tem
)), printcharfun
, 0);
1891 int print_length
, i
;
1892 Lisp_Object halftail
= obj
;
1894 /* Negative values of print-length are invalid in CL.
1895 Treat them like nil, as CMUCL does. */
1896 if (NATNUMP (Vprint_length
))
1897 print_length
= XFASTINT (Vprint_length
);
1904 /* Detect circular list. */
1905 if (NILP (Vprint_circle
))
1907 /* Simple but imcomplete way. */
1908 if (i
!= 0 && EQ (obj
, halftail
))
1910 sprintf (buf
, " . #%d", i
/ 2);
1911 strout (buf
, -1, -1, printcharfun
, 0);
1917 /* With the print-circle feature. */
1921 for (i
= 0; i
< print_number_index
; i
++)
1922 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
),
1925 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1927 strout (" . ", 3, 3, printcharfun
, 0);
1928 print_object (obj
, printcharfun
, escapeflag
);
1932 sprintf (buf
, " . #%d#", i
+ 1);
1933 strout (buf
, -1, -1, printcharfun
, 0);
1943 if (print_length
&& i
> print_length
)
1945 strout ("...", 3, 3, printcharfun
, 0);
1949 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1953 halftail
= XCDR (halftail
);
1957 /* OBJ non-nil here means it's the end of a dotted list. */
1960 strout (" . ", 3, 3, printcharfun
, 0);
1961 print_object (obj
, printcharfun
, escapeflag
);
1969 case Lisp_Vectorlike
:
1974 strout ("#<process ", -1, -1, printcharfun
, 0);
1975 print_string (XPROCESS (obj
)->name
, printcharfun
);
1979 print_string (XPROCESS (obj
)->name
, printcharfun
);
1981 else if (BOOL_VECTOR_P (obj
))
1984 register unsigned char c
;
1985 struct gcpro gcpro1
;
1987 = ((XBOOL_VECTOR (obj
)->size
+ BOOL_VECTOR_BITS_PER_CHAR
- 1)
1988 / BOOL_VECTOR_BITS_PER_CHAR
);
1994 sprintf (buf
, "%ld", (long) XBOOL_VECTOR (obj
)->size
);
1995 strout (buf
, -1, -1, printcharfun
, 0);
1998 /* Don't print more characters than the specified maximum.
1999 Negative values of print-length are invalid. Treat them
2000 like a print-length of nil. */
2001 if (NATNUMP (Vprint_length
)
2002 && XFASTINT (Vprint_length
) < size_in_chars
)
2003 size_in_chars
= XFASTINT (Vprint_length
);
2005 for (i
= 0; i
< size_in_chars
; i
++)
2008 c
= XBOOL_VECTOR (obj
)->data
[i
];
2009 if (! ASCII_BYTE_P (c
))
2011 sprintf (buf
, "\\%03o", c
);
2012 strout (buf
, -1, -1, printcharfun
, 0);
2014 else if (c
== '\n' && print_escape_newlines
)
2019 else if (c
== '\f' && print_escape_newlines
)
2024 else if (c
> '\177')
2026 /* Use octal escapes to avoid encoding issues. */
2028 PRINTCHAR ('0' + ((c
>> 6) & 3));
2029 PRINTCHAR ('0' + ((c
>> 3) & 7));
2030 PRINTCHAR ('0' + (c
& 7));
2034 if (c
== '\"' || c
== '\\')
2043 else if (SUBRP (obj
))
2045 strout ("#<subr ", -1, -1, printcharfun
, 0);
2046 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
2049 else if (WINDOWP (obj
))
2051 strout ("#<window ", -1, -1, printcharfun
, 0);
2052 sprintf (buf
, "%ld", (long) XFASTINT (XWINDOW (obj
)->sequence_number
));
2053 strout (buf
, -1, -1, printcharfun
, 0);
2054 if (!NILP (XWINDOW (obj
)->buffer
))
2056 strout (" on ", -1, -1, printcharfun
, 0);
2057 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
2061 else if (TERMINALP (obj
))
2063 struct terminal
*t
= XTERMINAL (obj
);
2064 strout ("#<terminal ", -1, -1, printcharfun
, 0);
2065 sprintf (buf
, "%d", t
->id
);
2066 strout (buf
, -1, -1, printcharfun
, 0);
2069 strout (" on ", -1, -1, printcharfun
, 0);
2070 strout (t
->name
, -1, -1, printcharfun
, 0);
2074 else if (HASH_TABLE_P (obj
))
2076 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
2077 strout ("#<hash-table", -1, -1, printcharfun
, 0);
2078 if (SYMBOLP (h
->test
))
2082 strout (SDATA (SYMBOL_NAME (h
->test
)), -1, -1, printcharfun
, 0);
2084 strout (SDATA (SYMBOL_NAME (h
->weak
)), -1, -1, printcharfun
, 0);
2086 sprintf (buf
, "%ld/%ld", (long) h
->count
,
2087 (long) XVECTOR (h
->next
)->size
);
2088 strout (buf
, -1, -1, printcharfun
, 0);
2090 sprintf (buf
, " 0x%lx", (unsigned long) h
);
2091 strout (buf
, -1, -1, printcharfun
, 0);
2094 else if (BUFFERP (obj
))
2096 if (NILP (XBUFFER (obj
)->name
))
2097 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
2098 else if (escapeflag
)
2100 strout ("#<buffer ", -1, -1, printcharfun
, 0);
2101 print_string (XBUFFER (obj
)->name
, printcharfun
);
2105 print_string (XBUFFER (obj
)->name
, printcharfun
);
2107 else if (WINDOW_CONFIGURATIONP (obj
))
2109 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
2111 else if (FRAMEP (obj
))
2113 strout ((FRAME_LIVE_P (XFRAME (obj
))
2114 ? "#<frame " : "#<dead frame "),
2115 -1, -1, printcharfun
, 0);
2116 print_string (XFRAME (obj
)->name
, printcharfun
);
2117 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
2118 strout (buf
, -1, -1, printcharfun
, 0);
2121 else if (FONTP (obj
))
2125 if (! FONT_OBJECT_P (obj
))
2127 if (FONT_SPEC_P (obj
))
2128 strout ("#<font-spec", -1, -1, printcharfun
, 0);
2130 strout ("#<font-entity", -1, -1, printcharfun
, 0);
2131 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2134 if (i
< FONT_WEIGHT_INDEX
|| i
> FONT_WIDTH_INDEX
)
2135 print_object (AREF (obj
, i
), printcharfun
, escapeflag
);
2137 print_object (font_style_symbolic (obj
, i
, 0),
2138 printcharfun
, escapeflag
);
2143 strout ("#<font-object ", -1, -1, printcharfun
, 0);
2144 print_object (AREF (obj
, FONT_NAME_INDEX
), printcharfun
,
2151 EMACS_INT size
= XVECTOR (obj
)->size
;
2152 if (COMPILEDP (obj
))
2155 size
&= PSEUDOVECTOR_SIZE_MASK
;
2157 if (CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
))
2159 /* We print a char-table as if it were a vector,
2160 lumping the parent and default slots in with the
2161 character slots. But we add #^ as a prefix. */
2164 if (SUB_CHAR_TABLE_P (obj
))
2166 size
&= PSEUDOVECTOR_SIZE_MASK
;
2168 if (size
& PSEUDOVECTOR_FLAG
)
2174 register Lisp_Object tem
;
2175 int real_size
= size
;
2177 /* Don't print more elements than the specified maximum. */
2178 if (NATNUMP (Vprint_length
)
2179 && XFASTINT (Vprint_length
) < size
)
2180 size
= XFASTINT (Vprint_length
);
2182 for (i
= 0; i
< size
; i
++)
2184 if (i
) PRINTCHAR (' ');
2185 tem
= XVECTOR (obj
)->contents
[i
];
2186 print_object (tem
, printcharfun
, escapeflag
);
2188 if (size
< real_size
)
2189 strout (" ...", 4, 4, printcharfun
, 0);
2196 switch (XMISCTYPE (obj
))
2198 case Lisp_Misc_Marker
:
2199 strout ("#<marker ", -1, -1, printcharfun
, 0);
2200 /* Do you think this is necessary? */
2201 if (XMARKER (obj
)->insertion_type
!= 0)
2202 strout ("(moves after insertion) ", -1, -1, printcharfun
, 0);
2203 if (! XMARKER (obj
)->buffer
)
2204 strout ("in no buffer", -1, -1, printcharfun
, 0);
2207 sprintf (buf
, "at %d", marker_position (obj
));
2208 strout (buf
, -1, -1, printcharfun
, 0);
2209 strout (" in ", -1, -1, printcharfun
, 0);
2210 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
2215 case Lisp_Misc_Overlay
:
2216 strout ("#<overlay ", -1, -1, printcharfun
, 0);
2217 if (! XMARKER (OVERLAY_START (obj
))->buffer
)
2218 strout ("in no buffer", -1, -1, printcharfun
, 0);
2221 sprintf (buf
, "from %d to %d in ",
2222 marker_position (OVERLAY_START (obj
)),
2223 marker_position (OVERLAY_END (obj
)));
2224 strout (buf
, -1, -1, printcharfun
, 0);
2225 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
2231 /* Remaining cases shouldn't happen in normal usage, but let's print
2232 them anyway for the benefit of the debugger. */
2233 case Lisp_Misc_Free
:
2234 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
2237 case Lisp_Misc_Intfwd
:
2238 sprintf (buf
, "#<intfwd to %ld>", (long) *XINTFWD (obj
)->intvar
);
2239 strout (buf
, -1, -1, printcharfun
, 0);
2242 case Lisp_Misc_Boolfwd
:
2243 sprintf (buf
, "#<boolfwd to %s>",
2244 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
2245 strout (buf
, -1, -1, printcharfun
, 0);
2248 case Lisp_Misc_Objfwd
:
2249 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
2250 print_object (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
2254 case Lisp_Misc_Buffer_Objfwd
:
2255 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
2256 print_object (PER_BUFFER_VALUE (current_buffer
,
2257 XBUFFER_OBJFWD (obj
)->offset
),
2258 printcharfun
, escapeflag
);
2262 case Lisp_Misc_Kboard_Objfwd
:
2263 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
2264 print_object (*(Lisp_Object
*) ((char *) current_kboard
2265 + XKBOARD_OBJFWD (obj
)->offset
),
2266 printcharfun
, escapeflag
);
2270 case Lisp_Misc_Buffer_Local_Value
:
2271 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
2272 if (XBUFFER_LOCAL_VALUE (obj
)->local_if_set
)
2273 strout ("[local-if-set] ", -1, -1, printcharfun
, 0);
2274 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
2275 print_object (XBUFFER_LOCAL_VALUE (obj
)->realvalue
,
2276 printcharfun
, escapeflag
);
2277 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
2278 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
2280 strout ("[buffer] ", -1, -1, printcharfun
, 0);
2281 print_object (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
2282 printcharfun
, escapeflag
);
2283 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
2285 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
2286 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
2288 strout ("[frame] ", -1, -1, printcharfun
, 0);
2289 print_object (XBUFFER_LOCAL_VALUE (obj
)->frame
,
2290 printcharfun
, escapeflag
);
2292 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
2293 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2294 printcharfun
, escapeflag
);
2295 strout ("[default-value] ", -1, -1, printcharfun
, 0);
2296 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2297 printcharfun
, escapeflag
);
2301 case Lisp_Misc_Save_Value
:
2302 strout ("#<save_value ", -1, -1, printcharfun
, 0);
2303 sprintf(buf
, "ptr=0x%08lx int=%d",
2304 (unsigned long) XSAVE_VALUE (obj
)->pointer
,
2305 XSAVE_VALUE (obj
)->integer
);
2306 strout (buf
, -1, -1, printcharfun
, 0);
2318 /* We're in trouble if this happens!
2319 Probably should just abort () */
2320 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
2322 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
2323 else if (VECTORLIKEP (obj
))
2324 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
2326 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
2327 strout (buf
, -1, -1, printcharfun
, 0);
2328 strout (" Save your buffers immediately and please report this bug>",
2329 -1, -1, printcharfun
, 0);
2337 /* Print a description of INTERVAL using PRINTCHARFUN.
2338 This is part of printing a string that has text properties. */
2341 print_interval (interval
, printcharfun
)
2343 Lisp_Object printcharfun
;
2345 if (NILP (interval
->plist
))
2348 print_object (make_number (interval
->position
), printcharfun
, 1);
2350 print_object (make_number (interval
->position
+ LENGTH (interval
)),
2353 print_object (interval
->plist
, printcharfun
, 1);
2360 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
2361 staticpro (&Qtemp_buffer_setup_hook
);
2363 DEFVAR_LISP ("standard-output", &Vstandard_output
,
2364 doc
: /* Output stream `print' uses by default for outputting a character.
2365 This may be any function of one argument.
2366 It may also be a buffer (output is inserted before point)
2367 or a marker (output is inserted and the marker is advanced)
2368 or the symbol t (output appears in the echo area). */);
2369 Vstandard_output
= Qt
;
2370 Qstandard_output
= intern ("standard-output");
2371 staticpro (&Qstandard_output
);
2373 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
2374 doc
: /* The format descriptor string used to print floats.
2375 This is a %-spec like those accepted by `printf' in C,
2376 but with some restrictions. It must start with the two characters `%.'.
2377 After that comes an integer precision specification,
2378 and then a letter which controls the format.
2379 The letters allowed are `e', `f' and `g'.
2380 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2381 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2382 Use `g' to choose the shorter of those two formats for the number at hand.
2383 The precision in any of these cases is the number of digits following
2384 the decimal point. With `f', a precision of 0 means to omit the
2385 decimal point. 0 is not allowed with `e' or `g'.
2387 A value of nil means to use the shortest notation
2388 that represents the number without losing information. */);
2389 Vfloat_output_format
= Qnil
;
2390 Qfloat_output_format
= intern ("float-output-format");
2391 staticpro (&Qfloat_output_format
);
2393 DEFVAR_LISP ("print-length", &Vprint_length
,
2394 doc
: /* Maximum length of list to print before abbreviating.
2395 A value of nil means no limit. See also `eval-expression-print-length'. */);
2396 Vprint_length
= Qnil
;
2398 DEFVAR_LISP ("print-level", &Vprint_level
,
2399 doc
: /* Maximum depth of list nesting to print before abbreviating.
2400 A value of nil means no limit. See also `eval-expression-print-level'. */);
2401 Vprint_level
= Qnil
;
2403 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
2404 doc
: /* Non-nil means print newlines in strings as `\\n'.
2405 Also print formfeeds as `\\f'. */);
2406 print_escape_newlines
= 0;
2408 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
2409 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2410 \(OOO is the octal representation of the character code.)
2411 Only single-byte characters are affected, and only in `prin1'.
2412 When the output goes in a multibyte buffer, this feature is
2413 enabled regardless of the value of the variable. */);
2414 print_escape_nonascii
= 0;
2416 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
2417 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2418 \(XXXX is the hex representation of the character code.)
2419 This affects only `prin1'. */);
2420 print_escape_multibyte
= 0;
2422 DEFVAR_BOOL ("print-quoted", &print_quoted
,
2423 doc
: /* Non-nil means print quoted forms with reader syntax.
2424 I.e., (quote foo) prints as 'foo, (function foo) as #'foo. */);
2427 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
2428 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2429 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2430 When the uninterned symbol appears within a recursive data structure,
2431 and the symbol appears more than once, in addition use the #N# and #N=
2432 constructs as needed, so that multiple references to the same symbol are
2433 shared once again when the text is read back. */);
2434 Vprint_gensym
= Qnil
;
2436 DEFVAR_LISP ("print-circle", &Vprint_circle
,
2437 doc
: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2438 If nil, printing proceeds recursively and may lead to
2439 `max-lisp-eval-depth' being exceeded or an error may occur:
2440 \"Apparently circular structure being printed.\" Also see
2441 `print-length' and `print-level'.
2442 If non-nil, shared substructures anywhere in the structure are printed
2443 with `#N=' before the first occurrence (in the order of the print
2444 representation) and `#N#' in place of each subsequent occurrence,
2445 where N is a positive decimal integer. */);
2446 Vprint_circle
= Qnil
;
2448 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
2449 doc
: /* *Non-nil means number continuously across print calls.
2450 This affects the numbers printed for #N= labels and #M# references.
2451 See also `print-circle', `print-gensym', and `print-number-table'.
2452 This variable should not be set with `setq'; bind it with a `let' instead. */);
2453 Vprint_continuous_numbering
= Qnil
;
2455 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
2456 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2457 The Lisp printer uses this vector to detect Lisp objects referenced more
2460 When you bind `print-continuous-numbering' to t, you should probably
2461 also bind `print-number-table' to nil. This ensures that the value of
2462 `print-number-table' can be garbage-collected once the printing is
2463 done. If all elements of `print-number-table' are nil, it means that
2464 the printing done so far has not found any shared structure or objects
2465 that need to be recorded in the table. */);
2466 Vprint_number_table
= Qnil
;
2468 DEFVAR_LISP ("print-charset-text-property", &Vprint_charset_text_property
,
2469 doc
: /* A flag to control printing of `charset' text property on printing a string.
2470 The value must be nil, t, or `default'.
2472 If the value is nil, don't print the text property `charset'.
2474 If the value is t, always print the text property `charset'.
2476 If the value is `default', print the text property `charset' only when
2477 the value is different from what is guessed in the current charset
2479 Vprint_charset_text_property
= Qdefault
;
2481 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2482 staticpro (&Vprin1_to_string_buffer
);
2485 defsubr (&Sprin1_to_string
);
2486 defsubr (&Serror_message_string
);
2490 defsubr (&Swrite_char
);
2491 defsubr (&Sexternal_debugging_output
);
2492 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2493 defsubr (&Sredirect_debugging_output
);
2496 Qexternal_debugging_output
= intern ("external-debugging-output");
2497 staticpro (&Qexternal_debugging_output
);
2499 Qprint_escape_newlines
= intern ("print-escape-newlines");
2500 staticpro (&Qprint_escape_newlines
);
2502 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
2503 staticpro (&Qprint_escape_multibyte
);
2505 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
2506 staticpro (&Qprint_escape_nonascii
);
2508 print_prune_charset_plist
= Qnil
;
2509 staticpro (&print_prune_charset_plist
);
2511 defsubr (&Swith_output_to_temp_buffer
);
2514 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2515 (do not change this comment) */