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 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 2, or (at your option)
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; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
28 #include "character.h"
34 #include "dispextern.h"
36 #include "intervals.h"
38 Lisp_Object Vstandard_output
, Qstandard_output
;
40 Lisp_Object Qtemp_buffer_setup_hook
;
42 /* These are used to print like we read. */
43 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
45 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
47 /* Work around a problem that happens because math.h on hpux 7
48 defines two static variables--which, in Emacs, are not really static,
49 because `static' is defined as nothing. The problem is that they are
50 defined both here and in lread.c.
51 These macros prevent the name conflict. */
52 #if defined (HPUX) && !defined (HPUX8)
53 #define _MAXLDBL print_maxldbl
54 #define _NMAXLDBL print_nmaxldbl
63 /* Default to values appropriate for IEEE floating point. */
68 #define DBL_MANT_DIG 53
74 #define DBL_MIN 2.2250738585072014e-308
77 #ifdef DBL_MIN_REPLACEMENT
79 #define DBL_MIN DBL_MIN_REPLACEMENT
82 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
83 needed to express a float without losing information.
84 The general-case formula is valid for the usual case, IEEE floating point,
85 but many compilers can't optimize the formula to an integer constant,
86 so make a special case for it. */
87 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
88 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
90 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
93 /* Avoid actual stack overflow in print. */
96 /* Nonzero if inside outputting backquote in old style. */
97 int old_backquote_output
;
99 /* Detect most circularities to print finite output. */
100 #define PRINT_CIRCLE 200
101 Lisp_Object being_printed
[PRINT_CIRCLE
];
103 /* When printing into a buffer, first we put the text in this
104 block, then insert it all at once. */
107 /* Size allocated in print_buffer. */
108 int print_buffer_size
;
109 /* Chars stored in print_buffer. */
110 int print_buffer_pos
;
111 /* Bytes stored in print_buffer. */
112 int print_buffer_pos_byte
;
114 /* Maximum length of list to print in full; noninteger means
115 effectively infinity */
117 Lisp_Object Vprint_length
;
119 /* Maximum depth of list to print in full; noninteger means
120 effectively infinity. */
122 Lisp_Object Vprint_level
;
124 /* Nonzero means print newlines in strings as \n. */
126 int print_escape_newlines
;
128 /* Nonzero means to print single-byte non-ascii characters in strings as
131 int print_escape_nonascii
;
133 /* Nonzero means to print multibyte characters in strings as hex escapes. */
135 int print_escape_multibyte
;
137 Lisp_Object Qprint_escape_newlines
;
138 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
140 /* Nonzero means print (quote foo) forms as 'foo, etc. */
144 /* Non-nil means print #: before uninterned symbols. */
146 Lisp_Object Vprint_gensym
;
148 /* Non-nil means print recursive structures using #n= and #n# syntax. */
150 Lisp_Object Vprint_circle
;
152 /* Non-nil means keep continuous number for #n= and #n# syntax
153 between several print functions. */
155 Lisp_Object Vprint_continuous_numbering
;
157 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
158 where OBJn are objects going to be printed, and STATn are their status,
159 which may be different meanings during process. See the comments of
160 the functions print and print_preprocess for details.
161 print_number_index keeps the last position the next object should be added,
162 twice of which is the actual vector position in Vprint_number_table. */
163 int print_number_index
;
164 Lisp_Object Vprint_number_table
;
166 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
167 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
168 See the comment of the variable Vprint_number_table. */
169 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
170 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
172 /* Nonzero means print newline to stdout before next minibuffer message.
173 Defined in xdisp.c */
175 extern int noninteractive_need_newline
;
177 extern int minibuffer_auto_raise
;
179 #ifdef MAX_PRINT_CHARS
180 static int print_chars
;
181 static int max_print
;
182 #endif /* MAX_PRINT_CHARS */
184 void print_interval ();
187 /* Low level output routines for characters and strings */
189 /* Lisp functions to do output using a stream
190 must have the stream in a variable called printcharfun
191 and must start with PRINTPREPARE, end with PRINTFINISH,
192 and use PRINTDECLARE to declare common variables.
193 Use PRINTCHAR to output one character,
194 or call strout to output a block of characters. */
196 #define PRINTDECLARE \
197 struct buffer *old = current_buffer; \
198 int old_point = -1, start_point = -1; \
199 int old_point_byte = -1, start_point_byte = -1; \
200 int specpdl_count = SPECPDL_INDEX (); \
201 int free_print_buffer = 0; \
202 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
205 #define PRINTPREPARE \
206 original = printcharfun; \
207 if (NILP (printcharfun)) printcharfun = Qt; \
208 if (BUFFERP (printcharfun)) \
210 if (XBUFFER (printcharfun) != current_buffer) \
211 Fset_buffer (printcharfun); \
212 printcharfun = Qnil; \
214 if (MARKERP (printcharfun)) \
216 EMACS_INT marker_pos; \
217 if (!(XMARKER (printcharfun)->buffer)) \
218 error ("Marker does not point anywhere"); \
219 if (XMARKER (printcharfun)->buffer != current_buffer) \
220 set_buffer_internal (XMARKER (printcharfun)->buffer); \
221 marker_pos = marker_position (printcharfun); \
222 if (marker_pos < BEGV || marker_pos > ZV) \
223 error ("Marker is outside the accessible part of the buffer"); \
225 old_point_byte = PT_BYTE; \
226 SET_PT_BOTH (marker_pos, \
227 marker_byte_position (printcharfun)); \
229 start_point_byte = PT_BYTE; \
230 printcharfun = Qnil; \
232 if (NILP (printcharfun)) \
234 Lisp_Object string; \
235 if (NILP (current_buffer->enable_multibyte_characters) \
236 && ! print_escape_multibyte) \
237 specbind (Qprint_escape_multibyte, Qt); \
238 if (! NILP (current_buffer->enable_multibyte_characters) \
239 && ! print_escape_nonascii) \
240 specbind (Qprint_escape_nonascii, Qt); \
241 if (print_buffer != 0) \
243 string = make_string_from_bytes (print_buffer, \
245 print_buffer_pos_byte); \
246 record_unwind_protect (print_unwind, string); \
250 print_buffer_size = 1000; \
251 print_buffer = (char *) xmalloc (print_buffer_size); \
252 free_print_buffer = 1; \
254 print_buffer_pos = 0; \
255 print_buffer_pos_byte = 0; \
257 if (EQ (printcharfun, Qt) && ! noninteractive) \
258 setup_echo_area_for_printing (multibyte);
260 #define PRINTFINISH \
261 if (NILP (printcharfun)) \
263 if (print_buffer_pos != print_buffer_pos_byte \
264 && NILP (current_buffer->enable_multibyte_characters)) \
266 unsigned char *temp \
267 = (unsigned char *) alloca (print_buffer_pos + 1); \
268 copy_text (print_buffer, temp, print_buffer_pos_byte, \
270 insert_1_both (temp, print_buffer_pos, \
271 print_buffer_pos, 0, 1, 0); \
274 insert_1_both (print_buffer, print_buffer_pos, \
275 print_buffer_pos_byte, 0, 1, 0); \
277 if (free_print_buffer) \
279 xfree (print_buffer); \
282 unbind_to (specpdl_count, Qnil); \
283 if (MARKERP (original)) \
284 set_marker_both (original, Qnil, PT, PT_BYTE); \
285 if (old_point >= 0) \
286 SET_PT_BOTH (old_point + (old_point >= start_point \
287 ? PT - start_point : 0), \
288 old_point_byte + (old_point_byte >= start_point_byte \
289 ? PT_BYTE - start_point_byte : 0)); \
290 if (old != current_buffer) \
291 set_buffer_internal (old);
293 #define PRINTCHAR(ch) printchar (ch, printcharfun)
295 /* This is used to restore the saved contents of print_buffer
296 when there is a recursive call to print. */
299 print_unwind (saved_text
)
300 Lisp_Object saved_text
;
302 bcopy (SDATA (saved_text
), print_buffer
, SCHARS (saved_text
));
307 /* Print character CH using method FUN. FUN nil means print to
308 print_buffer. FUN t means print to echo area or stdout if
309 non-interactive. If FUN is neither nil nor t, call FUN with CH as
317 #ifdef MAX_PRINT_CHARS
320 #endif /* MAX_PRINT_CHARS */
322 if (!NILP (fun
) && !EQ (fun
, Qt
))
323 call1 (fun
, make_number (ch
));
326 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
327 int len
= CHAR_STRING (ch
, str
);
333 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
334 print_buffer
= (char *) xrealloc (print_buffer
,
335 print_buffer_size
*= 2);
336 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
337 print_buffer_pos
+= 1;
338 print_buffer_pos_byte
+= len
;
340 else if (noninteractive
)
342 fwrite (str
, 1, len
, stdout
);
343 noninteractive_need_newline
= 1;
348 = !NILP (current_buffer
->enable_multibyte_characters
);
350 setup_echo_area_for_printing (multibyte_p
);
352 message_dolog (str
, len
, 0, multibyte_p
);
358 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
359 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
360 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
361 print_buffer. PRINTCHARFUN t means output to the echo area or to
362 stdout if non-interactive. If neither nil nor t, call Lisp
363 function PRINTCHARFUN for each character printed. MULTIBYTE
364 non-zero means PTR contains multibyte characters. */
367 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
370 Lisp_Object printcharfun
;
374 size_byte
= size
= strlen (ptr
);
376 if (NILP (printcharfun
))
378 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
380 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
381 print_buffer
= (char *) xrealloc (print_buffer
,
384 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
385 print_buffer_pos
+= size
;
386 print_buffer_pos_byte
+= size_byte
;
388 #ifdef MAX_PRINT_CHARS
391 #endif /* MAX_PRINT_CHARS */
393 else if (noninteractive
&& EQ (printcharfun
, Qt
))
395 fwrite (ptr
, 1, size_byte
, stdout
);
396 noninteractive_need_newline
= 1;
398 else if (EQ (printcharfun
, Qt
))
400 /* Output to echo area. We're trying to avoid a little overhead
401 here, that's the reason we don't call printchar to do the
405 = !NILP (current_buffer
->enable_multibyte_characters
);
407 setup_echo_area_for_printing (multibyte_p
);
408 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
410 if (size
== size_byte
)
412 for (i
= 0; i
< size
; ++i
)
413 insert_char ((unsigned char )*ptr
++);
418 for (i
= 0; i
< size_byte
; i
+= len
)
420 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
425 #ifdef MAX_PRINT_CHARS
428 #endif /* MAX_PRINT_CHARS */
432 /* PRINTCHARFUN is a Lisp function. */
435 if (size
== size_byte
)
437 while (i
< size_byte
)
445 while (i
< size_byte
)
447 /* Here, we must convert each multi-byte form to the
448 corresponding character code before handing it to
451 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
459 /* Print the contents of a string STRING using PRINTCHARFUN.
460 It isn't safe to use strout in many cases,
461 because printing one char can relocate. */
464 print_string (string
, printcharfun
)
466 Lisp_Object printcharfun
;
468 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
472 if (print_escape_nonascii
)
473 string
= string_escape_byte8 (string
);
475 if (STRING_MULTIBYTE (string
))
476 chars
= SCHARS (string
);
477 else if (! print_escape_nonascii
478 && (EQ (printcharfun
, Qt
)
479 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
480 : ! NILP (current_buffer
->enable_multibyte_characters
)))
482 /* If unibyte string STRING contains 8-bit codes, we must
483 convert STRING to a multibyte string containing the same
488 chars
= SBYTES (string
);
489 bytes
= parse_str_to_multibyte (SDATA (string
), chars
);
492 newstr
= make_uninit_multibyte_string (chars
, bytes
);
493 bcopy (SDATA (string
), SDATA (newstr
), chars
);
494 str_to_multibyte (SDATA (newstr
), bytes
, chars
);
499 chars
= SBYTES (string
);
501 /* strout is safe for output to a frame (echo area) or to print_buffer. */
502 strout (SDATA (string
),
503 chars
, SBYTES (string
),
504 printcharfun
, STRING_MULTIBYTE (string
));
508 /* Otherwise, string may be relocated by printing one char.
509 So re-fetch the string address for each character. */
511 int size
= SCHARS (string
);
512 int size_byte
= SBYTES (string
);
515 if (size
== size_byte
)
516 for (i
= 0; i
< size
; i
++)
517 PRINTCHAR (SREF (string
, i
));
519 for (i
= 0; i
< size_byte
; )
521 /* Here, we must convert each multi-byte form to the
522 corresponding character code before handing it to PRINTCHAR. */
524 int ch
= STRING_CHAR_AND_LENGTH (SDATA (string
) + i
,
533 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
534 doc
: /* Output character CHARACTER to stream PRINTCHARFUN.
535 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
536 (character
, printcharfun
)
537 Lisp_Object character
, printcharfun
;
541 if (NILP (printcharfun
))
542 printcharfun
= Vstandard_output
;
543 CHECK_NUMBER (character
);
545 PRINTCHAR (XINT (character
));
550 /* Used from outside of print.c to print a block of SIZE
551 single-byte chars at DATA on the default output stream.
552 Do not use this on the contents of a Lisp string. */
555 write_string (data
, size
)
560 Lisp_Object printcharfun
;
562 printcharfun
= Vstandard_output
;
565 strout (data
, size
, size
, printcharfun
, 0);
569 /* Used from outside of print.c to print a block of SIZE
570 single-byte chars at DATA on a specified stream PRINTCHARFUN.
571 Do not use this on the contents of a Lisp string. */
574 write_string_1 (data
, size
, printcharfun
)
577 Lisp_Object printcharfun
;
582 strout (data
, size
, size
, printcharfun
, 0);
588 temp_output_buffer_setup (bufname
)
591 int count
= SPECPDL_INDEX ();
592 register struct buffer
*old
= current_buffer
;
593 register Lisp_Object buf
;
595 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
597 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
599 Fkill_all_local_variables ();
600 delete_all_overlays (current_buffer
);
601 current_buffer
->directory
= old
->directory
;
602 current_buffer
->read_only
= Qnil
;
603 current_buffer
->filename
= Qnil
;
604 current_buffer
->undo_list
= Qt
;
605 eassert (current_buffer
->overlays_before
== NULL
);
606 eassert (current_buffer
->overlays_after
== NULL
);
607 current_buffer
->enable_multibyte_characters
608 = buffer_defaults
.enable_multibyte_characters
;
609 specbind (Qinhibit_read_only
, Qt
);
610 specbind (Qinhibit_modification_hooks
, Qt
);
612 XSETBUFFER (buf
, current_buffer
);
614 Frun_hooks (1, &Qtemp_buffer_setup_hook
);
616 unbind_to (count
, Qnil
);
618 specbind (Qstandard_output
, buf
);
622 internal_with_output_to_temp_buffer (bufname
, function
, args
)
624 Lisp_Object (*function
) P_ ((Lisp_Object
));
627 int count
= SPECPDL_INDEX ();
628 Lisp_Object buf
, val
;
632 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
633 temp_output_buffer_setup (bufname
);
634 buf
= Vstandard_output
;
637 val
= (*function
) (args
);
640 temp_output_buffer_show (buf
);
643 return unbind_to (count
, val
);
646 DEFUN ("with-output-to-temp-buffer",
647 Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
649 doc
: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
650 The buffer is cleared out initially, and marked as unmodified when done.
651 All output done by BODY is inserted in that buffer by default.
652 The buffer is displayed in another window, but not selected.
653 The value of the last form in BODY is returned.
654 If BODY does not finish normally, the buffer BUFNAME is not displayed.
656 The hook `temp-buffer-setup-hook' is run before BODY,
657 with the buffer BUFNAME temporarily current.
658 The hook `temp-buffer-show-hook' is run after the buffer is displayed,
659 with the buffer temporarily current, and the window that was used
660 to display it temporarily selected.
662 If variable `temp-buffer-show-function' is non-nil, call it at the end
663 to get the buffer displayed instead of just displaying the non-selected
664 buffer and calling the hook. It gets one argument, the buffer to display.
666 usage: (with-output-to-temp-buffer BUFNAME BODY ...) */)
672 int count
= SPECPDL_INDEX ();
673 Lisp_Object buf
, val
;
676 name
= Feval (Fcar (args
));
678 temp_output_buffer_setup (SDATA (name
));
679 buf
= Vstandard_output
;
682 val
= Fprogn (XCDR (args
));
685 temp_output_buffer_show (buf
);
688 return unbind_to (count
, val
);
692 static void print ();
693 static void print_preprocess ();
694 static void print_preprocess_string ();
695 static void print_object ();
697 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
698 doc
: /* Output a newline to stream PRINTCHARFUN.
699 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
701 Lisp_Object printcharfun
;
705 if (NILP (printcharfun
))
706 printcharfun
= Vstandard_output
;
713 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
714 doc
: /* Output the printed representation of OBJECT, any Lisp object.
715 Quoting characters are printed when needed to make output that `read'
716 can handle, whenever this is possible. For complex objects, the behavior
717 is controlled by `print-level' and `print-length', which see.
719 OBJECT is any of the Lisp data types: a number, a string, a symbol,
720 a list, a buffer, a window, a frame, etc.
722 A printed representation of an object is text which describes that object.
724 Optional argument PRINTCHARFUN is the output stream, which can be one
727 - a buffer, in which case output is inserted into that buffer at point;
728 - a marker, in which case output is inserted at marker's position;
729 - a function, in which case that function is called once for each
730 character of OBJECT's printed representation;
731 - a symbol, in which case that symbol's function definition is called; or
732 - t, in which case the output is displayed in the echo area.
734 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
736 (object
, printcharfun
)
737 Lisp_Object object
, printcharfun
;
741 #ifdef MAX_PRINT_CHARS
743 #endif /* MAX_PRINT_CHARS */
744 if (NILP (printcharfun
))
745 printcharfun
= Vstandard_output
;
747 print (object
, printcharfun
, 1);
752 /* a buffer which is used to hold output being built by prin1-to-string */
753 Lisp_Object Vprin1_to_string_buffer
;
755 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
756 doc
: /* Return a string containing the printed representation of OBJECT.
757 OBJECT can be any Lisp object. This function outputs quoting characters
758 when necessary to make output that `read' can handle, whenever possible,
759 unless the optional second argument NOESCAPE is non-nil.
761 OBJECT is any of the Lisp data types: a number, a string, a symbol,
762 a list, a buffer, a window, a frame, etc.
764 A printed representation of an object is text which describes that object. */)
766 Lisp_Object object
, noescape
;
768 Lisp_Object printcharfun
;
769 /* struct gcpro gcpro1, gcpro2; */
770 Lisp_Object save_deactivate_mark
;
771 int count
= specpdl_ptr
- specpdl
;
772 struct buffer
*previous
;
774 specbind (Qinhibit_modification_hooks
, Qt
);
779 /* Save and restore this--we are altering a buffer
780 but we don't want to deactivate the mark just for that.
781 No need for specbind, since errors deactivate the mark. */
782 save_deactivate_mark
= Vdeactivate_mark
;
783 /* GCPRO2 (object, save_deactivate_mark); */
786 printcharfun
= Vprin1_to_string_buffer
;
788 print (object
, printcharfun
, NILP (noescape
));
789 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
793 previous
= current_buffer
;
794 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
795 object
= Fbuffer_string ();
796 if (SBYTES (object
) == SCHARS (object
))
797 STRING_SET_UNIBYTE (object
);
799 /* Note that this won't make prepare_to_modify_buffer call
800 ask-user-about-supersession-threat because this buffer
801 does not visit a file. */
803 set_buffer_internal (previous
);
805 Vdeactivate_mark
= save_deactivate_mark
;
809 return unbind_to (count
, object
);
812 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
813 doc
: /* Output the printed representation of OBJECT, any Lisp object.
814 No quoting characters are used; no delimiters are printed around
815 the contents of strings.
817 OBJECT is any of the Lisp data types: a number, a string, a symbol,
818 a list, a buffer, a window, a frame, etc.
820 A printed representation of an object is text which describes that object.
822 Optional argument PRINTCHARFUN is the output stream, which can be one
825 - a buffer, in which case output is inserted into that buffer at point;
826 - a marker, in which case output is inserted at marker's position;
827 - a function, in which case that function is called once for each
828 character of OBJECT's printed representation;
829 - a symbol, in which case that symbol's function definition is called; or
830 - t, in which case the output is displayed in the echo area.
832 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
834 (object
, printcharfun
)
835 Lisp_Object object
, printcharfun
;
839 if (NILP (printcharfun
))
840 printcharfun
= Vstandard_output
;
842 print (object
, printcharfun
, 0);
847 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
848 doc
: /* Output the printed representation of OBJECT, with newlines around it.
849 Quoting characters are printed when needed to make output that `read'
850 can handle, whenever this is possible. For complex objects, the behavior
851 is controlled by `print-level' and `print-length', which see.
853 OBJECT is any of the Lisp data types: a number, a string, a symbol,
854 a list, a buffer, a window, a frame, etc.
856 A printed representation of an object is text which describes that object.
858 Optional argument PRINTCHARFUN is the output stream, which can be one
861 - a buffer, in which case output is inserted into that buffer at point;
862 - a marker, in which case output is inserted at marker's position;
863 - a function, in which case that function is called once for each
864 character of OBJECT's printed representation;
865 - a symbol, in which case that symbol's function definition is called; or
866 - t, in which case the output is displayed in the echo area.
868 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
870 (object
, printcharfun
)
871 Lisp_Object object
, printcharfun
;
876 #ifdef MAX_PRINT_CHARS
878 max_print
= MAX_PRINT_CHARS
;
879 #endif /* MAX_PRINT_CHARS */
880 if (NILP (printcharfun
))
881 printcharfun
= Vstandard_output
;
885 print (object
, printcharfun
, 1);
888 #ifdef MAX_PRINT_CHARS
891 #endif /* MAX_PRINT_CHARS */
896 /* The subroutine object for external-debugging-output is kept here
897 for the convenience of the debugger. */
898 Lisp_Object Qexternal_debugging_output
;
900 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
901 doc
: /* Write CHARACTER to stderr.
902 You can call print while debugging emacs, and pass it this function
903 to make it write to the debugging output. */)
905 Lisp_Object character
;
907 CHECK_NUMBER (character
);
908 putc (XINT (character
), stderr
);
911 /* Send the output to a debugger (nothing happens if there isn't one). */
913 char buf
[2] = {(char) XINT (character
), '\0'};
914 OutputDebugString (buf
);
922 #if defined(GNU_LINUX)
924 /* This functionality is not vitally important in general, so we rely on
925 non-portable ability to use stderr as lvalue. */
927 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
929 FILE *initial_stderr_stream
= NULL
;
931 DEFUN ("redirect-debugging-output", Fredirect_debugging_output
, Sredirect_debugging_output
,
933 "FDebug output file: \nP",
934 doc
: /* Redirect debugging output (stderr stream) to file FILE.
935 If FILE is nil, reset target to the initial stderr stream.
936 Optional arg APPEND non-nil (interactively, with prefix arg) means
937 append to existing target file. */)
939 Lisp_Object file
, append
;
941 if (initial_stderr_stream
!= NULL
)
943 stderr
= initial_stderr_stream
;
944 initial_stderr_stream
= NULL
;
948 file
= Fexpand_file_name (file
, Qnil
);
949 initial_stderr_stream
= stderr
;
950 stderr
= fopen(SDATA (file
), NILP (append
) ? "w" : "a");
953 stderr
= initial_stderr_stream
;
954 initial_stderr_stream
= NULL
;
955 report_file_error ("Cannot open debugging output stream",
961 #endif /* GNU_LINUX */
964 /* This is the interface for debugging printing. */
970 Fprin1 (arg
, Qexternal_debugging_output
);
971 fprintf (stderr
, "\r\n");
975 safe_debug_print (arg
)
978 int valid
= valid_lisp_object_p (arg
);
983 fprintf (stderr
, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
984 !valid
? "INVALID" : "SOME",
988 (unsigned long) arg
.i
994 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
996 doc
: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
997 See Info anchor `(elisp)Definition of signal' for some details on how this
998 error message is constructed. */)
1002 struct buffer
*old
= current_buffer
;
1004 struct gcpro gcpro1
;
1006 /* If OBJ is (error STRING), just return STRING.
1007 That is not only faster, it also avoids the need to allocate
1008 space here when the error is due to memory full. */
1009 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
1010 && CONSP (XCDR (obj
))
1011 && STRINGP (XCAR (XCDR (obj
)))
1012 && NILP (XCDR (XCDR (obj
))))
1013 return XCAR (XCDR (obj
));
1015 print_error_message (obj
, Vprin1_to_string_buffer
, 0, Qnil
);
1017 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
1018 value
= Fbuffer_string ();
1022 set_buffer_internal (old
);
1028 /* Print an error message for the error DATA onto Lisp output stream
1029 STREAM (suitable for the print functions). */
1032 print_error_message (data
, stream
, context
, caller
)
1033 Lisp_Object data
, stream
;
1037 Lisp_Object errname
, errmsg
, file_error
, tail
;
1038 struct gcpro gcpro1
;
1042 write_string_1 (context
, -1, stream
);
1044 /* If we know from where the error was signaled, show it in
1046 if (!NILP (caller
) && SYMBOLP (caller
))
1048 Lisp_Object cname
= SYMBOL_NAME (caller
);
1049 char *name
= alloca (SBYTES (cname
));
1050 bcopy (SDATA (cname
), name
, SBYTES (cname
));
1051 message_dolog (name
, SBYTES (cname
), 0, 0);
1052 message_dolog (": ", 2, 0, 0);
1055 errname
= Fcar (data
);
1057 if (EQ (errname
, Qerror
))
1062 errmsg
= Fcar (data
);
1067 Lisp_Object error_conditions
;
1068 errmsg
= Fget (errname
, Qerror_message
);
1069 error_conditions
= Fget (errname
, Qerror_conditions
);
1070 file_error
= Fmemq (Qfile_error
, error_conditions
);
1073 /* Print an error message including the data items. */
1075 tail
= Fcdr_safe (data
);
1078 /* For file-error, make error message by concatenating
1079 all the data items. They are all strings. */
1080 if (!NILP (file_error
) && CONSP (tail
))
1081 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
1083 if (STRINGP (errmsg
))
1084 Fprinc (errmsg
, stream
);
1086 write_string_1 ("peculiar error", -1, stream
);
1088 for (i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
1092 write_string_1 (i
? ", " : ": ", 2, stream
);
1094 if (!NILP (file_error
) || EQ (errname
, Qend_of_file
))
1095 Fprinc (obj
, stream
);
1097 Fprin1 (obj
, stream
);
1106 * The buffer should be at least as large as the max string size of the
1107 * largest float, printed in the biggest notation. This is undoubtedly
1108 * 20d float_output_format, with the negative of the C-constant "HUGE"
1111 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1113 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1114 * case of -1e307 in 20d float_output_format. What is one to do (short of
1115 * re-writing _doprnt to be more sane)?
1120 float_to_string (buf
, data
)
1127 /* Check for plus infinity in a way that won't lose
1128 if there is no plus infinity. */
1129 if (data
== data
/ 2 && data
> 1.0)
1131 strcpy (buf
, "1.0e+INF");
1134 /* Likewise for minus infinity. */
1135 if (data
== data
/ 2 && data
< -1.0)
1137 strcpy (buf
, "-1.0e+INF");
1140 /* Check for NaN in a way that won't fail if there are no NaNs. */
1141 if (! (data
* 0.0 >= 0.0))
1143 /* Prepend "-" if the NaN's sign bit is negative.
1144 The sign bit of a double is the bit that is 1 in -0.0. */
1146 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
1148 u_minus_zero
.d
= - 0.0;
1149 for (i
= 0; i
< sizeof (double); i
++)
1150 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1156 strcpy (buf
, "0.0e+NaN");
1160 if (NILP (Vfloat_output_format
)
1161 || !STRINGP (Vfloat_output_format
))
1164 /* Generate the fewest number of digits that represent the
1165 floating point value without losing information.
1166 The following method is simple but a bit slow.
1167 For ideas about speeding things up, please see:
1169 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1170 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1172 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1173 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1175 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1177 sprintf (buf
, "%.*g", width
, data
);
1178 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1180 else /* oink oink */
1182 /* Check that the spec we have is fully valid.
1183 This means not only valid for printf,
1184 but meant for floats, and reasonable. */
1185 cp
= SDATA (Vfloat_output_format
);
1194 /* Check the width specification. */
1196 if ('0' <= *cp
&& *cp
<= '9')
1200 width
= (width
* 10) + (*cp
++ - '0');
1201 while (*cp
>= '0' && *cp
<= '9');
1203 /* A precision of zero is valid only for %f. */
1205 || (width
== 0 && *cp
!= 'f'))
1209 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1215 sprintf (buf
, SDATA (Vfloat_output_format
), data
);
1218 /* Make sure there is a decimal point with digit after, or an
1219 exponent, so that the value is readable as a float. But don't do
1220 this with "%.0f"; it's valid for that not to produce a decimal
1221 point. Note that width can be 0 only for %.0f. */
1224 for (cp
= buf
; *cp
; cp
++)
1225 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1228 if (*cp
== '.' && cp
[1] == 0)
1245 print (obj
, printcharfun
, escapeflag
)
1247 register Lisp_Object printcharfun
;
1250 old_backquote_output
= 0;
1252 /* Reset print_number_index and Vprint_number_table only when
1253 the variable Vprint_continuous_numbering is nil. Otherwise,
1254 the values of these variables will be kept between several
1256 if (NILP (Vprint_continuous_numbering
))
1258 print_number_index
= 0;
1259 Vprint_number_table
= Qnil
;
1262 /* Construct Vprint_number_table for print-gensym and print-circle. */
1263 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1265 int i
, start
, index
;
1266 start
= index
= print_number_index
;
1267 /* Construct Vprint_number_table.
1268 This increments print_number_index for the objects added. */
1270 print_preprocess (obj
);
1272 /* Remove unnecessary objects, which appear only once in OBJ;
1273 that is, whose status is Qnil. Compactify the necessary objects. */
1274 for (i
= start
; i
< print_number_index
; i
++)
1275 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1277 PRINT_NUMBER_OBJECT (Vprint_number_table
, index
)
1278 = PRINT_NUMBER_OBJECT (Vprint_number_table
, i
);
1282 /* Clear out objects outside the active part of the table. */
1283 for (i
= index
; i
< print_number_index
; i
++)
1284 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
) = Qnil
;
1286 /* Reset the status field for the next print step. Now this
1287 field means whether the object has already been printed. */
1288 for (i
= start
; i
< print_number_index
; i
++)
1289 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qnil
;
1291 print_number_index
= index
;
1295 print_object (obj
, printcharfun
, escapeflag
);
1298 /* Construct Vprint_number_table according to the structure of OBJ.
1299 OBJ itself and all its elements will be added to Vprint_number_table
1300 recursively if it is a list, vector, compiled function, char-table,
1301 string (its text properties will be traced), or a symbol that has
1302 no obarray (this is for the print-gensym feature).
1303 The status fields of Vprint_number_table mean whether each object appears
1304 more than once in OBJ: Qnil at the first time, and Qt after that . */
1306 print_preprocess (obj
)
1312 Lisp_Object halftail
;
1314 /* Give up if we go so deep that print_object will get an error. */
1315 /* See similar code in print_object. */
1316 if (print_depth
>= PRINT_CIRCLE
)
1317 error ("Apparently circular structure being printed");
1319 /* Avoid infinite recursion for circular nested structure
1320 in the case where Vprint_circle is nil. */
1321 if (NILP (Vprint_circle
))
1323 for (i
= 0; i
< print_depth
; i
++)
1324 if (EQ (obj
, being_printed
[i
]))
1326 being_printed
[print_depth
] = obj
;
1333 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1334 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1335 || (! NILP (Vprint_gensym
)
1337 && !SYMBOL_INTERNED_P (obj
)))
1339 /* In case print-circle is nil and print-gensym is t,
1340 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1341 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1343 for (i
= 0; i
< print_number_index
; i
++)
1344 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1346 /* OBJ appears more than once. Let's remember that. */
1347 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1352 /* OBJ is not yet recorded. Let's add to the table. */
1353 if (print_number_index
== 0)
1355 /* Initialize the table. */
1356 Vprint_number_table
= Fmake_vector (make_number (40), Qnil
);
1358 else if (XVECTOR (Vprint_number_table
)->size
== print_number_index
* 2)
1360 /* Reallocate the table. */
1361 int i
= print_number_index
* 4;
1362 Lisp_Object old_table
= Vprint_number_table
;
1363 Vprint_number_table
= Fmake_vector (make_number (i
), Qnil
);
1364 for (i
= 0; i
< print_number_index
; i
++)
1366 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
)
1367 = PRINT_NUMBER_OBJECT (old_table
, i
);
1368 PRINT_NUMBER_STATUS (Vprint_number_table
, i
)
1369 = PRINT_NUMBER_STATUS (old_table
, i
);
1372 PRINT_NUMBER_OBJECT (Vprint_number_table
, print_number_index
) = obj
;
1373 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1374 always print the gensym with a number. This is a special for
1375 the lisp function byte-compile-output-docform. */
1376 if (!NILP (Vprint_continuous_numbering
)
1378 && !SYMBOL_INTERNED_P (obj
))
1379 PRINT_NUMBER_STATUS (Vprint_number_table
, print_number_index
) = Qt
;
1380 print_number_index
++;
1383 switch (XGCTYPE (obj
))
1386 /* A string may have text properties, which can be circular. */
1387 traverse_intervals_noorder (STRING_INTERVALS (obj
),
1388 print_preprocess_string
, Qnil
);
1392 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1393 just as in print_object. */
1394 if (loop_count
&& EQ (obj
, halftail
))
1396 print_preprocess (XCAR (obj
));
1399 if (!(loop_count
& 1))
1400 halftail
= XCDR (halftail
);
1403 case Lisp_Vectorlike
:
1404 size
= XVECTOR (obj
)->size
;
1405 if (size
& PSEUDOVECTOR_FLAG
)
1406 size
&= PSEUDOVECTOR_SIZE_MASK
;
1407 for (i
= 0; i
< size
; i
++)
1408 print_preprocess (XVECTOR (obj
)->contents
[i
]);
1419 print_preprocess_string (interval
, arg
)
1423 print_preprocess (interval
->plist
);
1426 /* A flag to control printing of `charset' text property.
1427 The default value is Qdefault. */
1428 Lisp_Object Vprint_charset_text_property
;
1429 extern Lisp_Object Qdefault
;
1431 static void print_check_string_charset_prop ();
1433 #define PRINT_STRING_NON_CHARSET_FOUND 1
1434 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
1436 /* Bitwize or of the abobe macros. */
1437 static int print_check_string_result
;
1440 print_check_string_charset_prop (interval
, string
)
1446 if (NILP (interval
->plist
)
1447 || (print_check_string_result
== (PRINT_STRING_NON_CHARSET_FOUND
1448 | PRINT_STRING_UNSAFE_CHARSET_FOUND
)))
1450 for (val
= interval
->plist
; CONSP (val
) && ! EQ (XCAR (val
), Qcharset
);
1451 val
= XCDR (XCDR (val
)));
1454 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1457 if (! (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
))
1459 if (! EQ (val
, interval
->plist
)
1460 || CONSP (XCDR (XCDR (val
))))
1461 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1463 if (NILP (Vprint_charset_text_property
)
1464 || ! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1467 int charpos
= interval
->position
;
1468 int bytepos
= string_char_to_byte (string
, charpos
);
1469 Lisp_Object charset
;
1471 charset
= XCAR (XCDR (val
));
1472 for (i
= 0; i
< LENGTH (interval
); i
++)
1474 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1475 if (! ASCII_CHAR_P (c
)
1476 && ! EQ (CHARSET_NAME (CHAR_CHARSET (c
)), charset
))
1478 print_check_string_result
|= PRINT_STRING_UNSAFE_CHARSET_FOUND
;
1485 /* The value is (charset . nil). */
1486 static Lisp_Object print_prune_charset_plist
;
1489 print_prune_string_charset (string
)
1492 print_check_string_result
= 0;
1493 traverse_intervals (STRING_INTERVALS (string
), 0,
1494 print_check_string_charset_prop
, string
);
1495 if (! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1497 string
= Fcopy_sequence (string
);
1498 if (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
)
1500 if (NILP (print_prune_charset_plist
))
1501 print_prune_charset_plist
= Fcons (Qcharset
, Qnil
);
1502 Fremove_text_properties (make_number (0),
1503 make_number (SCHARS (string
)),
1504 print_prune_charset_plist
, string
);
1507 Fset_text_properties (make_number (0), make_number (SCHARS (string
)),
1514 print_object (obj
, printcharfun
, escapeflag
)
1516 register Lisp_Object printcharfun
;
1523 /* Detect circularities and truncate them. */
1524 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1525 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
)
1526 || (! NILP (Vprint_gensym
)
1528 && !SYMBOL_INTERNED_P (obj
)))
1530 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1532 /* Simple but incomplete way. */
1534 for (i
= 0; i
< print_depth
; i
++)
1535 if (EQ (obj
, being_printed
[i
]))
1537 sprintf (buf
, "#%d", i
);
1538 strout (buf
, -1, -1, printcharfun
, 0);
1541 being_printed
[print_depth
] = obj
;
1545 /* With the print-circle feature. */
1547 for (i
= 0; i
< print_number_index
; i
++)
1548 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1550 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1552 /* Add a prefix #n= if OBJ has not yet been printed;
1553 that is, its status field is nil. */
1554 sprintf (buf
, "#%d=", i
+ 1);
1555 strout (buf
, -1, -1, printcharfun
, 0);
1556 /* OBJ is going to be printed. Set the status to t. */
1557 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1562 /* Just print #n# if OBJ has already been printed. */
1563 sprintf (buf
, "#%d#", i
+ 1);
1564 strout (buf
, -1, -1, printcharfun
, 0);
1573 /* See similar code in print_preprocess. */
1574 if (print_depth
> PRINT_CIRCLE
)
1575 error ("Apparently circular structure being printed");
1576 #ifdef MAX_PRINT_CHARS
1577 if (max_print
&& print_chars
> max_print
)
1582 #endif /* MAX_PRINT_CHARS */
1584 switch (XGCTYPE (obj
))
1587 if (sizeof (int) == sizeof (EMACS_INT
))
1588 sprintf (buf
, "%d", XINT (obj
));
1589 else if (sizeof (long) == sizeof (EMACS_INT
))
1590 sprintf (buf
, "%ld", (long) XINT (obj
));
1593 strout (buf
, -1, -1, printcharfun
, 0);
1598 char pigbuf
[350]; /* see comments in float_to_string */
1600 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1601 strout (pigbuf
, -1, -1, printcharfun
, 0);
1607 print_string (obj
, printcharfun
);
1610 register int i
, i_byte
;
1611 struct gcpro gcpro1
;
1614 /* 1 means we must ensure that the next character we output
1615 cannot be taken as part of a hex character escape. */
1616 int need_nonhex
= 0;
1617 int multibyte
= STRING_MULTIBYTE (obj
);
1621 if (! EQ (Vprint_charset_text_property
, Qt
))
1622 obj
= print_prune_string_charset (obj
);
1624 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1632 size_byte
= SBYTES (obj
);
1634 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1636 /* Here, we must convert each multi-byte form to the
1637 corresponding character code before handing it to PRINTCHAR. */
1643 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
,
1644 size_byte
- i_byte
, len
);
1652 if (c
== '\n' && print_escape_newlines
)
1657 else if (c
== '\f' && print_escape_newlines
)
1663 && (CHAR_BYTE8_P (c
)
1664 || (! ASCII_CHAR_P (c
) && print_escape_multibyte
)))
1666 /* When multibyte is disabled,
1667 print multibyte string chars using hex escapes.
1668 For a char code that could be in a unibyte string,
1669 when found in a multibyte string, always use a hex escape
1670 so it reads back as multibyte. */
1671 unsigned char outbuf
[50];
1673 if (CHAR_BYTE8_P (c
))
1674 sprintf (outbuf
, "\\%03o", CHAR_TO_BYTE8 (c
));
1677 sprintf (outbuf
, "\\x%04x", c
);
1680 strout (outbuf
, -1, -1, printcharfun
, 0);
1682 else if (! multibyte
1683 && SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1684 && print_escape_nonascii
)
1686 /* When printing in a multibyte buffer
1687 or when explicitly requested,
1688 print single-byte non-ASCII string chars
1689 using octal escapes. */
1690 unsigned char outbuf
[5];
1691 sprintf (outbuf
, "\\%03o", c
);
1692 strout (outbuf
, -1, -1, printcharfun
, 0);
1696 /* If we just had a hex escape, and this character
1697 could be taken as part of it,
1698 output `\ ' to prevent that. */
1702 if ((c
>= 'a' && c
<= 'f')
1703 || (c
>= 'A' && c
<= 'F')
1704 || (c
>= '0' && c
<= '9'))
1705 strout ("\\ ", -1, -1, printcharfun
, 0);
1708 if (c
== '\"' || c
== '\\')
1715 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1717 traverse_intervals (STRING_INTERVALS (obj
),
1718 0, print_interval
, printcharfun
);
1728 register int confusing
;
1729 register unsigned char *p
= SDATA (SYMBOL_NAME (obj
));
1730 register unsigned char *end
= p
+ SBYTES (SYMBOL_NAME (obj
));
1732 int i
, i_byte
, size_byte
;
1735 name
= SYMBOL_NAME (obj
);
1737 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1740 /* If symbol name begins with a digit, and ends with a digit,
1741 and contains nothing but digits and `e', it could be treated
1742 as a number. So set CONFUSING.
1744 Symbols that contain periods could also be taken as numbers,
1745 but periods are always escaped, so we don't have to worry
1747 else if (*p
>= '0' && *p
<= '9'
1748 && end
[-1] >= '0' && end
[-1] <= '9')
1750 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1751 /* Needed for \2e10. */
1754 confusing
= (end
== p
);
1759 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1765 size_byte
= SBYTES (name
);
1767 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1769 /* Here, we must convert each multi-byte form to the
1770 corresponding character code before handing it to PRINTCHAR. */
1771 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1776 if (c
== '\"' || c
== '\\' || c
== '\''
1777 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1778 || c
== ',' || c
=='.' || c
== '`'
1779 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1781 PRINTCHAR ('\\'), confusing
= 0;
1789 /* If deeper than spec'd depth, print placeholder. */
1790 if (INTEGERP (Vprint_level
)
1791 && print_depth
> XINT (Vprint_level
))
1792 strout ("...", -1, -1, printcharfun
, 0);
1793 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1794 && (EQ (XCAR (obj
), Qquote
)))
1797 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1799 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1800 && (EQ (XCAR (obj
), Qfunction
)))
1804 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1806 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1807 && ! old_backquote_output
1808 && ((EQ (XCAR (obj
), Qbackquote
)
1809 || EQ (XCAR (obj
), Qcomma
)
1810 || EQ (XCAR (obj
), Qcomma_at
)
1811 || EQ (XCAR (obj
), Qcomma_dot
))))
1813 print_object (XCAR (obj
), printcharfun
, 0);
1814 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1820 /* If the first element is a backquote form,
1821 print it old-style so it won't be misunderstood. */
1822 if (print_quoted
&& CONSP (XCAR (obj
))
1823 && CONSP (XCDR (XCAR (obj
)))
1824 && NILP (XCDR (XCDR (XCAR (obj
))))
1825 && EQ (XCAR (XCAR (obj
)), Qbackquote
))
1831 print_object (Qbackquote
, printcharfun
, 0);
1834 ++old_backquote_output
;
1835 print_object (XCAR (XCDR (tem
)), printcharfun
, 0);
1836 --old_backquote_output
;
1843 int print_length
, i
;
1844 Lisp_Object halftail
= obj
;
1846 /* Negative values of print-length are invalid in CL.
1847 Treat them like nil, as CMUCL does. */
1848 if (NATNUMP (Vprint_length
))
1849 print_length
= XFASTINT (Vprint_length
);
1856 /* Detect circular list. */
1857 if (NILP (Vprint_circle
))
1859 /* Simple but imcomplete way. */
1860 if (i
!= 0 && EQ (obj
, halftail
))
1862 sprintf (buf
, " . #%d", i
/ 2);
1863 strout (buf
, -1, -1, printcharfun
, 0);
1869 /* With the print-circle feature. */
1873 for (i
= 0; i
< print_number_index
; i
++)
1874 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
),
1877 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1879 strout (" . ", 3, 3, printcharfun
, 0);
1880 print_object (obj
, printcharfun
, escapeflag
);
1884 sprintf (buf
, " . #%d#", i
+ 1);
1885 strout (buf
, -1, -1, printcharfun
, 0);
1895 if (print_length
&& i
> print_length
)
1897 strout ("...", 3, 3, printcharfun
, 0);
1901 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1905 halftail
= XCDR (halftail
);
1909 /* OBJ non-nil here means it's the end of a dotted list. */
1912 strout (" . ", 3, 3, printcharfun
, 0);
1913 print_object (obj
, printcharfun
, escapeflag
);
1921 case Lisp_Vectorlike
:
1926 strout ("#<process ", -1, -1, printcharfun
, 0);
1927 print_string (XPROCESS (obj
)->name
, printcharfun
);
1931 print_string (XPROCESS (obj
)->name
, printcharfun
);
1933 else if (BOOL_VECTOR_P (obj
))
1936 register unsigned char c
;
1937 struct gcpro gcpro1
;
1939 = ((XBOOL_VECTOR (obj
)->size
+ BOOL_VECTOR_BITS_PER_CHAR
- 1)
1940 / BOOL_VECTOR_BITS_PER_CHAR
);
1946 sprintf (buf
, "%ld", (long) XBOOL_VECTOR (obj
)->size
);
1947 strout (buf
, -1, -1, printcharfun
, 0);
1950 /* Don't print more characters than the specified maximum.
1951 Negative values of print-length are invalid. Treat them
1952 like a print-length of nil. */
1953 if (NATNUMP (Vprint_length
)
1954 && XFASTINT (Vprint_length
) < size_in_chars
)
1955 size_in_chars
= XFASTINT (Vprint_length
);
1957 for (i
= 0; i
< size_in_chars
; i
++)
1960 c
= XBOOL_VECTOR (obj
)->data
[i
];
1961 if (! ASCII_BYTE_P (c
))
1963 sprintf (buf
, "\\%03o", c
);
1964 strout (buf
, -1, -1, printcharfun
, 0);
1966 else if (c
== '\n' && print_escape_newlines
)
1971 else if (c
== '\f' && print_escape_newlines
)
1976 else if (c
> '\177')
1978 /* Use octal escapes to avoid encoding issues. */
1980 PRINTCHAR ('0' + ((c
>> 6) & 3));
1981 PRINTCHAR ('0' + ((c
>> 3) & 7));
1982 PRINTCHAR ('0' + (c
& 7));
1986 if (c
== '\"' || c
== '\\')
1995 else if (SUBRP (obj
))
1997 strout ("#<subr ", -1, -1, printcharfun
, 0);
1998 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
2001 else if (WINDOWP (obj
))
2003 strout ("#<window ", -1, -1, printcharfun
, 0);
2004 sprintf (buf
, "%ld", (long) XFASTINT (XWINDOW (obj
)->sequence_number
));
2005 strout (buf
, -1, -1, printcharfun
, 0);
2006 if (!NILP (XWINDOW (obj
)->buffer
))
2008 strout (" on ", -1, -1, printcharfun
, 0);
2009 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
2013 else if (HASH_TABLE_P (obj
))
2015 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
2016 strout ("#<hash-table", -1, -1, printcharfun
, 0);
2017 if (SYMBOLP (h
->test
))
2021 strout (SDATA (SYMBOL_NAME (h
->test
)), -1, -1, printcharfun
, 0);
2023 strout (SDATA (SYMBOL_NAME (h
->weak
)), -1, -1, printcharfun
, 0);
2025 sprintf (buf
, "%ld/%ld", (long) XFASTINT (h
->count
),
2026 (long) XVECTOR (h
->next
)->size
);
2027 strout (buf
, -1, -1, printcharfun
, 0);
2029 sprintf (buf
, " 0x%lx", (unsigned long) h
);
2030 strout (buf
, -1, -1, printcharfun
, 0);
2033 else if (BUFFERP (obj
))
2035 if (NILP (XBUFFER (obj
)->name
))
2036 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
2037 else if (escapeflag
)
2039 strout ("#<buffer ", -1, -1, printcharfun
, 0);
2040 print_string (XBUFFER (obj
)->name
, printcharfun
);
2044 print_string (XBUFFER (obj
)->name
, printcharfun
);
2046 else if (WINDOW_CONFIGURATIONP (obj
))
2048 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
2050 else if (FRAMEP (obj
))
2052 strout ((FRAME_LIVE_P (XFRAME (obj
))
2053 ? "#<frame " : "#<dead frame "),
2054 -1, -1, printcharfun
, 0);
2055 print_string (XFRAME (obj
)->name
, printcharfun
);
2056 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
2057 strout (buf
, -1, -1, printcharfun
, 0);
2062 EMACS_INT size
= XVECTOR (obj
)->size
;
2063 if (COMPILEDP (obj
))
2066 size
&= PSEUDOVECTOR_SIZE_MASK
;
2068 if (CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
))
2070 /* We print a char-table as if it were a vector,
2071 lumping the parent and default slots in with the
2072 character slots. But we add #^ as a prefix. */
2075 if (SUB_CHAR_TABLE_P (obj
))
2077 size
&= PSEUDOVECTOR_SIZE_MASK
;
2079 if (size
& PSEUDOVECTOR_FLAG
)
2085 register Lisp_Object tem
;
2086 int real_size
= size
;
2088 /* Don't print more elements than the specified maximum. */
2089 if (NATNUMP (Vprint_length
)
2090 && XFASTINT (Vprint_length
) < size
)
2091 size
= XFASTINT (Vprint_length
);
2093 for (i
= 0; i
< size
; i
++)
2095 if (i
) PRINTCHAR (' ');
2096 tem
= XVECTOR (obj
)->contents
[i
];
2097 print_object (tem
, printcharfun
, escapeflag
);
2099 if (size
< real_size
)
2100 strout (" ...", 4, 4, printcharfun
, 0);
2107 switch (XMISCTYPE (obj
))
2109 case Lisp_Misc_Marker
:
2110 strout ("#<marker ", -1, -1, printcharfun
, 0);
2111 /* Do you think this is necessary? */
2112 if (XMARKER (obj
)->insertion_type
!= 0)
2113 strout ("(moves after insertion) ", -1, -1, printcharfun
, 0);
2114 if (!(XMARKER (obj
)->buffer
))
2115 strout ("in no buffer", -1, -1, printcharfun
, 0);
2118 sprintf (buf
, "at %d", marker_position (obj
));
2119 strout (buf
, -1, -1, printcharfun
, 0);
2120 strout (" in ", -1, -1, printcharfun
, 0);
2121 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
2126 case Lisp_Misc_Overlay
:
2127 strout ("#<overlay ", -1, -1, printcharfun
, 0);
2128 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
2129 strout ("in no buffer", -1, -1, printcharfun
, 0);
2132 sprintf (buf
, "from %d to %d in ",
2133 marker_position (OVERLAY_START (obj
)),
2134 marker_position (OVERLAY_END (obj
)));
2135 strout (buf
, -1, -1, printcharfun
, 0);
2136 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
2142 /* Remaining cases shouldn't happen in normal usage, but let's print
2143 them anyway for the benefit of the debugger. */
2144 case Lisp_Misc_Free
:
2145 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
2148 case Lisp_Misc_Intfwd
:
2149 sprintf (buf
, "#<intfwd to %ld>", (long) *XINTFWD (obj
)->intvar
);
2150 strout (buf
, -1, -1, printcharfun
, 0);
2153 case Lisp_Misc_Boolfwd
:
2154 sprintf (buf
, "#<boolfwd to %s>",
2155 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
2156 strout (buf
, -1, -1, printcharfun
, 0);
2159 case Lisp_Misc_Objfwd
:
2160 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
2161 print_object (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
2165 case Lisp_Misc_Buffer_Objfwd
:
2166 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
2167 print_object (PER_BUFFER_VALUE (current_buffer
,
2168 XBUFFER_OBJFWD (obj
)->offset
),
2169 printcharfun
, escapeflag
);
2173 case Lisp_Misc_Kboard_Objfwd
:
2174 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
2175 print_object (*(Lisp_Object
*)((char *) current_kboard
2176 + XKBOARD_OBJFWD (obj
)->offset
),
2177 printcharfun
, escapeflag
);
2181 case Lisp_Misc_Buffer_Local_Value
:
2182 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
2183 goto do_buffer_local
;
2184 case Lisp_Misc_Some_Buffer_Local_Value
:
2185 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
2187 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
2188 print_object (XBUFFER_LOCAL_VALUE (obj
)->realvalue
,
2189 printcharfun
, escapeflag
);
2190 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
2191 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
2193 strout ("[buffer] ", -1, -1, printcharfun
, 0);
2194 print_object (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
2195 printcharfun
, escapeflag
);
2196 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
2198 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
2199 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
2201 strout ("[frame] ", -1, -1, printcharfun
, 0);
2202 print_object (XBUFFER_LOCAL_VALUE (obj
)->frame
,
2203 printcharfun
, escapeflag
);
2205 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
2206 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2207 printcharfun
, escapeflag
);
2208 strout ("[default-value] ", -1, -1, printcharfun
, 0);
2209 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2210 printcharfun
, escapeflag
);
2214 case Lisp_Misc_Save_Value
:
2215 strout ("#<save_value ", -1, -1, printcharfun
, 0);
2216 sprintf(buf
, "ptr=0x%08lx int=%d",
2217 (unsigned long) XSAVE_VALUE (obj
)->pointer
,
2218 XSAVE_VALUE (obj
)->integer
);
2219 strout (buf
, -1, -1, printcharfun
, 0);
2231 /* We're in trouble if this happens!
2232 Probably should just abort () */
2233 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
2235 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
2236 else if (VECTORLIKEP (obj
))
2237 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
2239 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
2240 strout (buf
, -1, -1, printcharfun
, 0);
2241 strout (" Save your buffers immediately and please report this bug>",
2242 -1, -1, printcharfun
, 0);
2250 /* Print a description of INTERVAL using PRINTCHARFUN.
2251 This is part of printing a string that has text properties. */
2254 print_interval (interval
, printcharfun
)
2256 Lisp_Object printcharfun
;
2258 if (NILP (interval
->plist
))
2261 print_object (make_number (interval
->position
), printcharfun
, 1);
2263 print_object (make_number (interval
->position
+ LENGTH (interval
)),
2266 print_object (interval
->plist
, printcharfun
, 1);
2273 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
2274 staticpro (&Qtemp_buffer_setup_hook
);
2276 DEFVAR_LISP ("standard-output", &Vstandard_output
,
2277 doc
: /* Output stream `print' uses by default for outputting a character.
2278 This may be any function of one argument.
2279 It may also be a buffer (output is inserted before point)
2280 or a marker (output is inserted and the marker is advanced)
2281 or the symbol t (output appears in the echo area). */);
2282 Vstandard_output
= Qt
;
2283 Qstandard_output
= intern ("standard-output");
2284 staticpro (&Qstandard_output
);
2286 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
2287 doc
: /* The format descriptor string used to print floats.
2288 This is a %-spec like those accepted by `printf' in C,
2289 but with some restrictions. It must start with the two characters `%.'.
2290 After that comes an integer precision specification,
2291 and then a letter which controls the format.
2292 The letters allowed are `e', `f' and `g'.
2293 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2294 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2295 Use `g' to choose the shorter of those two formats for the number at hand.
2296 The precision in any of these cases is the number of digits following
2297 the decimal point. With `f', a precision of 0 means to omit the
2298 decimal point. 0 is not allowed with `e' or `g'.
2300 A value of nil means to use the shortest notation
2301 that represents the number without losing information. */);
2302 Vfloat_output_format
= Qnil
;
2303 Qfloat_output_format
= intern ("float-output-format");
2304 staticpro (&Qfloat_output_format
);
2306 DEFVAR_LISP ("print-length", &Vprint_length
,
2307 doc
: /* Maximum length of list to print before abbreviating.
2308 A value of nil means no limit. See also `eval-expression-print-length'. */);
2309 Vprint_length
= Qnil
;
2311 DEFVAR_LISP ("print-level", &Vprint_level
,
2312 doc
: /* Maximum depth of list nesting to print before abbreviating.
2313 A value of nil means no limit. See also `eval-expression-print-level'. */);
2314 Vprint_level
= Qnil
;
2316 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
2317 doc
: /* Non-nil means print newlines in strings as `\\n'.
2318 Also print formfeeds as `\\f'. */);
2319 print_escape_newlines
= 0;
2321 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
2322 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2323 \(OOO is the octal representation of the character code.)
2324 Only single-byte characters are affected, and only in `prin1'.
2325 When the output goes in a multibyte buffer, this feature is
2326 enabled regardless of the value of the variable. */);
2327 print_escape_nonascii
= 0;
2329 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
2330 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2331 \(XXXX is the hex representation of the character code.)
2332 This affects only `prin1'. */);
2333 print_escape_multibyte
= 0;
2335 DEFVAR_BOOL ("print-quoted", &print_quoted
,
2336 doc
: /* Non-nil means print quoted forms with reader syntax.
2337 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2338 forms print as in the new syntax. */);
2341 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
2342 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2343 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2344 When the uninterned symbol appears within a recursive data structure,
2345 and the symbol appears more than once, in addition use the #N# and #N=
2346 constructs as needed, so that multiple references to the same symbol are
2347 shared once again when the text is read back. */);
2348 Vprint_gensym
= Qnil
;
2350 DEFVAR_LISP ("print-circle", &Vprint_circle
,
2351 doc
: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2352 If nil, printing proceeds recursively and may lead to
2353 `max-lisp-eval-depth' being exceeded or an error may occur:
2354 \"Apparently circular structure being printed.\" Also see
2355 `print-length' and `print-level'.
2356 If non-nil, shared substructures anywhere in the structure are printed
2357 with `#N=' before the first occurrence (in the order of the print
2358 representation) and `#N#' in place of each subsequent occurrence,
2359 where N is a positive decimal integer. */);
2360 Vprint_circle
= Qnil
;
2362 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
2363 doc
: /* *Non-nil means number continuously across print calls.
2364 This affects the numbers printed for #N= labels and #M# references.
2365 See also `print-circle', `print-gensym', and `print-number-table'.
2366 This variable should not be set with `setq'; bind it with a `let' instead. */);
2367 Vprint_continuous_numbering
= Qnil
;
2369 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
2370 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2371 The Lisp printer uses this vector to detect Lisp objects referenced more
2374 When you bind `print-continuous-numbering' to t, you should probably
2375 also bind `print-number-table' to nil. This ensures that the value of
2376 `print-number-table' can be garbage-collected once the printing is
2377 done. If all elements of `print-number-table' are nil, it means that
2378 the printing done so far has not found any shared structure or objects
2379 that need to be recorded in the table. */);
2380 Vprint_number_table
= Qnil
;
2382 DEFVAR_LISP ("print-charset-text-property", &Vprint_charset_text_property
,
2383 doc
: /* A flag to control printing of `charset' text property on printing a string.
2384 The value must be nil, t, or `default'.
2386 If the value is nil, don't print the text property `charset'.
2388 If the value is t, always print the text property `charset'.
2390 If the value is `default', print the text property `charset' only when
2391 the value is different from what is guessed in the current charset
2393 Vprint_charset_text_property
= Qdefault
;
2395 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2396 staticpro (&Vprin1_to_string_buffer
);
2399 defsubr (&Sprin1_to_string
);
2400 defsubr (&Serror_message_string
);
2404 defsubr (&Swrite_char
);
2405 defsubr (&Sexternal_debugging_output
);
2406 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2407 defsubr (&Sredirect_debugging_output
);
2410 Qexternal_debugging_output
= intern ("external-debugging-output");
2411 staticpro (&Qexternal_debugging_output
);
2413 Qprint_escape_newlines
= intern ("print-escape-newlines");
2414 staticpro (&Qprint_escape_newlines
);
2416 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
2417 staticpro (&Qprint_escape_multibyte
);
2419 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
2420 staticpro (&Qprint_escape_nonascii
);
2422 print_prune_charset_plist
= Qnil
;
2423 staticpro (&print_prune_charset_plist
);
2425 defsubr (&Swith_output_to_temp_buffer
);
2428 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2429 (do not change this comment) */