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
;
48 /* Work around a problem that happens because math.h on hpux 7
49 defines two static variables--which, in Emacs, are not really static,
50 because `static' is defined as nothing. The problem is that they are
51 defined both here and in lread.c.
52 These macros prevent the name conflict. */
53 #if defined (HPUX) && !defined (HPUX8)
54 #define _MAXLDBL print_maxldbl
55 #define _NMAXLDBL print_nmaxldbl
64 /* Default to values appropriate for IEEE floating point. */
69 #define DBL_MANT_DIG 53
75 #define DBL_MIN 2.2250738585072014e-308
78 #ifdef DBL_MIN_REPLACEMENT
80 #define DBL_MIN DBL_MIN_REPLACEMENT
83 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
84 needed to express a float without losing information.
85 The general-case formula is valid for the usual case, IEEE floating point,
86 but many compilers can't optimize the formula to an integer constant,
87 so make a special case for it. */
88 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
89 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
91 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
94 /* Avoid actual stack overflow in print. */
97 /* Level of nesting inside outputting backquote in new style. */
98 int new_backquote_output
;
100 /* Detect most circularities to print finite output. */
101 #define PRINT_CIRCLE 200
102 Lisp_Object being_printed
[PRINT_CIRCLE
];
104 /* When printing into a buffer, first we put the text in this
105 block, then insert it all at once. */
108 /* Size allocated in print_buffer. */
109 int print_buffer_size
;
110 /* Chars stored in print_buffer. */
111 int print_buffer_pos
;
112 /* Bytes stored in print_buffer. */
113 int print_buffer_pos_byte
;
115 /* Maximum length of list to print in full; noninteger means
116 effectively infinity */
118 Lisp_Object Vprint_length
;
120 /* Maximum depth of list to print in full; noninteger means
121 effectively infinity. */
123 Lisp_Object Vprint_level
;
125 /* Nonzero means print newlines in strings as \n. */
127 int print_escape_newlines
;
129 /* Nonzero means to print single-byte non-ascii characters in strings as
132 int print_escape_nonascii
;
134 /* Nonzero means to print multibyte characters in strings as hex escapes. */
136 int print_escape_multibyte
;
138 Lisp_Object Qprint_escape_newlines
;
139 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
141 /* Nonzero means print (quote foo) forms as 'foo, etc. */
145 /* Non-nil means print #: before uninterned symbols. */
147 Lisp_Object Vprint_gensym
;
149 /* Non-nil means print recursive structures using #n= and #n# syntax. */
151 Lisp_Object Vprint_circle
;
153 /* Non-nil means keep continuous number for #n= and #n# syntax
154 between several print functions. */
156 Lisp_Object Vprint_continuous_numbering
;
158 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
159 where OBJn are objects going to be printed, and STATn are their status,
160 which may be different meanings during process. See the comments of
161 the functions print and print_preprocess for details.
162 print_number_index keeps the last position the next object should be added,
163 twice of which is the actual vector position in Vprint_number_table. */
164 int print_number_index
;
165 Lisp_Object Vprint_number_table
;
167 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
168 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
169 See the comment of the variable Vprint_number_table. */
170 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
171 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
173 /* Nonzero means print newline to stdout before next minibuffer message.
174 Defined in xdisp.c */
176 extern int noninteractive_need_newline
;
178 extern int minibuffer_auto_raise
;
180 #ifdef MAX_PRINT_CHARS
181 static int print_chars
;
182 static int max_print
;
183 #endif /* MAX_PRINT_CHARS */
185 void print_interval ();
187 /* GDB resets this to zero on W32 to disable OutputDebugString calls. */
188 int print_output_debug_flag
= 1;
191 /* Low level output routines for characters and strings */
193 /* Lisp functions to do output using a stream
194 must have the stream in a variable called printcharfun
195 and must start with PRINTPREPARE, end with PRINTFINISH,
196 and use PRINTDECLARE to declare common variables.
197 Use PRINTCHAR to output one character,
198 or call strout to output a block of characters. */
200 #define PRINTDECLARE \
201 struct buffer *old = current_buffer; \
202 int old_point = -1, start_point = -1; \
203 int old_point_byte = -1, start_point_byte = -1; \
204 int specpdl_count = SPECPDL_INDEX (); \
205 int free_print_buffer = 0; \
206 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
209 #define PRINTPREPARE \
210 original = printcharfun; \
211 if (NILP (printcharfun)) printcharfun = Qt; \
212 if (BUFFERP (printcharfun)) \
214 if (XBUFFER (printcharfun) != current_buffer) \
215 Fset_buffer (printcharfun); \
216 printcharfun = Qnil; \
218 if (MARKERP (printcharfun)) \
220 EMACS_INT marker_pos; \
221 if (! XMARKER (printcharfun)->buffer) \
222 error ("Marker does not point anywhere"); \
223 if (XMARKER (printcharfun)->buffer != current_buffer) \
224 set_buffer_internal (XMARKER (printcharfun)->buffer); \
225 marker_pos = marker_position (printcharfun); \
226 if (marker_pos < BEGV || marker_pos > ZV) \
227 error ("Marker is outside the accessible part of the buffer"); \
229 old_point_byte = PT_BYTE; \
230 SET_PT_BOTH (marker_pos, \
231 marker_byte_position (printcharfun)); \
233 start_point_byte = PT_BYTE; \
234 printcharfun = Qnil; \
236 if (NILP (printcharfun)) \
238 Lisp_Object string; \
239 if (NILP (current_buffer->enable_multibyte_characters) \
240 && ! print_escape_multibyte) \
241 specbind (Qprint_escape_multibyte, Qt); \
242 if (! NILP (current_buffer->enable_multibyte_characters) \
243 && ! print_escape_nonascii) \
244 specbind (Qprint_escape_nonascii, Qt); \
245 if (print_buffer != 0) \
247 string = make_string_from_bytes (print_buffer, \
249 print_buffer_pos_byte); \
250 record_unwind_protect (print_unwind, string); \
254 print_buffer_size = 1000; \
255 print_buffer = (char *) xmalloc (print_buffer_size); \
256 free_print_buffer = 1; \
258 print_buffer_pos = 0; \
259 print_buffer_pos_byte = 0; \
261 if (EQ (printcharfun, Qt) && ! noninteractive) \
262 setup_echo_area_for_printing (multibyte);
264 #define PRINTFINISH \
265 if (NILP (printcharfun)) \
267 if (print_buffer_pos != print_buffer_pos_byte \
268 && NILP (current_buffer->enable_multibyte_characters)) \
270 unsigned char *temp \
271 = (unsigned char *) alloca (print_buffer_pos + 1); \
272 copy_text (print_buffer, temp, print_buffer_pos_byte, \
274 insert_1_both (temp, print_buffer_pos, \
275 print_buffer_pos, 0, 1, 0); \
278 insert_1_both (print_buffer, print_buffer_pos, \
279 print_buffer_pos_byte, 0, 1, 0); \
280 signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
282 if (free_print_buffer) \
284 xfree (print_buffer); \
287 unbind_to (specpdl_count, Qnil); \
288 if (MARKERP (original)) \
289 set_marker_both (original, Qnil, PT, PT_BYTE); \
290 if (old_point >= 0) \
291 SET_PT_BOTH (old_point + (old_point >= start_point \
292 ? PT - start_point : 0), \
293 old_point_byte + (old_point_byte >= start_point_byte \
294 ? PT_BYTE - start_point_byte : 0)); \
295 if (old != current_buffer) \
296 set_buffer_internal (old);
298 #define PRINTCHAR(ch) printchar (ch, printcharfun)
300 /* This is used to restore the saved contents of print_buffer
301 when there is a recursive call to print. */
304 print_unwind (saved_text
)
305 Lisp_Object saved_text
;
307 bcopy (SDATA (saved_text
), print_buffer
, SCHARS (saved_text
));
312 /* Print character CH using method FUN. FUN nil means print to
313 print_buffer. FUN t means print to echo area or stdout if
314 non-interactive. If FUN is neither nil nor t, call FUN with CH as
322 #ifdef MAX_PRINT_CHARS
325 #endif /* MAX_PRINT_CHARS */
327 if (!NILP (fun
) && !EQ (fun
, Qt
))
328 call1 (fun
, make_number (ch
));
331 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
332 int len
= CHAR_STRING (ch
, str
);
338 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
339 print_buffer
= (char *) xrealloc (print_buffer
,
340 print_buffer_size
*= 2);
341 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
342 print_buffer_pos
+= 1;
343 print_buffer_pos_byte
+= len
;
345 else if (noninteractive
)
347 fwrite (str
, 1, len
, stdout
);
348 noninteractive_need_newline
= 1;
353 = !NILP (current_buffer
->enable_multibyte_characters
);
355 setup_echo_area_for_printing (multibyte_p
);
357 message_dolog (str
, len
, 0, multibyte_p
);
363 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
364 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
365 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
366 print_buffer. PRINTCHARFUN t means output to the echo area or to
367 stdout if non-interactive. If neither nil nor t, call Lisp
368 function PRINTCHARFUN for each character printed. MULTIBYTE
369 non-zero means PTR contains multibyte characters.
371 In the case where PRINTCHARFUN is nil, it is safe for PTR to point
372 to data in a Lisp string. Otherwise that is not safe. */
375 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
378 Lisp_Object printcharfun
;
382 size_byte
= size
= strlen (ptr
);
384 if (NILP (printcharfun
))
386 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
388 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
389 print_buffer
= (char *) xrealloc (print_buffer
,
392 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
393 print_buffer_pos
+= size
;
394 print_buffer_pos_byte
+= size_byte
;
396 #ifdef MAX_PRINT_CHARS
399 #endif /* MAX_PRINT_CHARS */
401 else if (noninteractive
&& EQ (printcharfun
, Qt
))
403 fwrite (ptr
, 1, size_byte
, stdout
);
404 noninteractive_need_newline
= 1;
406 else if (EQ (printcharfun
, Qt
))
408 /* Output to echo area. We're trying to avoid a little overhead
409 here, that's the reason we don't call printchar to do the
413 = !NILP (current_buffer
->enable_multibyte_characters
);
415 setup_echo_area_for_printing (multibyte_p
);
416 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
418 if (size
== size_byte
)
420 for (i
= 0; i
< size
; ++i
)
421 insert_char ((unsigned char) *ptr
++);
426 for (i
= 0; i
< size_byte
; i
+= len
)
428 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
433 #ifdef MAX_PRINT_CHARS
436 #endif /* MAX_PRINT_CHARS */
440 /* PRINTCHARFUN is a Lisp function. */
443 if (size
== size_byte
)
445 while (i
< size_byte
)
453 while (i
< size_byte
)
455 /* Here, we must convert each multi-byte form to the
456 corresponding character code before handing it to
459 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
467 /* Print the contents of a string STRING using PRINTCHARFUN.
468 It isn't safe to use strout in many cases,
469 because printing one char can relocate. */
472 print_string (string
, printcharfun
)
474 Lisp_Object printcharfun
;
476 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
480 if (print_escape_nonascii
)
481 string
= string_escape_byte8 (string
);
483 if (STRING_MULTIBYTE (string
))
484 chars
= SCHARS (string
);
485 else if (! print_escape_nonascii
486 && (EQ (printcharfun
, Qt
)
487 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
488 : ! NILP (current_buffer
->enable_multibyte_characters
)))
490 /* If unibyte string STRING contains 8-bit codes, we must
491 convert STRING to a multibyte string containing the same
496 chars
= SBYTES (string
);
497 bytes
= parse_str_to_multibyte (SDATA (string
), chars
);
500 newstr
= make_uninit_multibyte_string (chars
, bytes
);
501 bcopy (SDATA (string
), SDATA (newstr
), chars
);
502 str_to_multibyte (SDATA (newstr
), bytes
, chars
);
507 chars
= SBYTES (string
);
509 if (EQ (printcharfun
, Qt
))
511 /* Output to echo area. */
512 int nbytes
= SBYTES (string
);
515 /* Copy the string contents so that relocation of STRING by
516 GC does not cause trouble. */
519 SAFE_ALLOCA (buffer
, char *, nbytes
);
520 bcopy (SDATA (string
), buffer
, nbytes
);
522 strout (buffer
, chars
, SBYTES (string
),
523 printcharfun
, STRING_MULTIBYTE (string
));
528 /* No need to copy, since output to print_buffer can't GC. */
529 strout (SDATA (string
),
530 chars
, SBYTES (string
),
531 printcharfun
, STRING_MULTIBYTE (string
));
535 /* Otherwise, string may be relocated by printing one char.
536 So re-fetch the string address for each character. */
538 int size
= SCHARS (string
);
539 int size_byte
= SBYTES (string
);
542 if (size
== size_byte
)
543 for (i
= 0; i
< size
; i
++)
544 PRINTCHAR (SREF (string
, i
));
546 for (i
= 0; i
< size_byte
; )
548 /* Here, we must convert each multi-byte form to the
549 corresponding character code before handing it to PRINTCHAR. */
551 int ch
= STRING_CHAR_AND_LENGTH (SDATA (string
) + i
,
560 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
561 doc
: /* Output character CHARACTER to stream PRINTCHARFUN.
562 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
563 (character
, printcharfun
)
564 Lisp_Object character
, printcharfun
;
568 if (NILP (printcharfun
))
569 printcharfun
= Vstandard_output
;
570 CHECK_NUMBER (character
);
572 PRINTCHAR (XINT (character
));
577 /* Used from outside of print.c to print a block of SIZE
578 single-byte chars at DATA on the default output stream.
579 Do not use this on the contents of a Lisp string. */
582 write_string (data
, size
)
587 Lisp_Object printcharfun
;
589 printcharfun
= Vstandard_output
;
592 strout (data
, size
, size
, printcharfun
, 0);
596 /* Used from outside of print.c to print a block of SIZE
597 single-byte chars at DATA on a specified stream PRINTCHARFUN.
598 Do not use this on the contents of a Lisp string. */
601 write_string_1 (data
, size
, printcharfun
)
604 Lisp_Object printcharfun
;
609 strout (data
, size
, size
, printcharfun
, 0);
615 temp_output_buffer_setup (bufname
)
618 int count
= SPECPDL_INDEX ();
619 register struct buffer
*old
= current_buffer
;
620 register Lisp_Object buf
;
622 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
624 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
626 Fkill_all_local_variables ();
627 delete_all_overlays (current_buffer
);
628 current_buffer
->directory
= old
->directory
;
629 current_buffer
->read_only
= Qnil
;
630 current_buffer
->filename
= Qnil
;
631 current_buffer
->undo_list
= Qt
;
632 eassert (current_buffer
->overlays_before
== NULL
);
633 eassert (current_buffer
->overlays_after
== NULL
);
634 current_buffer
->enable_multibyte_characters
635 = buffer_defaults
.enable_multibyte_characters
;
636 specbind (Qinhibit_read_only
, Qt
);
637 specbind (Qinhibit_modification_hooks
, Qt
);
639 XSETBUFFER (buf
, current_buffer
);
641 Frun_hooks (1, &Qtemp_buffer_setup_hook
);
643 unbind_to (count
, Qnil
);
645 specbind (Qstandard_output
, buf
);
649 internal_with_output_to_temp_buffer (bufname
, function
, args
)
651 Lisp_Object (*function
) P_ ((Lisp_Object
));
654 int count
= SPECPDL_INDEX ();
655 Lisp_Object buf
, val
;
659 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
660 temp_output_buffer_setup (bufname
);
661 buf
= Vstandard_output
;
664 val
= (*function
) (args
);
667 temp_output_buffer_show (buf
);
670 return unbind_to (count
, val
);
673 DEFUN ("with-output-to-temp-buffer",
674 Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
676 doc
: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
678 This construct makes buffer BUFNAME empty before running BODY.
679 It does not make the buffer current for BODY.
680 Instead it binds `standard-output' to that buffer, so that output
681 generated with `prin1' and similar functions in BODY goes into
684 At the end of BODY, this marks buffer BUFNAME unmodifed and displays
685 it in a window, but does not select it. The normal way to do this is
686 by calling `display-buffer', then running `temp-buffer-show-hook'.
687 However, if `temp-buffer-show-function' is non-nil, it calls that
688 function instead (and does not run `temp-buffer-show-hook'). The
689 function gets one argument, the buffer to display.
691 The return value of `with-output-to-temp-buffer' is the value of the
692 last form in BODY. If BODY does not finish normally, the buffer
693 BUFNAME is not displayed.
695 This runs the hook `temp-buffer-setup-hook' before BODY,
696 with the buffer BUFNAME temporarily current. It runs the hook
697 `temp-buffer-show-hook' after displaying buffer BUFNAME, with that
698 buffer temporarily current, and the window that was used to display it
699 temporarily selected. But it doesn't run `temp-buffer-show-hook'
700 if it uses `temp-buffer-show-function'.
702 usage: (with-output-to-temp-buffer BUFNAME BODY...) */)
708 int count
= SPECPDL_INDEX ();
709 Lisp_Object buf
, val
;
712 name
= Feval (Fcar (args
));
714 temp_output_buffer_setup (SDATA (name
));
715 buf
= Vstandard_output
;
718 val
= Fprogn (XCDR (args
));
721 temp_output_buffer_show (buf
);
724 return unbind_to (count
, val
);
728 static void print ();
729 static void print_preprocess ();
730 static void print_preprocess_string ();
731 static void print_object ();
733 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
734 doc
: /* Output a newline to stream PRINTCHARFUN.
735 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
737 Lisp_Object printcharfun
;
741 if (NILP (printcharfun
))
742 printcharfun
= Vstandard_output
;
749 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
750 doc
: /* Output the printed representation of OBJECT, any Lisp object.
751 Quoting characters are printed when needed to make output that `read'
752 can handle, whenever this is possible. For complex objects, the behavior
753 is controlled by `print-level' and `print-length', which see.
755 OBJECT is any of the Lisp data types: a number, a string, a symbol,
756 a list, a buffer, a window, a frame, etc.
758 A printed representation of an object is text which describes that object.
760 Optional argument PRINTCHARFUN is the output stream, which can be one
763 - a buffer, in which case output is inserted into that buffer at point;
764 - a marker, in which case output is inserted at marker's position;
765 - a function, in which case that function is called once for each
766 character of OBJECT's printed representation;
767 - a symbol, in which case that symbol's function definition is called; or
768 - t, in which case the output is displayed in the echo area.
770 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
772 (object
, printcharfun
)
773 Lisp_Object object
, printcharfun
;
777 #ifdef MAX_PRINT_CHARS
779 #endif /* MAX_PRINT_CHARS */
780 if (NILP (printcharfun
))
781 printcharfun
= Vstandard_output
;
783 print (object
, printcharfun
, 1);
788 /* a buffer which is used to hold output being built by prin1-to-string */
789 Lisp_Object Vprin1_to_string_buffer
;
791 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
792 doc
: /* Return a string containing the printed representation of OBJECT.
793 OBJECT can be any Lisp object. This function outputs quoting characters
794 when necessary to make output that `read' can handle, whenever possible,
795 unless the optional second argument NOESCAPE is non-nil. For complex objects,
796 the behavior is controlled by `print-level' and `print-length', which see.
798 OBJECT is any of the Lisp data types: a number, a string, a symbol,
799 a list, a buffer, a window, a frame, etc.
801 A printed representation of an object is text which describes that object. */)
803 Lisp_Object object
, noescape
;
805 Lisp_Object printcharfun
;
806 /* struct gcpro gcpro1, gcpro2; */
807 Lisp_Object save_deactivate_mark
;
808 int count
= SPECPDL_INDEX ();
809 struct buffer
*previous
;
811 specbind (Qinhibit_modification_hooks
, Qt
);
816 /* Save and restore this--we are altering a buffer
817 but we don't want to deactivate the mark just for that.
818 No need for specbind, since errors deactivate the mark. */
819 save_deactivate_mark
= Vdeactivate_mark
;
820 /* GCPRO2 (object, save_deactivate_mark); */
823 printcharfun
= Vprin1_to_string_buffer
;
825 print (object
, printcharfun
, NILP (noescape
));
826 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
830 previous
= current_buffer
;
831 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
832 object
= Fbuffer_string ();
833 if (SBYTES (object
) == SCHARS (object
))
834 STRING_SET_UNIBYTE (object
);
836 /* Note that this won't make prepare_to_modify_buffer call
837 ask-user-about-supersession-threat because this buffer
838 does not visit a file. */
840 set_buffer_internal (previous
);
842 Vdeactivate_mark
= save_deactivate_mark
;
846 return unbind_to (count
, object
);
849 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
850 doc
: /* Output the printed representation of OBJECT, any Lisp object.
851 No quoting characters are used; no delimiters are printed around
852 the contents of strings.
854 OBJECT is any of the Lisp data types: a number, a string, a symbol,
855 a list, a buffer, a window, a frame, etc.
857 A printed representation of an object is text which describes that object.
859 Optional argument PRINTCHARFUN is the output stream, which can be one
862 - a buffer, in which case output is inserted into that buffer at point;
863 - a marker, in which case output is inserted at marker's position;
864 - a function, in which case that function is called once for each
865 character of OBJECT's printed representation;
866 - a symbol, in which case that symbol's function definition is called; or
867 - t, in which case the output is displayed in the echo area.
869 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
871 (object
, printcharfun
)
872 Lisp_Object object
, printcharfun
;
876 if (NILP (printcharfun
))
877 printcharfun
= Vstandard_output
;
879 print (object
, printcharfun
, 0);
884 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
885 doc
: /* Output the printed representation of OBJECT, with newlines around it.
886 Quoting characters are printed when needed to make output that `read'
887 can handle, whenever this is possible. For complex objects, the behavior
888 is controlled by `print-level' and `print-length', which see.
890 OBJECT is any of the Lisp data types: a number, a string, a symbol,
891 a list, a buffer, a window, a frame, etc.
893 A printed representation of an object is text which describes that object.
895 Optional argument PRINTCHARFUN is the output stream, which can be one
898 - a buffer, in which case output is inserted into that buffer at point;
899 - a marker, in which case output is inserted at marker's position;
900 - a function, in which case that function is called once for each
901 character of OBJECT's printed representation;
902 - a symbol, in which case that symbol's function definition is called; or
903 - t, in which case the output is displayed in the echo area.
905 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
907 (object
, printcharfun
)
908 Lisp_Object object
, printcharfun
;
913 #ifdef MAX_PRINT_CHARS
915 max_print
= MAX_PRINT_CHARS
;
916 #endif /* MAX_PRINT_CHARS */
917 if (NILP (printcharfun
))
918 printcharfun
= Vstandard_output
;
922 print (object
, printcharfun
, 1);
925 #ifdef MAX_PRINT_CHARS
928 #endif /* MAX_PRINT_CHARS */
933 /* The subroutine object for external-debugging-output is kept here
934 for the convenience of the debugger. */
935 Lisp_Object Qexternal_debugging_output
;
937 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
938 doc
: /* Write CHARACTER to stderr.
939 You can call print while debugging emacs, and pass it this function
940 to make it write to the debugging output. */)
942 Lisp_Object character
;
944 CHECK_NUMBER (character
);
945 putc (XINT (character
), stderr
);
948 /* Send the output to a debugger (nothing happens if there isn't one). */
949 if (print_output_debug_flag
)
951 char buf
[2] = {(char) XINT (character
), '\0'};
952 OutputDebugString (buf
);
959 /* This function is never called. Its purpose is to prevent
960 print_output_debug_flag from being optimized away. */
963 debug_output_compilation_hack (x
)
966 print_output_debug_flag
= x
;
969 #if defined (GNU_LINUX)
971 /* This functionality is not vitally important in general, so we rely on
972 non-portable ability to use stderr as lvalue. */
974 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
976 FILE *initial_stderr_stream
= NULL
;
978 DEFUN ("redirect-debugging-output", Fredirect_debugging_output
, Sredirect_debugging_output
,
980 "FDebug output file: \nP",
981 doc
: /* Redirect debugging output (stderr stream) to file FILE.
982 If FILE is nil, reset target to the initial stderr stream.
983 Optional arg APPEND non-nil (interactively, with prefix arg) means
984 append to existing target file. */)
986 Lisp_Object file
, append
;
988 if (initial_stderr_stream
!= NULL
)
994 stderr
= initial_stderr_stream
;
995 initial_stderr_stream
= NULL
;
999 file
= Fexpand_file_name (file
, Qnil
);
1000 initial_stderr_stream
= stderr
;
1001 stderr
= fopen (SDATA (file
), NILP (append
) ? "w" : "a");
1004 stderr
= initial_stderr_stream
;
1005 initial_stderr_stream
= NULL
;
1006 report_file_error ("Cannot open debugging output stream",
1007 Fcons (file
, Qnil
));
1012 #endif /* GNU_LINUX */
1015 /* This is the interface for debugging printing. */
1021 Fprin1 (arg
, Qexternal_debugging_output
);
1022 fprintf (stderr
, "\r\n");
1026 safe_debug_print (arg
)
1029 int valid
= valid_lisp_object_p (arg
);
1034 fprintf (stderr
, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
1035 !valid
? "INVALID" : "SOME",
1036 (unsigned long) XHASH (arg
)
1041 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
1043 doc
: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
1044 See Info anchor `(elisp)Definition of signal' for some details on how this
1045 error message is constructed. */)
1049 struct buffer
*old
= current_buffer
;
1051 struct gcpro gcpro1
;
1053 /* If OBJ is (error STRING), just return STRING.
1054 That is not only faster, it also avoids the need to allocate
1055 space here when the error is due to memory full. */
1056 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
1057 && CONSP (XCDR (obj
))
1058 && STRINGP (XCAR (XCDR (obj
)))
1059 && NILP (XCDR (XCDR (obj
))))
1060 return XCAR (XCDR (obj
));
1062 print_error_message (obj
, Vprin1_to_string_buffer
, 0, Qnil
);
1064 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
1065 value
= Fbuffer_string ();
1069 set_buffer_internal (old
);
1075 /* Print an error message for the error DATA onto Lisp output stream
1076 STREAM (suitable for the print functions).
1077 CONTEXT is a C string describing the context of the error.
1078 CALLER is the Lisp function inside which the error was signaled. */
1081 print_error_message (data
, stream
, context
, caller
)
1082 Lisp_Object data
, stream
;
1086 Lisp_Object errname
, errmsg
, file_error
, tail
;
1087 struct gcpro gcpro1
;
1091 write_string_1 (context
, -1, stream
);
1093 /* If we know from where the error was signaled, show it in
1095 if (!NILP (caller
) && SYMBOLP (caller
))
1097 Lisp_Object cname
= SYMBOL_NAME (caller
);
1098 char *name
= alloca (SBYTES (cname
));
1099 bcopy (SDATA (cname
), name
, SBYTES (cname
));
1100 message_dolog (name
, SBYTES (cname
), 0, 0);
1101 message_dolog (": ", 2, 0, 0);
1104 errname
= Fcar (data
);
1106 if (EQ (errname
, Qerror
))
1111 errmsg
= Fcar (data
);
1116 Lisp_Object error_conditions
;
1117 errmsg
= Fget (errname
, Qerror_message
);
1118 error_conditions
= Fget (errname
, Qerror_conditions
);
1119 file_error
= Fmemq (Qfile_error
, error_conditions
);
1122 /* Print an error message including the data items. */
1124 tail
= Fcdr_safe (data
);
1127 /* For file-error, make error message by concatenating
1128 all the data items. They are all strings. */
1129 if (!NILP (file_error
) && CONSP (tail
))
1130 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
1132 if (STRINGP (errmsg
))
1133 Fprinc (errmsg
, stream
);
1135 write_string_1 ("peculiar error", -1, stream
);
1137 for (i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
1141 write_string_1 (i
? ", " : ": ", 2, stream
);
1143 if (!NILP (file_error
) || EQ (errname
, Qend_of_file
))
1144 Fprinc (obj
, stream
);
1146 Fprin1 (obj
, stream
);
1155 * The buffer should be at least as large as the max string size of the
1156 * largest float, printed in the biggest notation. This is undoubtedly
1157 * 20d float_output_format, with the negative of the C-constant "HUGE"
1160 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1162 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1163 * case of -1e307 in 20d float_output_format. What is one to do (short of
1164 * re-writing _doprnt to be more sane)?
1169 float_to_string (buf
, data
)
1176 /* Check for plus infinity in a way that won't lose
1177 if there is no plus infinity. */
1178 if (data
== data
/ 2 && data
> 1.0)
1180 strcpy (buf
, "1.0e+INF");
1183 /* Likewise for minus infinity. */
1184 if (data
== data
/ 2 && data
< -1.0)
1186 strcpy (buf
, "-1.0e+INF");
1189 /* Check for NaN in a way that won't fail if there are no NaNs. */
1190 if (! (data
* 0.0 >= 0.0))
1192 /* Prepend "-" if the NaN's sign bit is negative.
1193 The sign bit of a double is the bit that is 1 in -0.0. */
1195 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
1197 u_minus_zero
.d
= - 0.0;
1198 for (i
= 0; i
< sizeof (double); i
++)
1199 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1205 strcpy (buf
, "0.0e+NaN");
1209 if (NILP (Vfloat_output_format
)
1210 || !STRINGP (Vfloat_output_format
))
1213 /* Generate the fewest number of digits that represent the
1214 floating point value without losing information.
1215 The following method is simple but a bit slow.
1216 For ideas about speeding things up, please see:
1218 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1219 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1221 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1222 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1224 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1226 sprintf (buf
, "%.*g", width
, data
);
1227 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1229 else /* oink oink */
1231 /* Check that the spec we have is fully valid.
1232 This means not only valid for printf,
1233 but meant for floats, and reasonable. */
1234 cp
= SDATA (Vfloat_output_format
);
1243 /* Check the width specification. */
1245 if ('0' <= *cp
&& *cp
<= '9')
1249 width
= (width
* 10) + (*cp
++ - '0');
1250 while (*cp
>= '0' && *cp
<= '9');
1252 /* A precision of zero is valid only for %f. */
1254 || (width
== 0 && *cp
!= 'f'))
1258 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1264 sprintf (buf
, SDATA (Vfloat_output_format
), data
);
1267 /* Make sure there is a decimal point with digit after, or an
1268 exponent, so that the value is readable as a float. But don't do
1269 this with "%.0f"; it's valid for that not to produce a decimal
1270 point. Note that width can be 0 only for %.0f. */
1273 for (cp
= buf
; *cp
; cp
++)
1274 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1277 if (*cp
== '.' && cp
[1] == 0)
1294 print (obj
, printcharfun
, escapeflag
)
1296 register Lisp_Object printcharfun
;
1299 new_backquote_output
= 0;
1301 /* Reset print_number_index and Vprint_number_table only when
1302 the variable Vprint_continuous_numbering is nil. Otherwise,
1303 the values of these variables will be kept between several
1305 if (NILP (Vprint_continuous_numbering
)
1306 || NILP (Vprint_number_table
))
1308 print_number_index
= 0;
1309 Vprint_number_table
= Qnil
;
1312 /* Construct Vprint_number_table for print-gensym and print-circle. */
1313 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1315 int i
, start
, index
;
1316 start
= index
= print_number_index
;
1317 /* Construct Vprint_number_table.
1318 This increments print_number_index for the objects added. */
1320 print_preprocess (obj
);
1322 /* Remove unnecessary objects, which appear only once in OBJ;
1323 that is, whose status is Qnil. Compactify the necessary objects. */
1324 for (i
= start
; i
< print_number_index
; i
++)
1325 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1327 PRINT_NUMBER_OBJECT (Vprint_number_table
, index
)
1328 = PRINT_NUMBER_OBJECT (Vprint_number_table
, i
);
1332 /* Clear out objects outside the active part of the table. */
1333 for (i
= index
; i
< print_number_index
; i
++)
1334 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
) = Qnil
;
1336 /* Reset the status field for the next print step. Now this
1337 field means whether the object has already been printed. */
1338 for (i
= start
; i
< print_number_index
; i
++)
1339 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qnil
;
1341 print_number_index
= index
;
1345 print_object (obj
, printcharfun
, escapeflag
);
1348 /* Construct Vprint_number_table according to the structure of OBJ.
1349 OBJ itself and all its elements will be added to Vprint_number_table
1350 recursively if it is a list, vector, compiled function, char-table,
1351 string (its text properties will be traced), or a symbol that has
1352 no obarray (this is for the print-gensym feature).
1353 The status fields of Vprint_number_table mean whether each object appears
1354 more than once in OBJ: Qnil at the first time, and Qt after that . */
1356 print_preprocess (obj
)
1362 Lisp_Object halftail
;
1364 /* Give up if we go so deep that print_object will get an error. */
1365 /* See similar code in print_object. */
1366 if (print_depth
>= PRINT_CIRCLE
)
1367 error ("Apparently circular structure being printed");
1369 /* Avoid infinite recursion for circular nested structure
1370 in the case where Vprint_circle is nil. */
1371 if (NILP (Vprint_circle
))
1373 for (i
= 0; i
< print_depth
; i
++)
1374 if (EQ (obj
, being_printed
[i
]))
1376 being_printed
[print_depth
] = obj
;
1383 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1384 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
)
1385 || (! NILP (Vprint_gensym
)
1387 && !SYMBOL_INTERNED_P (obj
)))
1389 /* In case print-circle is nil and print-gensym is t,
1390 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1391 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1393 for (i
= 0; i
< print_number_index
; i
++)
1394 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1396 /* OBJ appears more than once. Let's remember that. */
1397 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1402 /* OBJ is not yet recorded. Let's add to the table. */
1403 if (print_number_index
== 0)
1405 /* Initialize the table. */
1406 Vprint_number_table
= Fmake_vector (make_number (40), Qnil
);
1408 else if (XVECTOR (Vprint_number_table
)->size
== print_number_index
* 2)
1410 /* Reallocate the table. */
1411 int i
= print_number_index
* 4;
1412 Lisp_Object old_table
= Vprint_number_table
;
1413 Vprint_number_table
= Fmake_vector (make_number (i
), Qnil
);
1414 for (i
= 0; i
< print_number_index
; i
++)
1416 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
)
1417 = PRINT_NUMBER_OBJECT (old_table
, i
);
1418 PRINT_NUMBER_STATUS (Vprint_number_table
, i
)
1419 = PRINT_NUMBER_STATUS (old_table
, i
);
1422 PRINT_NUMBER_OBJECT (Vprint_number_table
, print_number_index
) = obj
;
1423 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1424 always print the gensym with a number. This is a special for
1425 the lisp function byte-compile-output-docform. */
1426 if (!NILP (Vprint_continuous_numbering
)
1428 && !SYMBOL_INTERNED_P (obj
))
1429 PRINT_NUMBER_STATUS (Vprint_number_table
, print_number_index
) = Qt
;
1430 print_number_index
++;
1433 switch (XTYPE (obj
))
1436 /* A string may have text properties, which can be circular. */
1437 traverse_intervals_noorder (STRING_INTERVALS (obj
),
1438 print_preprocess_string
, Qnil
);
1442 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1443 just as in print_object. */
1444 if (loop_count
&& EQ (obj
, halftail
))
1446 print_preprocess (XCAR (obj
));
1449 if (!(loop_count
& 1))
1450 halftail
= XCDR (halftail
);
1453 case Lisp_Vectorlike
:
1454 size
= XVECTOR (obj
)->size
;
1455 if (size
& PSEUDOVECTOR_FLAG
)
1456 size
&= PSEUDOVECTOR_SIZE_MASK
;
1457 for (i
= 0; i
< size
; i
++)
1458 print_preprocess (XVECTOR (obj
)->contents
[i
]);
1469 print_preprocess_string (interval
, arg
)
1473 print_preprocess (interval
->plist
);
1476 /* A flag to control printing of `charset' text property.
1477 The default value is Qdefault. */
1478 Lisp_Object Vprint_charset_text_property
;
1479 extern Lisp_Object Qdefault
;
1481 static void print_check_string_charset_prop ();
1483 #define PRINT_STRING_NON_CHARSET_FOUND 1
1484 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
1486 /* Bitwize or of the abobe macros. */
1487 static int print_check_string_result
;
1490 print_check_string_charset_prop (interval
, string
)
1496 if (NILP (interval
->plist
)
1497 || (print_check_string_result
== (PRINT_STRING_NON_CHARSET_FOUND
1498 | PRINT_STRING_UNSAFE_CHARSET_FOUND
)))
1500 for (val
= interval
->plist
; CONSP (val
) && ! EQ (XCAR (val
), Qcharset
);
1501 val
= XCDR (XCDR (val
)));
1504 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1507 if (! (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
))
1509 if (! EQ (val
, interval
->plist
)
1510 || CONSP (XCDR (XCDR (val
))))
1511 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1513 if (NILP (Vprint_charset_text_property
)
1514 || ! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1517 int charpos
= interval
->position
;
1518 int bytepos
= string_char_to_byte (string
, charpos
);
1519 Lisp_Object charset
;
1521 charset
= XCAR (XCDR (val
));
1522 for (i
= 0; i
< LENGTH (interval
); i
++)
1524 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1525 if (! ASCII_CHAR_P (c
)
1526 && ! EQ (CHARSET_NAME (CHAR_CHARSET (c
)), charset
))
1528 print_check_string_result
|= PRINT_STRING_UNSAFE_CHARSET_FOUND
;
1535 /* The value is (charset . nil). */
1536 static Lisp_Object print_prune_charset_plist
;
1539 print_prune_string_charset (string
)
1542 print_check_string_result
= 0;
1543 traverse_intervals (STRING_INTERVALS (string
), 0,
1544 print_check_string_charset_prop
, string
);
1545 if (! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1547 string
= Fcopy_sequence (string
);
1548 if (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
)
1550 if (NILP (print_prune_charset_plist
))
1551 print_prune_charset_plist
= Fcons (Qcharset
, Qnil
);
1552 Fremove_text_properties (make_number (0),
1553 make_number (SCHARS (string
)),
1554 print_prune_charset_plist
, string
);
1557 Fset_text_properties (make_number (0), make_number (SCHARS (string
)),
1564 print_object (obj
, printcharfun
, escapeflag
)
1566 register Lisp_Object printcharfun
;
1573 /* Detect circularities and truncate them. */
1574 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1575 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
)
1576 || (! NILP (Vprint_gensym
)
1578 && !SYMBOL_INTERNED_P (obj
)))
1580 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1582 /* Simple but incomplete way. */
1584 for (i
= 0; i
< print_depth
; i
++)
1585 if (EQ (obj
, being_printed
[i
]))
1587 sprintf (buf
, "#%d", i
);
1588 strout (buf
, -1, -1, printcharfun
, 0);
1591 being_printed
[print_depth
] = obj
;
1595 /* With the print-circle feature. */
1597 for (i
= 0; i
< print_number_index
; i
++)
1598 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1600 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1602 /* Add a prefix #n= if OBJ has not yet been printed;
1603 that is, its status field is nil. */
1604 sprintf (buf
, "#%d=", i
+ 1);
1605 strout (buf
, -1, -1, printcharfun
, 0);
1606 /* OBJ is going to be printed. Set the status to t. */
1607 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1612 /* Just print #n# if OBJ has already been printed. */
1613 sprintf (buf
, "#%d#", i
+ 1);
1614 strout (buf
, -1, -1, printcharfun
, 0);
1623 /* See similar code in print_preprocess. */
1624 if (print_depth
> PRINT_CIRCLE
)
1625 error ("Apparently circular structure being printed");
1626 #ifdef MAX_PRINT_CHARS
1627 if (max_print
&& print_chars
> max_print
)
1632 #endif /* MAX_PRINT_CHARS */
1634 switch (XTYPE (obj
))
1637 if (sizeof (int) == sizeof (EMACS_INT
))
1638 sprintf (buf
, "%d", (int) XINT (obj
));
1639 else if (sizeof (long) == sizeof (EMACS_INT
))
1640 sprintf (buf
, "%ld", (long) XINT (obj
));
1643 strout (buf
, -1, -1, printcharfun
, 0);
1648 char pigbuf
[350]; /* see comments in float_to_string */
1650 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1651 strout (pigbuf
, -1, -1, printcharfun
, 0);
1657 print_string (obj
, printcharfun
);
1660 register int i
, i_byte
;
1661 struct gcpro gcpro1
;
1664 /* 1 means we must ensure that the next character we output
1665 cannot be taken as part of a hex character escape. */
1666 int need_nonhex
= 0;
1667 int multibyte
= STRING_MULTIBYTE (obj
);
1671 if (! EQ (Vprint_charset_text_property
, Qt
))
1672 obj
= print_prune_string_charset (obj
);
1674 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1682 size_byte
= SBYTES (obj
);
1684 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1686 /* Here, we must convert each multi-byte form to the
1687 corresponding character code before handing it to PRINTCHAR. */
1693 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
,
1694 size_byte
- i_byte
, len
);
1702 if (c
== '\n' && print_escape_newlines
)
1707 else if (c
== '\f' && print_escape_newlines
)
1713 && (CHAR_BYTE8_P (c
)
1714 || (! ASCII_CHAR_P (c
) && print_escape_multibyte
)))
1716 /* When multibyte is disabled,
1717 print multibyte string chars using hex escapes.
1718 For a char code that could be in a unibyte string,
1719 when found in a multibyte string, always use a hex escape
1720 so it reads back as multibyte. */
1721 unsigned char outbuf
[50];
1723 if (CHAR_BYTE8_P (c
))
1724 sprintf (outbuf
, "\\%03o", CHAR_TO_BYTE8 (c
));
1727 sprintf (outbuf
, "\\x%04x", c
);
1730 strout (outbuf
, -1, -1, printcharfun
, 0);
1732 else if (! multibyte
1733 && SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1734 && print_escape_nonascii
)
1736 /* When printing in a multibyte buffer
1737 or when explicitly requested,
1738 print single-byte non-ASCII string chars
1739 using octal escapes. */
1740 unsigned char outbuf
[5];
1741 sprintf (outbuf
, "\\%03o", c
);
1742 strout (outbuf
, -1, -1, printcharfun
, 0);
1746 /* If we just had a hex escape, and this character
1747 could be taken as part of it,
1748 output `\ ' to prevent that. */
1752 if ((c
>= 'a' && c
<= 'f')
1753 || (c
>= 'A' && c
<= 'F')
1754 || (c
>= '0' && c
<= '9'))
1755 strout ("\\ ", -1, -1, printcharfun
, 0);
1758 if (c
== '\"' || c
== '\\')
1765 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1767 traverse_intervals (STRING_INTERVALS (obj
),
1768 0, print_interval
, printcharfun
);
1778 register int confusing
;
1779 register unsigned char *p
= SDATA (SYMBOL_NAME (obj
));
1780 register unsigned char *end
= p
+ SBYTES (SYMBOL_NAME (obj
));
1782 int i
, i_byte
, size_byte
;
1785 name
= SYMBOL_NAME (obj
);
1787 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1790 /* If symbol name begins with a digit, and ends with a digit,
1791 and contains nothing but digits and `e', it could be treated
1792 as a number. So set CONFUSING.
1794 Symbols that contain periods could also be taken as numbers,
1795 but periods are always escaped, so we don't have to worry
1797 else if (*p
>= '0' && *p
<= '9'
1798 && end
[-1] >= '0' && end
[-1] <= '9')
1800 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1801 /* Needed for \2e10. */
1804 confusing
= (end
== p
);
1809 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1815 size_byte
= SBYTES (name
);
1817 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1819 /* Here, we must convert each multi-byte form to the
1820 corresponding character code before handing it to PRINTCHAR. */
1821 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1826 if (c
== '\"' || c
== '\\' || c
== '\''
1827 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1828 || c
== ',' || c
=='.' || c
== '`'
1829 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1831 PRINTCHAR ('\\'), confusing
= 0;
1839 /* If deeper than spec'd depth, print placeholder. */
1840 if (INTEGERP (Vprint_level
)
1841 && print_depth
> XINT (Vprint_level
))
1842 strout ("...", -1, -1, printcharfun
, 0);
1843 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1844 && (EQ (XCAR (obj
), Qquote
)))
1847 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1849 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1850 && (EQ (XCAR (obj
), Qfunction
)))
1854 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1856 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1857 && ((EQ (XCAR (obj
), Qbackquote
))))
1859 print_object (XCAR (obj
), printcharfun
, 0);
1860 new_backquote_output
++;
1861 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1862 new_backquote_output
--;
1864 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1865 && new_backquote_output
1866 && ((EQ (XCAR (obj
), Qbackquote
)
1867 || EQ (XCAR (obj
), Qcomma
)
1868 || EQ (XCAR (obj
), Qcomma_at
)
1869 || EQ (XCAR (obj
), Qcomma_dot
))))
1871 print_object (XCAR (obj
), printcharfun
, 0);
1872 new_backquote_output
--;
1873 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1874 new_backquote_output
++;
1880 /* If the first element is a backquote form,
1881 print it old-style so it won't be misunderstood. */
1882 if (print_quoted
&& CONSP (XCAR (obj
))
1883 && CONSP (XCDR (XCAR (obj
)))
1884 && NILP (XCDR (XCDR (XCAR (obj
))))
1885 && EQ (XCAR (XCAR (obj
)), Qbackquote
))
1891 print_object (Qbackquote
, printcharfun
, 0);
1894 print_object (XCAR (XCDR (tem
)), printcharfun
, 0);
1901 int print_length
, i
;
1902 Lisp_Object halftail
= obj
;
1904 /* Negative values of print-length are invalid in CL.
1905 Treat them like nil, as CMUCL does. */
1906 if (NATNUMP (Vprint_length
))
1907 print_length
= XFASTINT (Vprint_length
);
1914 /* Detect circular list. */
1915 if (NILP (Vprint_circle
))
1917 /* Simple but imcomplete way. */
1918 if (i
!= 0 && EQ (obj
, halftail
))
1920 sprintf (buf
, " . #%d", i
/ 2);
1921 strout (buf
, -1, -1, printcharfun
, 0);
1927 /* With the print-circle feature. */
1931 for (i
= 0; i
< print_number_index
; i
++)
1932 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
),
1935 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1937 strout (" . ", 3, 3, printcharfun
, 0);
1938 print_object (obj
, printcharfun
, escapeflag
);
1942 sprintf (buf
, " . #%d#", i
+ 1);
1943 strout (buf
, -1, -1, printcharfun
, 0);
1953 if (print_length
&& i
> print_length
)
1955 strout ("...", 3, 3, printcharfun
, 0);
1959 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1963 halftail
= XCDR (halftail
);
1967 /* OBJ non-nil here means it's the end of a dotted list. */
1970 strout (" . ", 3, 3, printcharfun
, 0);
1971 print_object (obj
, printcharfun
, escapeflag
);
1979 case Lisp_Vectorlike
:
1984 strout ("#<process ", -1, -1, printcharfun
, 0);
1985 print_string (XPROCESS (obj
)->name
, printcharfun
);
1989 print_string (XPROCESS (obj
)->name
, printcharfun
);
1991 else if (BOOL_VECTOR_P (obj
))
1994 register unsigned char c
;
1995 struct gcpro gcpro1
;
1997 = ((XBOOL_VECTOR (obj
)->size
+ BOOL_VECTOR_BITS_PER_CHAR
- 1)
1998 / BOOL_VECTOR_BITS_PER_CHAR
);
2004 sprintf (buf
, "%ld", (long) XBOOL_VECTOR (obj
)->size
);
2005 strout (buf
, -1, -1, printcharfun
, 0);
2008 /* Don't print more characters than the specified maximum.
2009 Negative values of print-length are invalid. Treat them
2010 like a print-length of nil. */
2011 if (NATNUMP (Vprint_length
)
2012 && XFASTINT (Vprint_length
) < size_in_chars
)
2013 size_in_chars
= XFASTINT (Vprint_length
);
2015 for (i
= 0; i
< size_in_chars
; i
++)
2018 c
= XBOOL_VECTOR (obj
)->data
[i
];
2019 if (! ASCII_BYTE_P (c
))
2021 sprintf (buf
, "\\%03o", c
);
2022 strout (buf
, -1, -1, printcharfun
, 0);
2024 else if (c
== '\n' && print_escape_newlines
)
2029 else if (c
== '\f' && print_escape_newlines
)
2034 else if (c
> '\177')
2036 /* Use octal escapes to avoid encoding issues. */
2038 PRINTCHAR ('0' + ((c
>> 6) & 3));
2039 PRINTCHAR ('0' + ((c
>> 3) & 7));
2040 PRINTCHAR ('0' + (c
& 7));
2044 if (c
== '\"' || c
== '\\')
2053 else if (SUBRP (obj
))
2055 strout ("#<subr ", -1, -1, printcharfun
, 0);
2056 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
2059 else if (WINDOWP (obj
))
2061 strout ("#<window ", -1, -1, printcharfun
, 0);
2062 sprintf (buf
, "%ld", (long) XFASTINT (XWINDOW (obj
)->sequence_number
));
2063 strout (buf
, -1, -1, printcharfun
, 0);
2064 if (!NILP (XWINDOW (obj
)->buffer
))
2066 strout (" on ", -1, -1, printcharfun
, 0);
2067 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
2071 else if (TERMINALP (obj
))
2073 struct terminal
*t
= XTERMINAL (obj
);
2074 strout ("#<terminal ", -1, -1, printcharfun
, 0);
2075 sprintf (buf
, "%d", t
->id
);
2076 strout (buf
, -1, -1, printcharfun
, 0);
2079 strout (" on ", -1, -1, printcharfun
, 0);
2080 strout (t
->name
, -1, -1, printcharfun
, 0);
2084 else if (HASH_TABLE_P (obj
))
2086 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
2087 strout ("#<hash-table", -1, -1, printcharfun
, 0);
2088 if (SYMBOLP (h
->test
))
2092 strout (SDATA (SYMBOL_NAME (h
->test
)), -1, -1, printcharfun
, 0);
2094 strout (SDATA (SYMBOL_NAME (h
->weak
)), -1, -1, printcharfun
, 0);
2096 sprintf (buf
, "%ld/%ld", (long) h
->count
,
2097 (long) XVECTOR (h
->next
)->size
);
2098 strout (buf
, -1, -1, printcharfun
, 0);
2100 sprintf (buf
, " 0x%lx", (unsigned long) h
);
2101 strout (buf
, -1, -1, printcharfun
, 0);
2104 else if (BUFFERP (obj
))
2106 if (NILP (XBUFFER (obj
)->name
))
2107 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
2108 else if (escapeflag
)
2110 strout ("#<buffer ", -1, -1, printcharfun
, 0);
2111 print_string (XBUFFER (obj
)->name
, printcharfun
);
2115 print_string (XBUFFER (obj
)->name
, printcharfun
);
2117 else if (WINDOW_CONFIGURATIONP (obj
))
2119 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
2121 else if (FRAMEP (obj
))
2123 strout ((FRAME_LIVE_P (XFRAME (obj
))
2124 ? "#<frame " : "#<dead frame "),
2125 -1, -1, printcharfun
, 0);
2126 print_string (XFRAME (obj
)->name
, printcharfun
);
2127 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
2128 strout (buf
, -1, -1, printcharfun
, 0);
2131 else if (FONTP (obj
))
2135 if (! FONT_OBJECT_P (obj
))
2137 if (FONT_SPEC_P (obj
))
2138 strout ("#<font-spec", -1, -1, printcharfun
, 0);
2140 strout ("#<font-entity", -1, -1, printcharfun
, 0);
2141 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2144 if (i
< FONT_WEIGHT_INDEX
|| i
> FONT_WIDTH_INDEX
)
2145 print_object (AREF (obj
, i
), printcharfun
, escapeflag
);
2147 print_object (font_style_symbolic (obj
, i
, 0),
2148 printcharfun
, escapeflag
);
2153 strout ("#<font-object ", -1, -1, printcharfun
, 0);
2154 print_object (AREF (obj
, FONT_NAME_INDEX
), printcharfun
,
2161 EMACS_INT size
= XVECTOR (obj
)->size
;
2162 if (COMPILEDP (obj
))
2165 size
&= PSEUDOVECTOR_SIZE_MASK
;
2167 if (CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
))
2169 /* We print a char-table as if it were a vector,
2170 lumping the parent and default slots in with the
2171 character slots. But we add #^ as a prefix. */
2174 if (SUB_CHAR_TABLE_P (obj
))
2176 size
&= PSEUDOVECTOR_SIZE_MASK
;
2178 if (size
& PSEUDOVECTOR_FLAG
)
2184 register Lisp_Object tem
;
2185 int real_size
= size
;
2187 /* Don't print more elements than the specified maximum. */
2188 if (NATNUMP (Vprint_length
)
2189 && XFASTINT (Vprint_length
) < size
)
2190 size
= XFASTINT (Vprint_length
);
2192 for (i
= 0; i
< size
; i
++)
2194 if (i
) PRINTCHAR (' ');
2195 tem
= XVECTOR (obj
)->contents
[i
];
2196 print_object (tem
, printcharfun
, escapeflag
);
2198 if (size
< real_size
)
2199 strout (" ...", 4, 4, printcharfun
, 0);
2206 switch (XMISCTYPE (obj
))
2208 case Lisp_Misc_Marker
:
2209 strout ("#<marker ", -1, -1, printcharfun
, 0);
2210 /* Do you think this is necessary? */
2211 if (XMARKER (obj
)->insertion_type
!= 0)
2212 strout ("(moves after insertion) ", -1, -1, printcharfun
, 0);
2213 if (! XMARKER (obj
)->buffer
)
2214 strout ("in no buffer", -1, -1, printcharfun
, 0);
2217 sprintf (buf
, "at %d", marker_position (obj
));
2218 strout (buf
, -1, -1, printcharfun
, 0);
2219 strout (" in ", -1, -1, printcharfun
, 0);
2220 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
2225 case Lisp_Misc_Overlay
:
2226 strout ("#<overlay ", -1, -1, printcharfun
, 0);
2227 if (! XMARKER (OVERLAY_START (obj
))->buffer
)
2228 strout ("in no buffer", -1, -1, printcharfun
, 0);
2231 sprintf (buf
, "from %d to %d in ",
2232 marker_position (OVERLAY_START (obj
)),
2233 marker_position (OVERLAY_END (obj
)));
2234 strout (buf
, -1, -1, printcharfun
, 0);
2235 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
2241 /* Remaining cases shouldn't happen in normal usage, but let's print
2242 them anyway for the benefit of the debugger. */
2243 case Lisp_Misc_Free
:
2244 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
2247 case Lisp_Misc_Intfwd
:
2248 sprintf (buf
, "#<intfwd to %ld>", (long) *XINTFWD (obj
)->intvar
);
2249 strout (buf
, -1, -1, printcharfun
, 0);
2252 case Lisp_Misc_Boolfwd
:
2253 sprintf (buf
, "#<boolfwd to %s>",
2254 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
2255 strout (buf
, -1, -1, printcharfun
, 0);
2258 case Lisp_Misc_Objfwd
:
2259 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
2260 print_object (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
2264 case Lisp_Misc_Buffer_Objfwd
:
2265 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
2266 print_object (PER_BUFFER_VALUE (current_buffer
,
2267 XBUFFER_OBJFWD (obj
)->offset
),
2268 printcharfun
, escapeflag
);
2272 case Lisp_Misc_Kboard_Objfwd
:
2273 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
2274 print_object (*(Lisp_Object
*) ((char *) current_kboard
2275 + XKBOARD_OBJFWD (obj
)->offset
),
2276 printcharfun
, escapeflag
);
2280 case Lisp_Misc_Buffer_Local_Value
:
2281 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
2282 if (XBUFFER_LOCAL_VALUE (obj
)->local_if_set
)
2283 strout ("[local-if-set] ", -1, -1, printcharfun
, 0);
2284 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
2285 print_object (XBUFFER_LOCAL_VALUE (obj
)->realvalue
,
2286 printcharfun
, escapeflag
);
2287 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
2288 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
2290 strout ("[buffer] ", -1, -1, printcharfun
, 0);
2291 print_object (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
2292 printcharfun
, escapeflag
);
2293 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
2295 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
2296 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
2298 strout ("[frame] ", -1, -1, printcharfun
, 0);
2299 print_object (XBUFFER_LOCAL_VALUE (obj
)->frame
,
2300 printcharfun
, escapeflag
);
2302 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
2303 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2304 printcharfun
, escapeflag
);
2305 strout ("[default-value] ", -1, -1, printcharfun
, 0);
2306 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2307 printcharfun
, escapeflag
);
2311 case Lisp_Misc_Save_Value
:
2312 strout ("#<save_value ", -1, -1, printcharfun
, 0);
2313 sprintf(buf
, "ptr=0x%08lx int=%d",
2314 (unsigned long) XSAVE_VALUE (obj
)->pointer
,
2315 XSAVE_VALUE (obj
)->integer
);
2316 strout (buf
, -1, -1, printcharfun
, 0);
2328 /* We're in trouble if this happens!
2329 Probably should just abort () */
2330 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
2332 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
2333 else if (VECTORLIKEP (obj
))
2334 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
2336 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
2337 strout (buf
, -1, -1, printcharfun
, 0);
2338 strout (" Save your buffers immediately and please report this bug>",
2339 -1, -1, printcharfun
, 0);
2347 /* Print a description of INTERVAL using PRINTCHARFUN.
2348 This is part of printing a string that has text properties. */
2351 print_interval (interval
, printcharfun
)
2353 Lisp_Object printcharfun
;
2355 if (NILP (interval
->plist
))
2358 print_object (make_number (interval
->position
), printcharfun
, 1);
2360 print_object (make_number (interval
->position
+ LENGTH (interval
)),
2363 print_object (interval
->plist
, printcharfun
, 1);
2370 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
2371 staticpro (&Qtemp_buffer_setup_hook
);
2373 DEFVAR_LISP ("standard-output", &Vstandard_output
,
2374 doc
: /* Output stream `print' uses by default for outputting a character.
2375 This may be any function of one argument.
2376 It may also be a buffer (output is inserted before point)
2377 or a marker (output is inserted and the marker is advanced)
2378 or the symbol t (output appears in the echo area). */);
2379 Vstandard_output
= Qt
;
2380 Qstandard_output
= intern ("standard-output");
2381 staticpro (&Qstandard_output
);
2383 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
2384 doc
: /* The format descriptor string used to print floats.
2385 This is a %-spec like those accepted by `printf' in C,
2386 but with some restrictions. It must start with the two characters `%.'.
2387 After that comes an integer precision specification,
2388 and then a letter which controls the format.
2389 The letters allowed are `e', `f' and `g'.
2390 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2391 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2392 Use `g' to choose the shorter of those two formats for the number at hand.
2393 The precision in any of these cases is the number of digits following
2394 the decimal point. With `f', a precision of 0 means to omit the
2395 decimal point. 0 is not allowed with `e' or `g'.
2397 A value of nil means to use the shortest notation
2398 that represents the number without losing information. */);
2399 Vfloat_output_format
= Qnil
;
2400 Qfloat_output_format
= intern ("float-output-format");
2401 staticpro (&Qfloat_output_format
);
2403 DEFVAR_LISP ("print-length", &Vprint_length
,
2404 doc
: /* Maximum length of list to print before abbreviating.
2405 A value of nil means no limit. See also `eval-expression-print-length'. */);
2406 Vprint_length
= Qnil
;
2408 DEFVAR_LISP ("print-level", &Vprint_level
,
2409 doc
: /* Maximum depth of list nesting to print before abbreviating.
2410 A value of nil means no limit. See also `eval-expression-print-level'. */);
2411 Vprint_level
= Qnil
;
2413 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
2414 doc
: /* Non-nil means print newlines in strings as `\\n'.
2415 Also print formfeeds as `\\f'. */);
2416 print_escape_newlines
= 0;
2418 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
2419 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2420 \(OOO is the octal representation of the character code.)
2421 Only single-byte characters are affected, and only in `prin1'.
2422 When the output goes in a multibyte buffer, this feature is
2423 enabled regardless of the value of the variable. */);
2424 print_escape_nonascii
= 0;
2426 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
2427 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2428 \(XXXX is the hex representation of the character code.)
2429 This affects only `prin1'. */);
2430 print_escape_multibyte
= 0;
2432 DEFVAR_BOOL ("print-quoted", &print_quoted
,
2433 doc
: /* Non-nil means print quoted forms with reader syntax.
2434 I.e., (quote foo) prints as 'foo, (function foo) as #'foo. */);
2437 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
2438 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2439 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2440 When the uninterned symbol appears within a recursive data structure,
2441 and the symbol appears more than once, in addition use the #N# and #N=
2442 constructs as needed, so that multiple references to the same symbol are
2443 shared once again when the text is read back. */);
2444 Vprint_gensym
= Qnil
;
2446 DEFVAR_LISP ("print-circle", &Vprint_circle
,
2447 doc
: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2448 If nil, printing proceeds recursively and may lead to
2449 `max-lisp-eval-depth' being exceeded or an error may occur:
2450 \"Apparently circular structure being printed.\" Also see
2451 `print-length' and `print-level'.
2452 If non-nil, shared substructures anywhere in the structure are printed
2453 with `#N=' before the first occurrence (in the order of the print
2454 representation) and `#N#' in place of each subsequent occurrence,
2455 where N is a positive decimal integer. */);
2456 Vprint_circle
= Qnil
;
2458 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
2459 doc
: /* *Non-nil means number continuously across print calls.
2460 This affects the numbers printed for #N= labels and #M# references.
2461 See also `print-circle', `print-gensym', and `print-number-table'.
2462 This variable should not be set with `setq'; bind it with a `let' instead. */);
2463 Vprint_continuous_numbering
= Qnil
;
2465 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
2466 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2467 The Lisp printer uses this vector to detect Lisp objects referenced more
2470 When you bind `print-continuous-numbering' to t, you should probably
2471 also bind `print-number-table' to nil. This ensures that the value of
2472 `print-number-table' can be garbage-collected once the printing is
2473 done. If all elements of `print-number-table' are nil, it means that
2474 the printing done so far has not found any shared structure or objects
2475 that need to be recorded in the table. */);
2476 Vprint_number_table
= Qnil
;
2478 DEFVAR_LISP ("print-charset-text-property", &Vprint_charset_text_property
,
2479 doc
: /* A flag to control printing of `charset' text property on printing a string.
2480 The value must be nil, t, or `default'.
2482 If the value is nil, don't print the text property `charset'.
2484 If the value is t, always print the text property `charset'.
2486 If the value is `default', print the text property `charset' only when
2487 the value is different from what is guessed in the current charset
2489 Vprint_charset_text_property
= Qdefault
;
2491 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2492 staticpro (&Vprin1_to_string_buffer
);
2495 defsubr (&Sprin1_to_string
);
2496 defsubr (&Serror_message_string
);
2500 defsubr (&Swrite_char
);
2501 defsubr (&Sexternal_debugging_output
);
2502 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2503 defsubr (&Sredirect_debugging_output
);
2506 Qexternal_debugging_output
= intern ("external-debugging-output");
2507 staticpro (&Qexternal_debugging_output
);
2509 Qprint_escape_newlines
= intern ("print-escape-newlines");
2510 staticpro (&Qprint_escape_newlines
);
2512 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
2513 staticpro (&Qprint_escape_multibyte
);
2515 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
2516 staticpro (&Qprint_escape_nonascii
);
2518 print_prune_charset_plist
= Qnil
;
2519 staticpro (&print_prune_charset_plist
);
2521 defsubr (&Swith_output_to_temp_buffer
);
2524 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2525 (do not change this comment) */