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 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, 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"
37 #include "blockinput.h"
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 /* Nonzero if inside outputting backquote in old style. */
98 int old_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.
677 The buffer is cleared out initially, and marked as unmodified when done.
678 All output done by BODY is inserted in that buffer by default.
679 The buffer is displayed in another window, but not selected.
680 The value of the last form in BODY is returned.
681 If BODY does not finish normally, the buffer BUFNAME is not displayed.
683 The hook `temp-buffer-setup-hook' is run before BODY,
684 with the buffer BUFNAME temporarily current.
685 The hook `temp-buffer-show-hook' is run after the buffer is displayed,
686 with the buffer temporarily current, and the window that was used
687 to display it temporarily selected.
689 If variable `temp-buffer-show-function' is non-nil, call it at the end
690 to get the buffer displayed instead of just displaying the non-selected
691 buffer and calling the hook. It gets one argument, the buffer to display.
693 usage: (with-output-to-temp-buffer BUFNAME BODY...) */)
699 int count
= SPECPDL_INDEX ();
700 Lisp_Object buf
, val
;
703 name
= Feval (Fcar (args
));
705 temp_output_buffer_setup (SDATA (name
));
706 buf
= Vstandard_output
;
709 val
= Fprogn (XCDR (args
));
712 temp_output_buffer_show (buf
);
715 return unbind_to (count
, val
);
719 static void print ();
720 static void print_preprocess ();
721 static void print_preprocess_string ();
722 static void print_object ();
724 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
725 doc
: /* Output a newline to stream PRINTCHARFUN.
726 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
728 Lisp_Object printcharfun
;
732 if (NILP (printcharfun
))
733 printcharfun
= Vstandard_output
;
740 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
741 doc
: /* Output the printed representation of OBJECT, any Lisp object.
742 Quoting characters are printed when needed to make output that `read'
743 can handle, whenever this is possible. For complex objects, the behavior
744 is controlled by `print-level' and `print-length', which see.
746 OBJECT is any of the Lisp data types: a number, a string, a symbol,
747 a list, a buffer, a window, a frame, etc.
749 A printed representation of an object is text which describes that object.
751 Optional argument PRINTCHARFUN is the output stream, which can be one
754 - a buffer, in which case output is inserted into that buffer at point;
755 - a marker, in which case output is inserted at marker's position;
756 - a function, in which case that function is called once for each
757 character of OBJECT's printed representation;
758 - a symbol, in which case that symbol's function definition is called; or
759 - t, in which case the output is displayed in the echo area.
761 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
763 (object
, printcharfun
)
764 Lisp_Object object
, printcharfun
;
768 #ifdef MAX_PRINT_CHARS
770 #endif /* MAX_PRINT_CHARS */
771 if (NILP (printcharfun
))
772 printcharfun
= Vstandard_output
;
774 print (object
, printcharfun
, 1);
779 /* a buffer which is used to hold output being built by prin1-to-string */
780 Lisp_Object Vprin1_to_string_buffer
;
782 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
783 doc
: /* Return a string containing the printed representation of OBJECT.
784 OBJECT can be any Lisp object. This function outputs quoting characters
785 when necessary to make output that `read' can handle, whenever possible,
786 unless the optional second argument NOESCAPE is non-nil. For complex objects,
787 the behavior is controlled by `print-level' and `print-length', which see.
789 OBJECT is any of the Lisp data types: a number, a string, a symbol,
790 a list, a buffer, a window, a frame, etc.
792 A printed representation of an object is text which describes that object. */)
794 Lisp_Object object
, noescape
;
796 Lisp_Object printcharfun
;
797 /* struct gcpro gcpro1, gcpro2; */
798 Lisp_Object save_deactivate_mark
;
799 int count
= SPECPDL_INDEX ();
800 struct buffer
*previous
;
802 specbind (Qinhibit_modification_hooks
, Qt
);
807 /* Save and restore this--we are altering a buffer
808 but we don't want to deactivate the mark just for that.
809 No need for specbind, since errors deactivate the mark. */
810 save_deactivate_mark
= Vdeactivate_mark
;
811 /* GCPRO2 (object, save_deactivate_mark); */
814 printcharfun
= Vprin1_to_string_buffer
;
816 print (object
, printcharfun
, NILP (noescape
));
817 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
821 previous
= current_buffer
;
822 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
823 object
= Fbuffer_string ();
824 if (SBYTES (object
) == SCHARS (object
))
825 STRING_SET_UNIBYTE (object
);
827 /* Note that this won't make prepare_to_modify_buffer call
828 ask-user-about-supersession-threat because this buffer
829 does not visit a file. */
831 set_buffer_internal (previous
);
833 Vdeactivate_mark
= save_deactivate_mark
;
837 return unbind_to (count
, object
);
840 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
841 doc
: /* Output the printed representation of OBJECT, any Lisp object.
842 No quoting characters are used; no delimiters are printed around
843 the contents of strings.
845 OBJECT is any of the Lisp data types: a number, a string, a symbol,
846 a list, a buffer, a window, a frame, etc.
848 A printed representation of an object is text which describes that object.
850 Optional argument PRINTCHARFUN is the output stream, which can be one
853 - a buffer, in which case output is inserted into that buffer at point;
854 - a marker, in which case output is inserted at marker's position;
855 - a function, in which case that function is called once for each
856 character of OBJECT's printed representation;
857 - a symbol, in which case that symbol's function definition is called; or
858 - t, in which case the output is displayed in the echo area.
860 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
862 (object
, printcharfun
)
863 Lisp_Object object
, printcharfun
;
867 if (NILP (printcharfun
))
868 printcharfun
= Vstandard_output
;
870 print (object
, printcharfun
, 0);
875 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
876 doc
: /* Output the printed representation of OBJECT, with newlines around it.
877 Quoting characters are printed when needed to make output that `read'
878 can handle, whenever this is possible. For complex objects, the behavior
879 is controlled by `print-level' and `print-length', which see.
881 OBJECT is any of the Lisp data types: a number, a string, a symbol,
882 a list, a buffer, a window, a frame, etc.
884 A printed representation of an object is text which describes that object.
886 Optional argument PRINTCHARFUN is the output stream, which can be one
889 - a buffer, in which case output is inserted into that buffer at point;
890 - a marker, in which case output is inserted at marker's position;
891 - a function, in which case that function is called once for each
892 character of OBJECT's printed representation;
893 - a symbol, in which case that symbol's function definition is called; or
894 - t, in which case the output is displayed in the echo area.
896 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
898 (object
, printcharfun
)
899 Lisp_Object object
, printcharfun
;
904 #ifdef MAX_PRINT_CHARS
906 max_print
= MAX_PRINT_CHARS
;
907 #endif /* MAX_PRINT_CHARS */
908 if (NILP (printcharfun
))
909 printcharfun
= Vstandard_output
;
913 print (object
, printcharfun
, 1);
916 #ifdef MAX_PRINT_CHARS
919 #endif /* MAX_PRINT_CHARS */
924 /* The subroutine object for external-debugging-output is kept here
925 for the convenience of the debugger. */
926 Lisp_Object Qexternal_debugging_output
;
928 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
929 doc
: /* Write CHARACTER to stderr.
930 You can call print while debugging emacs, and pass it this function
931 to make it write to the debugging output. */)
933 Lisp_Object character
;
935 CHECK_NUMBER (character
);
936 putc (XINT (character
), stderr
);
939 /* Send the output to a debugger (nothing happens if there isn't one). */
940 if (print_output_debug_flag
)
942 char buf
[2] = {(char) XINT (character
), '\0'};
943 OutputDebugString (buf
);
950 /* This function is never called. Its purpose is to prevent
951 print_output_debug_flag from being optimized away. */
954 debug_output_compilation_hack (x
)
957 print_output_debug_flag
= x
;
960 #if defined (GNU_LINUX)
962 /* This functionality is not vitally important in general, so we rely on
963 non-portable ability to use stderr as lvalue. */
965 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
967 FILE *initial_stderr_stream
= NULL
;
969 DEFUN ("redirect-debugging-output", Fredirect_debugging_output
, Sredirect_debugging_output
,
971 "FDebug output file: \nP",
972 doc
: /* Redirect debugging output (stderr stream) to file FILE.
973 If FILE is nil, reset target to the initial stderr stream.
974 Optional arg APPEND non-nil (interactively, with prefix arg) means
975 append to existing target file. */)
977 Lisp_Object file
, append
;
979 if (initial_stderr_stream
!= NULL
)
985 stderr
= initial_stderr_stream
;
986 initial_stderr_stream
= NULL
;
990 file
= Fexpand_file_name (file
, Qnil
);
991 initial_stderr_stream
= stderr
;
992 stderr
= fopen (SDATA (file
), NILP (append
) ? "w" : "a");
995 stderr
= initial_stderr_stream
;
996 initial_stderr_stream
= NULL
;
997 report_file_error ("Cannot open debugging output stream",
1003 #endif /* GNU_LINUX */
1006 /* This is the interface for debugging printing. */
1012 Fprin1 (arg
, Qexternal_debugging_output
);
1013 fprintf (stderr
, "\r\n");
1017 safe_debug_print (arg
)
1020 int valid
= valid_lisp_object_p (arg
);
1025 fprintf (stderr
, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
1026 !valid
? "INVALID" : "SOME",
1027 #ifdef NO_UNION_TYPE
1030 (unsigned long) arg
.i
1036 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
1038 doc
: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
1039 See Info anchor `(elisp)Definition of signal' for some details on how this
1040 error message is constructed. */)
1044 struct buffer
*old
= current_buffer
;
1046 struct gcpro gcpro1
;
1048 /* If OBJ is (error STRING), just return STRING.
1049 That is not only faster, it also avoids the need to allocate
1050 space here when the error is due to memory full. */
1051 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
1052 && CONSP (XCDR (obj
))
1053 && STRINGP (XCAR (XCDR (obj
)))
1054 && NILP (XCDR (XCDR (obj
))))
1055 return XCAR (XCDR (obj
));
1057 print_error_message (obj
, Vprin1_to_string_buffer
, 0, Qnil
);
1059 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
1060 value
= Fbuffer_string ();
1064 set_buffer_internal (old
);
1070 /* Print an error message for the error DATA onto Lisp output stream
1071 STREAM (suitable for the print functions).
1072 CONTEXT is a C string describing the context of the error.
1073 CALLER is the Lisp function inside which the error was signaled. */
1076 print_error_message (data
, stream
, context
, caller
)
1077 Lisp_Object data
, stream
;
1081 Lisp_Object errname
, errmsg
, file_error
, tail
;
1082 struct gcpro gcpro1
;
1086 write_string_1 (context
, -1, stream
);
1088 /* If we know from where the error was signaled, show it in
1090 if (!NILP (caller
) && SYMBOLP (caller
))
1092 Lisp_Object cname
= SYMBOL_NAME (caller
);
1093 char *name
= alloca (SBYTES (cname
));
1094 bcopy (SDATA (cname
), name
, SBYTES (cname
));
1095 message_dolog (name
, SBYTES (cname
), 0, 0);
1096 message_dolog (": ", 2, 0, 0);
1099 errname
= Fcar (data
);
1101 if (EQ (errname
, Qerror
))
1106 errmsg
= Fcar (data
);
1111 Lisp_Object error_conditions
;
1112 errmsg
= Fget (errname
, Qerror_message
);
1113 error_conditions
= Fget (errname
, Qerror_conditions
);
1114 file_error
= Fmemq (Qfile_error
, error_conditions
);
1117 /* Print an error message including the data items. */
1119 tail
= Fcdr_safe (data
);
1122 /* For file-error, make error message by concatenating
1123 all the data items. They are all strings. */
1124 if (!NILP (file_error
) && CONSP (tail
))
1125 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
1127 if (STRINGP (errmsg
))
1128 Fprinc (errmsg
, stream
);
1130 write_string_1 ("peculiar error", -1, stream
);
1132 for (i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
1136 write_string_1 (i
? ", " : ": ", 2, stream
);
1138 if (!NILP (file_error
) || EQ (errname
, Qend_of_file
))
1139 Fprinc (obj
, stream
);
1141 Fprin1 (obj
, stream
);
1150 * The buffer should be at least as large as the max string size of the
1151 * largest float, printed in the biggest notation. This is undoubtedly
1152 * 20d float_output_format, with the negative of the C-constant "HUGE"
1155 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1157 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1158 * case of -1e307 in 20d float_output_format. What is one to do (short of
1159 * re-writing _doprnt to be more sane)?
1164 float_to_string (buf
, data
)
1171 /* Check for plus infinity in a way that won't lose
1172 if there is no plus infinity. */
1173 if (data
== data
/ 2 && data
> 1.0)
1175 strcpy (buf
, "1.0e+INF");
1178 /* Likewise for minus infinity. */
1179 if (data
== data
/ 2 && data
< -1.0)
1181 strcpy (buf
, "-1.0e+INF");
1184 /* Check for NaN in a way that won't fail if there are no NaNs. */
1185 if (! (data
* 0.0 >= 0.0))
1187 /* Prepend "-" if the NaN's sign bit is negative.
1188 The sign bit of a double is the bit that is 1 in -0.0. */
1190 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
1192 u_minus_zero
.d
= - 0.0;
1193 for (i
= 0; i
< sizeof (double); i
++)
1194 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1200 strcpy (buf
, "0.0e+NaN");
1204 if (NILP (Vfloat_output_format
)
1205 || !STRINGP (Vfloat_output_format
))
1208 /* Generate the fewest number of digits that represent the
1209 floating point value without losing information.
1210 The following method is simple but a bit slow.
1211 For ideas about speeding things up, please see:
1213 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1214 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1216 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1217 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1219 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1221 sprintf (buf
, "%.*g", width
, data
);
1222 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1224 else /* oink oink */
1226 /* Check that the spec we have is fully valid.
1227 This means not only valid for printf,
1228 but meant for floats, and reasonable. */
1229 cp
= SDATA (Vfloat_output_format
);
1238 /* Check the width specification. */
1240 if ('0' <= *cp
&& *cp
<= '9')
1244 width
= (width
* 10) + (*cp
++ - '0');
1245 while (*cp
>= '0' && *cp
<= '9');
1247 /* A precision of zero is valid only for %f. */
1249 || (width
== 0 && *cp
!= 'f'))
1253 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1259 sprintf (buf
, SDATA (Vfloat_output_format
), data
);
1262 /* Make sure there is a decimal point with digit after, or an
1263 exponent, so that the value is readable as a float. But don't do
1264 this with "%.0f"; it's valid for that not to produce a decimal
1265 point. Note that width can be 0 only for %.0f. */
1268 for (cp
= buf
; *cp
; cp
++)
1269 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1272 if (*cp
== '.' && cp
[1] == 0)
1289 print (obj
, printcharfun
, escapeflag
)
1291 register Lisp_Object printcharfun
;
1294 old_backquote_output
= 0;
1296 /* Reset print_number_index and Vprint_number_table only when
1297 the variable Vprint_continuous_numbering is nil. Otherwise,
1298 the values of these variables will be kept between several
1300 if (NILP (Vprint_continuous_numbering
)
1301 || NILP (Vprint_number_table
))
1303 print_number_index
= 0;
1304 Vprint_number_table
= Qnil
;
1307 /* Construct Vprint_number_table for print-gensym and print-circle. */
1308 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1310 int i
, start
, index
;
1311 start
= index
= print_number_index
;
1312 /* Construct Vprint_number_table.
1313 This increments print_number_index for the objects added. */
1315 print_preprocess (obj
);
1317 /* Remove unnecessary objects, which appear only once in OBJ;
1318 that is, whose status is Qnil. Compactify the necessary objects. */
1319 for (i
= start
; i
< print_number_index
; i
++)
1320 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1322 PRINT_NUMBER_OBJECT (Vprint_number_table
, index
)
1323 = PRINT_NUMBER_OBJECT (Vprint_number_table
, i
);
1327 /* Clear out objects outside the active part of the table. */
1328 for (i
= index
; i
< print_number_index
; i
++)
1329 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
) = Qnil
;
1331 /* Reset the status field for the next print step. Now this
1332 field means whether the object has already been printed. */
1333 for (i
= start
; i
< print_number_index
; i
++)
1334 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qnil
;
1336 print_number_index
= index
;
1340 print_object (obj
, printcharfun
, escapeflag
);
1343 /* Construct Vprint_number_table according to the structure of OBJ.
1344 OBJ itself and all its elements will be added to Vprint_number_table
1345 recursively if it is a list, vector, compiled function, char-table,
1346 string (its text properties will be traced), or a symbol that has
1347 no obarray (this is for the print-gensym feature).
1348 The status fields of Vprint_number_table mean whether each object appears
1349 more than once in OBJ: Qnil at the first time, and Qt after that . */
1351 print_preprocess (obj
)
1357 Lisp_Object halftail
;
1359 /* Give up if we go so deep that print_object will get an error. */
1360 /* See similar code in print_object. */
1361 if (print_depth
>= PRINT_CIRCLE
)
1362 error ("Apparently circular structure being printed");
1364 /* Avoid infinite recursion for circular nested structure
1365 in the case where Vprint_circle is nil. */
1366 if (NILP (Vprint_circle
))
1368 for (i
= 0; i
< print_depth
; i
++)
1369 if (EQ (obj
, being_printed
[i
]))
1371 being_printed
[print_depth
] = obj
;
1378 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1379 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1380 || (! NILP (Vprint_gensym
)
1382 && !SYMBOL_INTERNED_P (obj
)))
1384 /* In case print-circle is nil and print-gensym is t,
1385 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1386 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1388 for (i
= 0; i
< print_number_index
; i
++)
1389 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1391 /* OBJ appears more than once. Let's remember that. */
1392 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1397 /* OBJ is not yet recorded. Let's add to the table. */
1398 if (print_number_index
== 0)
1400 /* Initialize the table. */
1401 Vprint_number_table
= Fmake_vector (make_number (40), Qnil
);
1403 else if (XVECTOR (Vprint_number_table
)->size
== print_number_index
* 2)
1405 /* Reallocate the table. */
1406 int i
= print_number_index
* 4;
1407 Lisp_Object old_table
= Vprint_number_table
;
1408 Vprint_number_table
= Fmake_vector (make_number (i
), Qnil
);
1409 for (i
= 0; i
< print_number_index
; i
++)
1411 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
)
1412 = PRINT_NUMBER_OBJECT (old_table
, i
);
1413 PRINT_NUMBER_STATUS (Vprint_number_table
, i
)
1414 = PRINT_NUMBER_STATUS (old_table
, i
);
1417 PRINT_NUMBER_OBJECT (Vprint_number_table
, print_number_index
) = obj
;
1418 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1419 always print the gensym with a number. This is a special for
1420 the lisp function byte-compile-output-docform. */
1421 if (!NILP (Vprint_continuous_numbering
)
1423 && !SYMBOL_INTERNED_P (obj
))
1424 PRINT_NUMBER_STATUS (Vprint_number_table
, print_number_index
) = Qt
;
1425 print_number_index
++;
1428 switch (XTYPE (obj
))
1431 /* A string may have text properties, which can be circular. */
1432 traverse_intervals_noorder (STRING_INTERVALS (obj
),
1433 print_preprocess_string
, Qnil
);
1437 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1438 just as in print_object. */
1439 if (loop_count
&& EQ (obj
, halftail
))
1441 print_preprocess (XCAR (obj
));
1444 if (!(loop_count
& 1))
1445 halftail
= XCDR (halftail
);
1448 case Lisp_Vectorlike
:
1449 size
= XVECTOR (obj
)->size
;
1450 if (size
& PSEUDOVECTOR_FLAG
)
1451 size
&= PSEUDOVECTOR_SIZE_MASK
;
1452 for (i
= 0; i
< size
; i
++)
1453 print_preprocess (XVECTOR (obj
)->contents
[i
]);
1464 print_preprocess_string (interval
, arg
)
1468 print_preprocess (interval
->plist
);
1471 /* A flag to control printing of `charset' text property.
1472 The default value is Qdefault. */
1473 Lisp_Object Vprint_charset_text_property
;
1474 extern Lisp_Object Qdefault
;
1476 static void print_check_string_charset_prop ();
1478 #define PRINT_STRING_NON_CHARSET_FOUND 1
1479 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
1481 /* Bitwize or of the abobe macros. */
1482 static int print_check_string_result
;
1485 print_check_string_charset_prop (interval
, string
)
1491 if (NILP (interval
->plist
)
1492 || (print_check_string_result
== (PRINT_STRING_NON_CHARSET_FOUND
1493 | PRINT_STRING_UNSAFE_CHARSET_FOUND
)))
1495 for (val
= interval
->plist
; CONSP (val
) && ! EQ (XCAR (val
), Qcharset
);
1496 val
= XCDR (XCDR (val
)));
1499 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1502 if (! (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
))
1504 if (! EQ (val
, interval
->plist
)
1505 || CONSP (XCDR (XCDR (val
))))
1506 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1508 if (NILP (Vprint_charset_text_property
)
1509 || ! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1512 int charpos
= interval
->position
;
1513 int bytepos
= string_char_to_byte (string
, charpos
);
1514 Lisp_Object charset
;
1516 charset
= XCAR (XCDR (val
));
1517 for (i
= 0; i
< LENGTH (interval
); i
++)
1519 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1520 if (! ASCII_CHAR_P (c
)
1521 && ! EQ (CHARSET_NAME (CHAR_CHARSET (c
)), charset
))
1523 print_check_string_result
|= PRINT_STRING_UNSAFE_CHARSET_FOUND
;
1530 /* The value is (charset . nil). */
1531 static Lisp_Object print_prune_charset_plist
;
1534 print_prune_string_charset (string
)
1537 print_check_string_result
= 0;
1538 traverse_intervals (STRING_INTERVALS (string
), 0,
1539 print_check_string_charset_prop
, string
);
1540 if (! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1542 string
= Fcopy_sequence (string
);
1543 if (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
)
1545 if (NILP (print_prune_charset_plist
))
1546 print_prune_charset_plist
= Fcons (Qcharset
, Qnil
);
1547 Fremove_text_properties (make_number (0),
1548 make_number (SCHARS (string
)),
1549 print_prune_charset_plist
, string
);
1552 Fset_text_properties (make_number (0), make_number (SCHARS (string
)),
1559 print_object (obj
, printcharfun
, escapeflag
)
1561 register Lisp_Object printcharfun
;
1568 /* Detect circularities and truncate them. */
1569 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1570 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
)
1571 || (! NILP (Vprint_gensym
)
1573 && !SYMBOL_INTERNED_P (obj
)))
1575 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1577 /* Simple but incomplete way. */
1579 for (i
= 0; i
< print_depth
; i
++)
1580 if (EQ (obj
, being_printed
[i
]))
1582 sprintf (buf
, "#%d", i
);
1583 strout (buf
, -1, -1, printcharfun
, 0);
1586 being_printed
[print_depth
] = obj
;
1590 /* With the print-circle feature. */
1592 for (i
= 0; i
< print_number_index
; i
++)
1593 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1595 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1597 /* Add a prefix #n= if OBJ has not yet been printed;
1598 that is, its status field is nil. */
1599 sprintf (buf
, "#%d=", i
+ 1);
1600 strout (buf
, -1, -1, printcharfun
, 0);
1601 /* OBJ is going to be printed. Set the status to t. */
1602 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1607 /* Just print #n# if OBJ has already been printed. */
1608 sprintf (buf
, "#%d#", i
+ 1);
1609 strout (buf
, -1, -1, printcharfun
, 0);
1618 /* See similar code in print_preprocess. */
1619 if (print_depth
> PRINT_CIRCLE
)
1620 error ("Apparently circular structure being printed");
1621 #ifdef MAX_PRINT_CHARS
1622 if (max_print
&& print_chars
> max_print
)
1627 #endif /* MAX_PRINT_CHARS */
1629 switch (XTYPE (obj
))
1632 if (sizeof (int) == sizeof (EMACS_INT
))
1633 sprintf (buf
, "%d", XINT (obj
));
1634 else if (sizeof (long) == sizeof (EMACS_INT
))
1635 sprintf (buf
, "%ld", (long) XINT (obj
));
1638 strout (buf
, -1, -1, printcharfun
, 0);
1643 char pigbuf
[350]; /* see comments in float_to_string */
1645 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1646 strout (pigbuf
, -1, -1, printcharfun
, 0);
1652 print_string (obj
, printcharfun
);
1655 register int i
, i_byte
;
1656 struct gcpro gcpro1
;
1659 /* 1 means we must ensure that the next character we output
1660 cannot be taken as part of a hex character escape. */
1661 int need_nonhex
= 0;
1662 int multibyte
= STRING_MULTIBYTE (obj
);
1666 if (! EQ (Vprint_charset_text_property
, Qt
))
1667 obj
= print_prune_string_charset (obj
);
1669 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1677 size_byte
= SBYTES (obj
);
1679 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1681 /* Here, we must convert each multi-byte form to the
1682 corresponding character code before handing it to PRINTCHAR. */
1688 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
,
1689 size_byte
- i_byte
, len
);
1697 if (c
== '\n' && print_escape_newlines
)
1702 else if (c
== '\f' && print_escape_newlines
)
1708 && (CHAR_BYTE8_P (c
)
1709 || (! ASCII_CHAR_P (c
) && print_escape_multibyte
)))
1711 /* When multibyte is disabled,
1712 print multibyte string chars using hex escapes.
1713 For a char code that could be in a unibyte string,
1714 when found in a multibyte string, always use a hex escape
1715 so it reads back as multibyte. */
1716 unsigned char outbuf
[50];
1718 if (CHAR_BYTE8_P (c
))
1719 sprintf (outbuf
, "\\%03o", CHAR_TO_BYTE8 (c
));
1722 sprintf (outbuf
, "\\x%04x", c
);
1725 strout (outbuf
, -1, -1, printcharfun
, 0);
1727 else if (! multibyte
1728 && SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1729 && print_escape_nonascii
)
1731 /* When printing in a multibyte buffer
1732 or when explicitly requested,
1733 print single-byte non-ASCII string chars
1734 using octal escapes. */
1735 unsigned char outbuf
[5];
1736 sprintf (outbuf
, "\\%03o", c
);
1737 strout (outbuf
, -1, -1, printcharfun
, 0);
1741 /* If we just had a hex escape, and this character
1742 could be taken as part of it,
1743 output `\ ' to prevent that. */
1747 if ((c
>= 'a' && c
<= 'f')
1748 || (c
>= 'A' && c
<= 'F')
1749 || (c
>= '0' && c
<= '9'))
1750 strout ("\\ ", -1, -1, printcharfun
, 0);
1753 if (c
== '\"' || c
== '\\')
1760 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1762 traverse_intervals (STRING_INTERVALS (obj
),
1763 0, print_interval
, printcharfun
);
1773 register int confusing
;
1774 register unsigned char *p
= SDATA (SYMBOL_NAME (obj
));
1775 register unsigned char *end
= p
+ SBYTES (SYMBOL_NAME (obj
));
1777 int i
, i_byte
, size_byte
;
1780 name
= SYMBOL_NAME (obj
);
1782 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1785 /* If symbol name begins with a digit, and ends with a digit,
1786 and contains nothing but digits and `e', it could be treated
1787 as a number. So set CONFUSING.
1789 Symbols that contain periods could also be taken as numbers,
1790 but periods are always escaped, so we don't have to worry
1792 else if (*p
>= '0' && *p
<= '9'
1793 && end
[-1] >= '0' && end
[-1] <= '9')
1795 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1796 /* Needed for \2e10. */
1799 confusing
= (end
== p
);
1804 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1810 size_byte
= SBYTES (name
);
1812 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1814 /* Here, we must convert each multi-byte form to the
1815 corresponding character code before handing it to PRINTCHAR. */
1816 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1821 if (c
== '\"' || c
== '\\' || c
== '\''
1822 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1823 || c
== ',' || c
=='.' || c
== '`'
1824 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1826 PRINTCHAR ('\\'), confusing
= 0;
1834 /* If deeper than spec'd depth, print placeholder. */
1835 if (INTEGERP (Vprint_level
)
1836 && print_depth
> XINT (Vprint_level
))
1837 strout ("...", -1, -1, printcharfun
, 0);
1838 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1839 && (EQ (XCAR (obj
), Qquote
)))
1842 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1844 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1845 && (EQ (XCAR (obj
), Qfunction
)))
1849 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1851 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1852 && ! old_backquote_output
1853 && ((EQ (XCAR (obj
), Qbackquote
)
1854 || EQ (XCAR (obj
), Qcomma
)
1855 || EQ (XCAR (obj
), Qcomma_at
)
1856 || EQ (XCAR (obj
), Qcomma_dot
))))
1858 print_object (XCAR (obj
), printcharfun
, 0);
1859 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1865 /* If the first element is a backquote form,
1866 print it old-style so it won't be misunderstood. */
1867 if (print_quoted
&& CONSP (XCAR (obj
))
1868 && CONSP (XCDR (XCAR (obj
)))
1869 && NILP (XCDR (XCDR (XCAR (obj
))))
1870 && EQ (XCAR (XCAR (obj
)), Qbackquote
))
1876 print_object (Qbackquote
, printcharfun
, 0);
1879 ++old_backquote_output
;
1880 print_object (XCAR (XCDR (tem
)), printcharfun
, 0);
1881 --old_backquote_output
;
1888 int print_length
, i
;
1889 Lisp_Object halftail
= obj
;
1891 /* Negative values of print-length are invalid in CL.
1892 Treat them like nil, as CMUCL does. */
1893 if (NATNUMP (Vprint_length
))
1894 print_length
= XFASTINT (Vprint_length
);
1901 /* Detect circular list. */
1902 if (NILP (Vprint_circle
))
1904 /* Simple but imcomplete way. */
1905 if (i
!= 0 && EQ (obj
, halftail
))
1907 sprintf (buf
, " . #%d", i
/ 2);
1908 strout (buf
, -1, -1, printcharfun
, 0);
1914 /* With the print-circle feature. */
1918 for (i
= 0; i
< print_number_index
; i
++)
1919 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
),
1922 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1924 strout (" . ", 3, 3, printcharfun
, 0);
1925 print_object (obj
, printcharfun
, escapeflag
);
1929 sprintf (buf
, " . #%d#", i
+ 1);
1930 strout (buf
, -1, -1, printcharfun
, 0);
1940 if (print_length
&& i
> print_length
)
1942 strout ("...", 3, 3, printcharfun
, 0);
1946 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1950 halftail
= XCDR (halftail
);
1954 /* OBJ non-nil here means it's the end of a dotted list. */
1957 strout (" . ", 3, 3, printcharfun
, 0);
1958 print_object (obj
, printcharfun
, escapeflag
);
1966 case Lisp_Vectorlike
:
1971 strout ("#<process ", -1, -1, printcharfun
, 0);
1972 print_string (XPROCESS (obj
)->name
, printcharfun
);
1976 print_string (XPROCESS (obj
)->name
, printcharfun
);
1978 else if (BOOL_VECTOR_P (obj
))
1981 register unsigned char c
;
1982 struct gcpro gcpro1
;
1984 = ((XBOOL_VECTOR (obj
)->size
+ BOOL_VECTOR_BITS_PER_CHAR
- 1)
1985 / BOOL_VECTOR_BITS_PER_CHAR
);
1991 sprintf (buf
, "%ld", (long) XBOOL_VECTOR (obj
)->size
);
1992 strout (buf
, -1, -1, printcharfun
, 0);
1995 /* Don't print more characters than the specified maximum.
1996 Negative values of print-length are invalid. Treat them
1997 like a print-length of nil. */
1998 if (NATNUMP (Vprint_length
)
1999 && XFASTINT (Vprint_length
) < size_in_chars
)
2000 size_in_chars
= XFASTINT (Vprint_length
);
2002 for (i
= 0; i
< size_in_chars
; i
++)
2005 c
= XBOOL_VECTOR (obj
)->data
[i
];
2006 if (! ASCII_BYTE_P (c
))
2008 sprintf (buf
, "\\%03o", c
);
2009 strout (buf
, -1, -1, printcharfun
, 0);
2011 else if (c
== '\n' && print_escape_newlines
)
2016 else if (c
== '\f' && print_escape_newlines
)
2021 else if (c
> '\177')
2023 /* Use octal escapes to avoid encoding issues. */
2025 PRINTCHAR ('0' + ((c
>> 6) & 3));
2026 PRINTCHAR ('0' + ((c
>> 3) & 7));
2027 PRINTCHAR ('0' + (c
& 7));
2031 if (c
== '\"' || c
== '\\')
2040 else if (SUBRP (obj
))
2042 strout ("#<subr ", -1, -1, printcharfun
, 0);
2043 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
2046 else if (WINDOWP (obj
))
2048 strout ("#<window ", -1, -1, printcharfun
, 0);
2049 sprintf (buf
, "%ld", (long) XFASTINT (XWINDOW (obj
)->sequence_number
));
2050 strout (buf
, -1, -1, printcharfun
, 0);
2051 if (!NILP (XWINDOW (obj
)->buffer
))
2053 strout (" on ", -1, -1, printcharfun
, 0);
2054 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
2058 else if (HASH_TABLE_P (obj
))
2060 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
2061 strout ("#<hash-table", -1, -1, printcharfun
, 0);
2062 if (SYMBOLP (h
->test
))
2066 strout (SDATA (SYMBOL_NAME (h
->test
)), -1, -1, printcharfun
, 0);
2068 strout (SDATA (SYMBOL_NAME (h
->weak
)), -1, -1, printcharfun
, 0);
2070 sprintf (buf
, "%ld/%ld", (long) XFASTINT (h
->count
),
2071 (long) XVECTOR (h
->next
)->size
);
2072 strout (buf
, -1, -1, printcharfun
, 0);
2074 sprintf (buf
, " 0x%lx", (unsigned long) h
);
2075 strout (buf
, -1, -1, printcharfun
, 0);
2078 else if (BUFFERP (obj
))
2080 if (NILP (XBUFFER (obj
)->name
))
2081 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
2082 else if (escapeflag
)
2084 strout ("#<buffer ", -1, -1, printcharfun
, 0);
2085 print_string (XBUFFER (obj
)->name
, printcharfun
);
2089 print_string (XBUFFER (obj
)->name
, printcharfun
);
2091 else if (WINDOW_CONFIGURATIONP (obj
))
2093 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
2095 else if (FRAMEP (obj
))
2097 strout ((FRAME_LIVE_P (XFRAME (obj
))
2098 ? "#<frame " : "#<dead frame "),
2099 -1, -1, printcharfun
, 0);
2100 print_string (XFRAME (obj
)->name
, printcharfun
);
2101 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
2102 strout (buf
, -1, -1, printcharfun
, 0);
2107 EMACS_INT size
= XVECTOR (obj
)->size
;
2108 if (COMPILEDP (obj
))
2111 size
&= PSEUDOVECTOR_SIZE_MASK
;
2113 if (CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
))
2115 /* We print a char-table as if it were a vector,
2116 lumping the parent and default slots in with the
2117 character slots. But we add #^ as a prefix. */
2120 if (SUB_CHAR_TABLE_P (obj
))
2122 size
&= PSEUDOVECTOR_SIZE_MASK
;
2124 if (size
& PSEUDOVECTOR_FLAG
)
2130 register Lisp_Object tem
;
2131 int real_size
= size
;
2133 /* Don't print more elements than the specified maximum. */
2134 if (NATNUMP (Vprint_length
)
2135 && XFASTINT (Vprint_length
) < size
)
2136 size
= XFASTINT (Vprint_length
);
2138 for (i
= 0; i
< size
; i
++)
2140 if (i
) PRINTCHAR (' ');
2141 tem
= XVECTOR (obj
)->contents
[i
];
2142 print_object (tem
, printcharfun
, escapeflag
);
2144 if (size
< real_size
)
2145 strout (" ...", 4, 4, printcharfun
, 0);
2152 switch (XMISCTYPE (obj
))
2154 case Lisp_Misc_Marker
:
2155 strout ("#<marker ", -1, -1, printcharfun
, 0);
2156 /* Do you think this is necessary? */
2157 if (XMARKER (obj
)->insertion_type
!= 0)
2158 strout ("(moves after insertion) ", -1, -1, printcharfun
, 0);
2159 if (! XMARKER (obj
)->buffer
)
2160 strout ("in no buffer", -1, -1, printcharfun
, 0);
2163 sprintf (buf
, "at %d", marker_position (obj
));
2164 strout (buf
, -1, -1, printcharfun
, 0);
2165 strout (" in ", -1, -1, printcharfun
, 0);
2166 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
2171 case Lisp_Misc_Overlay
:
2172 strout ("#<overlay ", -1, -1, printcharfun
, 0);
2173 if (! XMARKER (OVERLAY_START (obj
))->buffer
)
2174 strout ("in no buffer", -1, -1, printcharfun
, 0);
2177 sprintf (buf
, "from %d to %d in ",
2178 marker_position (OVERLAY_START (obj
)),
2179 marker_position (OVERLAY_END (obj
)));
2180 strout (buf
, -1, -1, printcharfun
, 0);
2181 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
2187 /* Remaining cases shouldn't happen in normal usage, but let's print
2188 them anyway for the benefit of the debugger. */
2189 case Lisp_Misc_Free
:
2190 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
2193 case Lisp_Misc_Intfwd
:
2194 sprintf (buf
, "#<intfwd to %ld>", (long) *XINTFWD (obj
)->intvar
);
2195 strout (buf
, -1, -1, printcharfun
, 0);
2198 case Lisp_Misc_Boolfwd
:
2199 sprintf (buf
, "#<boolfwd to %s>",
2200 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
2201 strout (buf
, -1, -1, printcharfun
, 0);
2204 case Lisp_Misc_Objfwd
:
2205 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
2206 print_object (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
2210 case Lisp_Misc_Buffer_Objfwd
:
2211 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
2212 print_object (PER_BUFFER_VALUE (current_buffer
,
2213 XBUFFER_OBJFWD (obj
)->offset
),
2214 printcharfun
, escapeflag
);
2218 case Lisp_Misc_Kboard_Objfwd
:
2219 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
2220 print_object (*(Lisp_Object
*) ((char *) current_kboard
2221 + XKBOARD_OBJFWD (obj
)->offset
),
2222 printcharfun
, escapeflag
);
2226 case Lisp_Misc_Buffer_Local_Value
:
2227 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
2228 goto do_buffer_local
;
2229 case Lisp_Misc_Some_Buffer_Local_Value
:
2230 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
2232 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
2233 print_object (XBUFFER_LOCAL_VALUE (obj
)->realvalue
,
2234 printcharfun
, escapeflag
);
2235 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
2236 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
2238 strout ("[buffer] ", -1, -1, printcharfun
, 0);
2239 print_object (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
2240 printcharfun
, escapeflag
);
2241 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
2243 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
2244 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
2246 strout ("[frame] ", -1, -1, printcharfun
, 0);
2247 print_object (XBUFFER_LOCAL_VALUE (obj
)->frame
,
2248 printcharfun
, escapeflag
);
2250 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
2251 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2252 printcharfun
, escapeflag
);
2253 strout ("[default-value] ", -1, -1, printcharfun
, 0);
2254 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2255 printcharfun
, escapeflag
);
2259 case Lisp_Misc_Save_Value
:
2260 strout ("#<save_value ", -1, -1, printcharfun
, 0);
2261 sprintf(buf
, "ptr=0x%08lx int=%d",
2262 (unsigned long) XSAVE_VALUE (obj
)->pointer
,
2263 XSAVE_VALUE (obj
)->integer
);
2264 strout (buf
, -1, -1, printcharfun
, 0);
2276 /* We're in trouble if this happens!
2277 Probably should just abort () */
2278 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
2280 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
2281 else if (VECTORLIKEP (obj
))
2282 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
2284 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
2285 strout (buf
, -1, -1, printcharfun
, 0);
2286 strout (" Save your buffers immediately and please report this bug>",
2287 -1, -1, printcharfun
, 0);
2295 /* Print a description of INTERVAL using PRINTCHARFUN.
2296 This is part of printing a string that has text properties. */
2299 print_interval (interval
, printcharfun
)
2301 Lisp_Object printcharfun
;
2303 if (NILP (interval
->plist
))
2306 print_object (make_number (interval
->position
), printcharfun
, 1);
2308 print_object (make_number (interval
->position
+ LENGTH (interval
)),
2311 print_object (interval
->plist
, printcharfun
, 1);
2318 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
2319 staticpro (&Qtemp_buffer_setup_hook
);
2321 DEFVAR_LISP ("standard-output", &Vstandard_output
,
2322 doc
: /* Output stream `print' uses by default for outputting a character.
2323 This may be any function of one argument.
2324 It may also be a buffer (output is inserted before point)
2325 or a marker (output is inserted and the marker is advanced)
2326 or the symbol t (output appears in the echo area). */);
2327 Vstandard_output
= Qt
;
2328 Qstandard_output
= intern ("standard-output");
2329 staticpro (&Qstandard_output
);
2331 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
2332 doc
: /* The format descriptor string used to print floats.
2333 This is a %-spec like those accepted by `printf' in C,
2334 but with some restrictions. It must start with the two characters `%.'.
2335 After that comes an integer precision specification,
2336 and then a letter which controls the format.
2337 The letters allowed are `e', `f' and `g'.
2338 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2339 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2340 Use `g' to choose the shorter of those two formats for the number at hand.
2341 The precision in any of these cases is the number of digits following
2342 the decimal point. With `f', a precision of 0 means to omit the
2343 decimal point. 0 is not allowed with `e' or `g'.
2345 A value of nil means to use the shortest notation
2346 that represents the number without losing information. */);
2347 Vfloat_output_format
= Qnil
;
2348 Qfloat_output_format
= intern ("float-output-format");
2349 staticpro (&Qfloat_output_format
);
2351 DEFVAR_LISP ("print-length", &Vprint_length
,
2352 doc
: /* Maximum length of list to print before abbreviating.
2353 A value of nil means no limit. See also `eval-expression-print-length'. */);
2354 Vprint_length
= Qnil
;
2356 DEFVAR_LISP ("print-level", &Vprint_level
,
2357 doc
: /* Maximum depth of list nesting to print before abbreviating.
2358 A value of nil means no limit. See also `eval-expression-print-level'. */);
2359 Vprint_level
= Qnil
;
2361 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
2362 doc
: /* Non-nil means print newlines in strings as `\\n'.
2363 Also print formfeeds as `\\f'. */);
2364 print_escape_newlines
= 0;
2366 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
2367 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2368 \(OOO is the octal representation of the character code.)
2369 Only single-byte characters are affected, and only in `prin1'.
2370 When the output goes in a multibyte buffer, this feature is
2371 enabled regardless of the value of the variable. */);
2372 print_escape_nonascii
= 0;
2374 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
2375 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2376 \(XXXX is the hex representation of the character code.)
2377 This affects only `prin1'. */);
2378 print_escape_multibyte
= 0;
2380 DEFVAR_BOOL ("print-quoted", &print_quoted
,
2381 doc
: /* Non-nil means print quoted forms with reader syntax.
2382 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2383 forms print as in the new syntax. */);
2386 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
2387 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2388 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2389 When the uninterned symbol appears within a recursive data structure,
2390 and the symbol appears more than once, in addition use the #N# and #N=
2391 constructs as needed, so that multiple references to the same symbol are
2392 shared once again when the text is read back. */);
2393 Vprint_gensym
= Qnil
;
2395 DEFVAR_LISP ("print-circle", &Vprint_circle
,
2396 doc
: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2397 If nil, printing proceeds recursively and may lead to
2398 `max-lisp-eval-depth' being exceeded or an error may occur:
2399 \"Apparently circular structure being printed.\" Also see
2400 `print-length' and `print-level'.
2401 If non-nil, shared substructures anywhere in the structure are printed
2402 with `#N=' before the first occurrence (in the order of the print
2403 representation) and `#N#' in place of each subsequent occurrence,
2404 where N is a positive decimal integer. */);
2405 Vprint_circle
= Qnil
;
2407 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
2408 doc
: /* *Non-nil means number continuously across print calls.
2409 This affects the numbers printed for #N= labels and #M# references.
2410 See also `print-circle', `print-gensym', and `print-number-table'.
2411 This variable should not be set with `setq'; bind it with a `let' instead. */);
2412 Vprint_continuous_numbering
= Qnil
;
2414 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
2415 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2416 The Lisp printer uses this vector to detect Lisp objects referenced more
2419 When you bind `print-continuous-numbering' to t, you should probably
2420 also bind `print-number-table' to nil. This ensures that the value of
2421 `print-number-table' can be garbage-collected once the printing is
2422 done. If all elements of `print-number-table' are nil, it means that
2423 the printing done so far has not found any shared structure or objects
2424 that need to be recorded in the table. */);
2425 Vprint_number_table
= Qnil
;
2427 DEFVAR_LISP ("print-charset-text-property", &Vprint_charset_text_property
,
2428 doc
: /* A flag to control printing of `charset' text property on printing a string.
2429 The value must be nil, t, or `default'.
2431 If the value is nil, don't print the text property `charset'.
2433 If the value is t, always print the text property `charset'.
2435 If the value is `default', print the text property `charset' only when
2436 the value is different from what is guessed in the current charset
2438 Vprint_charset_text_property
= Qdefault
;
2440 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2441 staticpro (&Vprin1_to_string_buffer
);
2444 defsubr (&Sprin1_to_string
);
2445 defsubr (&Serror_message_string
);
2449 defsubr (&Swrite_char
);
2450 defsubr (&Sexternal_debugging_output
);
2451 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2452 defsubr (&Sredirect_debugging_output
);
2455 Qexternal_debugging_output
= intern ("external-debugging-output");
2456 staticpro (&Qexternal_debugging_output
);
2458 Qprint_escape_newlines
= intern ("print-escape-newlines");
2459 staticpro (&Qprint_escape_newlines
);
2461 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
2462 staticpro (&Qprint_escape_multibyte
);
2464 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
2465 staticpro (&Qprint_escape_nonascii
);
2467 print_prune_charset_plist
= Qnil
;
2468 staticpro (&print_prune_charset_plist
);
2470 defsubr (&Swith_output_to_temp_buffer
);
2473 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2474 (do not change this comment) */