1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997,
3 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
27 #include "character.h"
33 #include "dispextern.h"
35 #include "intervals.h"
36 #include "blockinput.h"
37 #include "termhooks.h" /* For struct terminal. */
40 Lisp_Object Vstandard_output
, Qstandard_output
;
42 Lisp_Object Qtemp_buffer_setup_hook
;
44 /* These are used to print like we read. */
46 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
54 /* Default to values appropriate for IEEE floating point. */
59 #define DBL_MANT_DIG 53
65 #define DBL_MIN 2.2250738585072014e-308
68 #ifdef DBL_MIN_REPLACEMENT
70 #define DBL_MIN DBL_MIN_REPLACEMENT
73 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
74 needed to express a float without losing information.
75 The general-case formula is valid for the usual case, IEEE floating point,
76 but many compilers can't optimize the formula to an integer constant,
77 so make a special case for it. */
78 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
79 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
81 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
84 /* Avoid actual stack overflow in print. */
87 /* Level of nesting inside outputting backquote in new style. */
88 int new_backquote_output
;
90 /* Detect most circularities to print finite output. */
91 #define PRINT_CIRCLE 200
92 Lisp_Object being_printed
[PRINT_CIRCLE
];
94 /* When printing into a buffer, first we put the text in this
95 block, then insert it all at once. */
98 /* Size allocated in print_buffer. */
99 int print_buffer_size
;
100 /* Chars stored in print_buffer. */
101 int print_buffer_pos
;
102 /* Bytes stored in print_buffer. */
103 int print_buffer_pos_byte
;
105 /* Maximum length of list to print in full; noninteger means
106 effectively infinity */
108 Lisp_Object Vprint_length
;
110 /* Maximum depth of list to print in full; noninteger means
111 effectively infinity. */
113 Lisp_Object Vprint_level
;
115 /* Nonzero means print newlines in strings as \n. */
117 int print_escape_newlines
;
119 /* Nonzero means to print single-byte non-ascii characters in strings as
122 int print_escape_nonascii
;
124 /* Nonzero means to print multibyte characters in strings as hex escapes. */
126 int print_escape_multibyte
;
128 Lisp_Object Qprint_escape_newlines
;
129 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
131 /* Nonzero means print (quote foo) forms as 'foo, etc. */
135 /* Non-nil means print #: before uninterned symbols. */
137 Lisp_Object Vprint_gensym
;
139 /* Non-nil means print recursive structures using #n= and #n# syntax. */
141 Lisp_Object Vprint_circle
;
143 /* Non-nil means keep continuous number for #n= and #n# syntax
144 between several print functions. */
146 Lisp_Object Vprint_continuous_numbering
;
148 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
149 where OBJn are objects going to be printed, and STATn are their status,
150 which may be different meanings during process. See the comments of
151 the functions print and print_preprocess for details.
152 print_number_index keeps the last position the next object should be added,
153 twice of which is the actual vector position in Vprint_number_table. */
154 int print_number_index
;
155 Lisp_Object Vprint_number_table
;
157 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
158 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
159 See the comment of the variable Vprint_number_table. */
160 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
161 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
163 void print_interval (INTERVAL interval
, Lisp_Object printcharfun
);
165 /* GDB resets this to zero on W32 to disable OutputDebugString calls. */
166 int print_output_debug_flag
= 1;
169 /* Low level output routines for characters and strings */
171 /* Lisp functions to do output using a stream
172 must have the stream in a variable called printcharfun
173 and must start with PRINTPREPARE, end with PRINTFINISH,
174 and use PRINTDECLARE to declare common variables.
175 Use PRINTCHAR to output one character,
176 or call strout to output a block of characters. */
178 #define PRINTDECLARE \
179 struct buffer *old = current_buffer; \
180 int old_point = -1, start_point = -1; \
181 int old_point_byte = -1, start_point_byte = -1; \
182 int specpdl_count = SPECPDL_INDEX (); \
183 int free_print_buffer = 0; \
184 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
187 #define PRINTPREPARE \
188 original = printcharfun; \
189 if (NILP (printcharfun)) printcharfun = Qt; \
190 if (BUFFERP (printcharfun)) \
192 if (XBUFFER (printcharfun) != current_buffer) \
193 Fset_buffer (printcharfun); \
194 printcharfun = Qnil; \
196 if (MARKERP (printcharfun)) \
198 EMACS_INT marker_pos; \
199 if (! XMARKER (printcharfun)->buffer) \
200 error ("Marker does not point anywhere"); \
201 if (XMARKER (printcharfun)->buffer != current_buffer) \
202 set_buffer_internal (XMARKER (printcharfun)->buffer); \
203 marker_pos = marker_position (printcharfun); \
204 if (marker_pos < BEGV || marker_pos > ZV) \
205 error ("Marker is outside the accessible part of the buffer"); \
207 old_point_byte = PT_BYTE; \
208 SET_PT_BOTH (marker_pos, \
209 marker_byte_position (printcharfun)); \
211 start_point_byte = PT_BYTE; \
212 printcharfun = Qnil; \
214 if (NILP (printcharfun)) \
216 Lisp_Object string; \
217 if (NILP (current_buffer->enable_multibyte_characters) \
218 && ! print_escape_multibyte) \
219 specbind (Qprint_escape_multibyte, Qt); \
220 if (! NILP (current_buffer->enable_multibyte_characters) \
221 && ! print_escape_nonascii) \
222 specbind (Qprint_escape_nonascii, Qt); \
223 if (print_buffer != 0) \
225 string = make_string_from_bytes (print_buffer, \
227 print_buffer_pos_byte); \
228 record_unwind_protect (print_unwind, string); \
232 print_buffer_size = 1000; \
233 print_buffer = (char *) xmalloc (print_buffer_size); \
234 free_print_buffer = 1; \
236 print_buffer_pos = 0; \
237 print_buffer_pos_byte = 0; \
239 if (EQ (printcharfun, Qt) && ! noninteractive) \
240 setup_echo_area_for_printing (multibyte);
242 #define PRINTFINISH \
243 if (NILP (printcharfun)) \
245 if (print_buffer_pos != print_buffer_pos_byte \
246 && NILP (current_buffer->enable_multibyte_characters)) \
248 unsigned char *temp \
249 = (unsigned char *) alloca (print_buffer_pos + 1); \
250 copy_text (print_buffer, temp, print_buffer_pos_byte, \
252 insert_1_both (temp, print_buffer_pos, \
253 print_buffer_pos, 0, 1, 0); \
256 insert_1_both (print_buffer, print_buffer_pos, \
257 print_buffer_pos_byte, 0, 1, 0); \
258 signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
260 if (free_print_buffer) \
262 xfree (print_buffer); \
265 unbind_to (specpdl_count, Qnil); \
266 if (MARKERP (original)) \
267 set_marker_both (original, Qnil, PT, PT_BYTE); \
268 if (old_point >= 0) \
269 SET_PT_BOTH (old_point + (old_point >= start_point \
270 ? PT - start_point : 0), \
271 old_point_byte + (old_point_byte >= start_point_byte \
272 ? PT_BYTE - start_point_byte : 0)); \
273 if (old != current_buffer) \
274 set_buffer_internal (old);
276 #define PRINTCHAR(ch) printchar (ch, printcharfun)
278 /* This is used to restore the saved contents of print_buffer
279 when there is a recursive call to print. */
282 print_unwind (Lisp_Object saved_text
)
284 memcpy (print_buffer
, SDATA (saved_text
), SCHARS (saved_text
));
289 /* Print character CH using method FUN. FUN nil means print to
290 print_buffer. FUN t means print to echo area or stdout if
291 non-interactive. If FUN is neither nil nor t, call FUN with CH as
295 printchar (unsigned int ch
, Lisp_Object fun
)
297 if (!NILP (fun
) && !EQ (fun
, Qt
))
298 call1 (fun
, make_number (ch
));
301 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
302 int len
= CHAR_STRING (ch
, str
);
308 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
309 print_buffer
= (char *) xrealloc (print_buffer
,
310 print_buffer_size
*= 2);
311 memcpy (print_buffer
+ print_buffer_pos_byte
, str
, len
);
312 print_buffer_pos
+= 1;
313 print_buffer_pos_byte
+= len
;
315 else if (noninteractive
)
317 fwrite (str
, 1, len
, stdout
);
318 noninteractive_need_newline
= 1;
323 = !NILP (current_buffer
->enable_multibyte_characters
);
325 setup_echo_area_for_printing (multibyte_p
);
327 message_dolog (str
, len
, 0, multibyte_p
);
333 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
334 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
335 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
336 print_buffer. PRINTCHARFUN t means output to the echo area or to
337 stdout if non-interactive. If neither nil nor t, call Lisp
338 function PRINTCHARFUN for each character printed. MULTIBYTE
339 non-zero means PTR contains multibyte characters.
341 In the case where PRINTCHARFUN is nil, it is safe for PTR to point
342 to data in a Lisp string. Otherwise that is not safe. */
345 strout (const char *ptr
, int size
, int size_byte
, Lisp_Object printcharfun
,
349 size_byte
= size
= strlen (ptr
);
351 if (NILP (printcharfun
))
353 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
355 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
356 print_buffer
= (char *) xrealloc (print_buffer
,
359 memcpy (print_buffer
+ print_buffer_pos_byte
, ptr
, size_byte
);
360 print_buffer_pos
+= size
;
361 print_buffer_pos_byte
+= size_byte
;
363 else if (noninteractive
&& EQ (printcharfun
, Qt
))
365 fwrite (ptr
, 1, size_byte
, stdout
);
366 noninteractive_need_newline
= 1;
368 else if (EQ (printcharfun
, Qt
))
370 /* Output to echo area. We're trying to avoid a little overhead
371 here, that's the reason we don't call printchar to do the
375 = !NILP (current_buffer
->enable_multibyte_characters
);
377 setup_echo_area_for_printing (multibyte_p
);
378 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
380 if (size
== size_byte
)
382 for (i
= 0; i
< size
; ++i
)
383 insert_char ((unsigned char) *ptr
++);
388 for (i
= 0; i
< size_byte
; i
+= len
)
390 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, len
);
397 /* PRINTCHARFUN is a Lisp function. */
400 if (size
== size_byte
)
402 while (i
< size_byte
)
410 while (i
< size_byte
)
412 /* Here, we must convert each multi-byte form to the
413 corresponding character code before handing it to
416 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, len
);
424 /* Print the contents of a string STRING using PRINTCHARFUN.
425 It isn't safe to use strout in many cases,
426 because printing one char can relocate. */
429 print_string (Lisp_Object string
, Lisp_Object printcharfun
)
431 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
435 if (print_escape_nonascii
)
436 string
= string_escape_byte8 (string
);
438 if (STRING_MULTIBYTE (string
))
439 chars
= SCHARS (string
);
440 else if (! print_escape_nonascii
441 && (EQ (printcharfun
, Qt
)
442 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
443 : ! NILP (current_buffer
->enable_multibyte_characters
)))
445 /* If unibyte string STRING contains 8-bit codes, we must
446 convert STRING to a multibyte string containing the same
451 chars
= SBYTES (string
);
452 bytes
= parse_str_to_multibyte (SDATA (string
), chars
);
455 newstr
= make_uninit_multibyte_string (chars
, bytes
);
456 memcpy (SDATA (newstr
), SDATA (string
), chars
);
457 str_to_multibyte (SDATA (newstr
), bytes
, chars
);
462 chars
= SBYTES (string
);
464 if (EQ (printcharfun
, Qt
))
466 /* Output to echo area. */
467 int nbytes
= SBYTES (string
);
470 /* Copy the string contents so that relocation of STRING by
471 GC does not cause trouble. */
474 SAFE_ALLOCA (buffer
, char *, nbytes
);
475 memcpy (buffer
, SDATA (string
), nbytes
);
477 strout (buffer
, chars
, SBYTES (string
),
478 printcharfun
, STRING_MULTIBYTE (string
));
483 /* No need to copy, since output to print_buffer can't GC. */
484 strout (SDATA (string
),
485 chars
, SBYTES (string
),
486 printcharfun
, STRING_MULTIBYTE (string
));
490 /* Otherwise, string may be relocated by printing one char.
491 So re-fetch the string address for each character. */
493 int size
= SCHARS (string
);
494 int size_byte
= SBYTES (string
);
497 if (size
== size_byte
)
498 for (i
= 0; i
< size
; i
++)
499 PRINTCHAR (SREF (string
, i
));
501 for (i
= 0; i
< size_byte
; )
503 /* Here, we must convert each multi-byte form to the
504 corresponding character code before handing it to PRINTCHAR. */
506 int ch
= STRING_CHAR_AND_LENGTH (SDATA (string
) + i
, len
);
514 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
515 doc
: /* Output character CHARACTER to stream PRINTCHARFUN.
516 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
517 (Lisp_Object character
, Lisp_Object printcharfun
)
521 if (NILP (printcharfun
))
522 printcharfun
= Vstandard_output
;
523 CHECK_NUMBER (character
);
525 PRINTCHAR (XINT (character
));
530 /* Used from outside of print.c to print a block of SIZE
531 single-byte chars at DATA on the default output stream.
532 Do not use this on the contents of a Lisp string. */
535 write_string (const char *data
, int size
)
538 Lisp_Object printcharfun
;
540 printcharfun
= Vstandard_output
;
543 strout (data
, size
, size
, printcharfun
, 0);
547 /* Used from outside of print.c to print a block of SIZE
548 single-byte chars at DATA on a specified stream PRINTCHARFUN.
549 Do not use this on the contents of a Lisp string. */
552 write_string_1 (const char *data
, int size
, Lisp_Object printcharfun
)
557 strout (data
, size
, size
, printcharfun
, 0);
563 temp_output_buffer_setup (const char *bufname
)
565 int count
= SPECPDL_INDEX ();
566 register struct buffer
*old
= current_buffer
;
567 register Lisp_Object buf
;
569 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
571 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
573 Fkill_all_local_variables ();
574 delete_all_overlays (current_buffer
);
575 current_buffer
->directory
= old
->directory
;
576 current_buffer
->read_only
= Qnil
;
577 current_buffer
->filename
= Qnil
;
578 current_buffer
->undo_list
= Qt
;
579 eassert (current_buffer
->overlays_before
== NULL
);
580 eassert (current_buffer
->overlays_after
== NULL
);
581 current_buffer
->enable_multibyte_characters
582 = buffer_defaults
.enable_multibyte_characters
;
583 specbind (Qinhibit_read_only
, Qt
);
584 specbind (Qinhibit_modification_hooks
, Qt
);
586 XSETBUFFER (buf
, current_buffer
);
588 Frun_hooks (1, &Qtemp_buffer_setup_hook
);
590 unbind_to (count
, Qnil
);
592 specbind (Qstandard_output
, buf
);
596 internal_with_output_to_temp_buffer (const char *bufname
, Lisp_Object (*function
) (Lisp_Object
), Lisp_Object args
)
598 int count
= SPECPDL_INDEX ();
599 Lisp_Object buf
, val
;
603 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
604 temp_output_buffer_setup (bufname
);
605 buf
= Vstandard_output
;
608 val
= (*function
) (args
);
611 temp_output_buffer_show (buf
);
614 return unbind_to (count
, val
);
617 DEFUN ("with-output-to-temp-buffer",
618 Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
620 doc
: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
622 This construct makes buffer BUFNAME empty before running BODY.
623 It does not make the buffer current for BODY.
624 Instead it binds `standard-output' to that buffer, so that output
625 generated with `prin1' and similar functions in BODY goes into
628 At the end of BODY, this marks buffer BUFNAME unmodifed and displays
629 it in a window, but does not select it. The normal way to do this is
630 by calling `display-buffer', then running `temp-buffer-show-hook'.
631 However, if `temp-buffer-show-function' is non-nil, it calls that
632 function instead (and does not run `temp-buffer-show-hook'). The
633 function gets one argument, the buffer to display.
635 The return value of `with-output-to-temp-buffer' is the value of the
636 last form in BODY. If BODY does not finish normally, the buffer
637 BUFNAME is not displayed.
639 This runs the hook `temp-buffer-setup-hook' before BODY,
640 with the buffer BUFNAME temporarily current. It runs the hook
641 `temp-buffer-show-hook' after displaying buffer BUFNAME, with that
642 buffer temporarily current, and the window that was used to display it
643 temporarily selected. But it doesn't run `temp-buffer-show-hook'
644 if it uses `temp-buffer-show-function'.
646 usage: (with-output-to-temp-buffer BUFNAME BODY...) */)
651 int count
= SPECPDL_INDEX ();
652 Lisp_Object buf
, val
;
655 name
= Feval (Fcar (args
));
657 temp_output_buffer_setup (SDATA (name
));
658 buf
= Vstandard_output
;
661 val
= Fprogn (XCDR (args
));
664 temp_output_buffer_show (buf
);
667 return unbind_to (count
, val
);
671 static void print (Lisp_Object obj
, register Lisp_Object printcharfun
, int escapeflag
);
672 static void print_preprocess (Lisp_Object obj
);
673 static void print_preprocess_string (INTERVAL interval
, Lisp_Object arg
);
674 static void print_object (Lisp_Object obj
, register Lisp_Object printcharfun
, int escapeflag
);
676 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
677 doc
: /* Output a newline to stream PRINTCHARFUN.
678 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
679 (Lisp_Object printcharfun
)
683 if (NILP (printcharfun
))
684 printcharfun
= Vstandard_output
;
691 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
692 doc
: /* Output the printed representation of OBJECT, any Lisp object.
693 Quoting characters are printed when needed to make output that `read'
694 can handle, whenever this is possible. For complex objects, the behavior
695 is controlled by `print-level' and `print-length', which see.
697 OBJECT is any of the Lisp data types: a number, a string, a symbol,
698 a list, a buffer, a window, a frame, etc.
700 A printed representation of an object is text which describes that object.
702 Optional argument PRINTCHARFUN is the output stream, which can be one
705 - a buffer, in which case output is inserted into that buffer at point;
706 - a marker, in which case output is inserted at marker's position;
707 - a function, in which case that function is called once for each
708 character of OBJECT's printed representation;
709 - a symbol, in which case that symbol's function definition is called; or
710 - t, in which case the output is displayed in the echo area.
712 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
714 (Lisp_Object object
, Lisp_Object printcharfun
)
718 if (NILP (printcharfun
))
719 printcharfun
= Vstandard_output
;
721 print (object
, printcharfun
, 1);
726 /* a buffer which is used to hold output being built by prin1-to-string */
727 Lisp_Object Vprin1_to_string_buffer
;
729 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
730 doc
: /* Return a string containing the printed representation of OBJECT.
731 OBJECT can be any Lisp object. This function outputs quoting characters
732 when necessary to make output that `read' can handle, whenever possible,
733 unless the optional second argument NOESCAPE is non-nil. For complex objects,
734 the behavior is controlled by `print-level' and `print-length', which see.
736 OBJECT is any of the Lisp data types: a number, a string, a symbol,
737 a list, a buffer, a window, a frame, etc.
739 A printed representation of an object is text which describes that object. */)
740 (Lisp_Object object
, Lisp_Object noescape
)
742 Lisp_Object printcharfun
;
743 /* struct gcpro gcpro1, gcpro2; */
744 Lisp_Object save_deactivate_mark
;
745 int count
= SPECPDL_INDEX ();
746 struct buffer
*previous
;
748 specbind (Qinhibit_modification_hooks
, Qt
);
753 /* Save and restore this--we are altering a buffer
754 but we don't want to deactivate the mark just for that.
755 No need for specbind, since errors deactivate the mark. */
756 save_deactivate_mark
= Vdeactivate_mark
;
757 /* GCPRO2 (object, save_deactivate_mark); */
760 printcharfun
= Vprin1_to_string_buffer
;
762 print (object
, printcharfun
, NILP (noescape
));
763 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
767 previous
= current_buffer
;
768 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
769 object
= Fbuffer_string ();
770 if (SBYTES (object
) == SCHARS (object
))
771 STRING_SET_UNIBYTE (object
);
773 /* Note that this won't make prepare_to_modify_buffer call
774 ask-user-about-supersession-threat because this buffer
775 does not visit a file. */
777 set_buffer_internal (previous
);
779 Vdeactivate_mark
= save_deactivate_mark
;
783 return unbind_to (count
, object
);
786 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
787 doc
: /* Output the printed representation of OBJECT, any Lisp object.
788 No quoting characters are used; no delimiters are printed around
789 the contents of strings.
791 OBJECT is any of the Lisp data types: a number, a string, a symbol,
792 a list, a buffer, a window, a frame, etc.
794 A printed representation of an object is text which describes that object.
796 Optional argument PRINTCHARFUN is the output stream, which can be one
799 - a buffer, in which case output is inserted into that buffer at point;
800 - a marker, in which case output is inserted at marker's position;
801 - a function, in which case that function is called once for each
802 character of OBJECT's printed representation;
803 - a symbol, in which case that symbol's function definition is called; or
804 - t, in which case the output is displayed in the echo area.
806 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
808 (Lisp_Object object
, Lisp_Object printcharfun
)
812 if (NILP (printcharfun
))
813 printcharfun
= Vstandard_output
;
815 print (object
, printcharfun
, 0);
820 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
821 doc
: /* Output the printed representation of OBJECT, with newlines around it.
822 Quoting characters are printed when needed to make output that `read'
823 can handle, whenever this is possible. For complex objects, the behavior
824 is controlled by `print-level' and `print-length', which see.
826 OBJECT is any of the Lisp data types: a number, a string, a symbol,
827 a list, a buffer, a window, a frame, etc.
829 A printed representation of an object is text which describes that object.
831 Optional argument PRINTCHARFUN is the output stream, which can be one
834 - a buffer, in which case output is inserted into that buffer at point;
835 - a marker, in which case output is inserted at marker's position;
836 - a function, in which case that function is called once for each
837 character of OBJECT's printed representation;
838 - a symbol, in which case that symbol's function definition is called; or
839 - t, in which case the output is displayed in the echo area.
841 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
843 (Lisp_Object object
, Lisp_Object printcharfun
)
848 if (NILP (printcharfun
))
849 printcharfun
= Vstandard_output
;
853 print (object
, printcharfun
, 1);
860 /* The subroutine object for external-debugging-output is kept here
861 for the convenience of the debugger. */
862 Lisp_Object Qexternal_debugging_output
;
864 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
865 doc
: /* Write CHARACTER to stderr.
866 You can call print while debugging emacs, and pass it this function
867 to make it write to the debugging output. */)
868 (Lisp_Object character
)
870 CHECK_NUMBER (character
);
871 putc (XINT (character
), stderr
);
874 /* Send the output to a debugger (nothing happens if there isn't one). */
875 if (print_output_debug_flag
)
877 char buf
[2] = {(char) XINT (character
), '\0'};
878 OutputDebugString (buf
);
885 /* This function is never called. Its purpose is to prevent
886 print_output_debug_flag from being optimized away. */
889 debug_output_compilation_hack (int x
)
891 print_output_debug_flag
= x
;
894 #if defined (GNU_LINUX)
896 /* This functionality is not vitally important in general, so we rely on
897 non-portable ability to use stderr as lvalue. */
899 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
901 FILE *initial_stderr_stream
= NULL
;
903 DEFUN ("redirect-debugging-output", Fredirect_debugging_output
, Sredirect_debugging_output
,
905 "FDebug output file: \nP",
906 doc
: /* Redirect debugging output (stderr stream) to file FILE.
907 If FILE is nil, reset target to the initial stderr stream.
908 Optional arg APPEND non-nil (interactively, with prefix arg) means
909 append to existing target file. */)
910 (Lisp_Object file
, Lisp_Object append
)
912 if (initial_stderr_stream
!= NULL
)
918 stderr
= initial_stderr_stream
;
919 initial_stderr_stream
= NULL
;
923 file
= Fexpand_file_name (file
, Qnil
);
924 initial_stderr_stream
= stderr
;
925 stderr
= fopen (SDATA (file
), NILP (append
) ? "w" : "a");
928 stderr
= initial_stderr_stream
;
929 initial_stderr_stream
= NULL
;
930 report_file_error ("Cannot open debugging output stream",
936 #endif /* GNU_LINUX */
939 /* This is the interface for debugging printing. */
942 debug_print (Lisp_Object arg
)
944 Fprin1 (arg
, Qexternal_debugging_output
);
945 fprintf (stderr
, "\r\n");
949 safe_debug_print (Lisp_Object arg
)
951 int valid
= valid_lisp_object_p (arg
);
956 fprintf (stderr
, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
957 !valid
? "INVALID" : "SOME",
958 (unsigned long) XHASH (arg
)
963 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
965 doc
: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
966 See Info anchor `(elisp)Definition of signal' for some details on how this
967 error message is constructed. */)
970 struct buffer
*old
= current_buffer
;
974 /* If OBJ is (error STRING), just return STRING.
975 That is not only faster, it also avoids the need to allocate
976 space here when the error is due to memory full. */
977 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
978 && CONSP (XCDR (obj
))
979 && STRINGP (XCAR (XCDR (obj
)))
980 && NILP (XCDR (XCDR (obj
))))
981 return XCAR (XCDR (obj
));
983 print_error_message (obj
, Vprin1_to_string_buffer
, 0, Qnil
);
985 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
986 value
= Fbuffer_string ();
990 set_buffer_internal (old
);
996 /* Print an error message for the error DATA onto Lisp output stream
997 STREAM (suitable for the print functions).
998 CONTEXT is a C string describing the context of the error.
999 CALLER is the Lisp function inside which the error was signaled. */
1002 print_error_message (Lisp_Object data
, Lisp_Object stream
, const char *context
,
1005 Lisp_Object errname
, errmsg
, file_error
, tail
;
1006 struct gcpro gcpro1
;
1010 write_string_1 (context
, -1, stream
);
1012 /* If we know from where the error was signaled, show it in
1014 if (!NILP (caller
) && SYMBOLP (caller
))
1016 Lisp_Object cname
= SYMBOL_NAME (caller
);
1017 char *name
= alloca (SBYTES (cname
));
1018 memcpy (name
, SDATA (cname
), SBYTES (cname
));
1019 message_dolog (name
, SBYTES (cname
), 0, 0);
1020 message_dolog (": ", 2, 0, 0);
1023 errname
= Fcar (data
);
1025 if (EQ (errname
, Qerror
))
1030 errmsg
= Fcar (data
);
1035 Lisp_Object error_conditions
;
1036 errmsg
= Fget (errname
, Qerror_message
);
1037 error_conditions
= Fget (errname
, Qerror_conditions
);
1038 file_error
= Fmemq (Qfile_error
, error_conditions
);
1041 /* Print an error message including the data items. */
1043 tail
= Fcdr_safe (data
);
1046 /* For file-error, make error message by concatenating
1047 all the data items. They are all strings. */
1048 if (!NILP (file_error
) && CONSP (tail
))
1049 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
1051 if (STRINGP (errmsg
))
1052 Fprinc (errmsg
, stream
);
1054 write_string_1 ("peculiar error", -1, stream
);
1056 for (i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
1060 write_string_1 (i
? ", " : ": ", 2, stream
);
1062 if (!NILP (file_error
) || EQ (errname
, Qend_of_file
))
1063 Fprinc (obj
, stream
);
1065 Fprin1 (obj
, stream
);
1074 * The buffer should be at least as large as the max string size of the
1075 * largest float, printed in the biggest notation. This is undoubtedly
1076 * 20d float_output_format, with the negative of the C-constant "HUGE"
1079 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1081 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1082 * case of -1e307 in 20d float_output_format. What is one to do (short of
1083 * re-writing _doprnt to be more sane)?
1088 float_to_string (unsigned char *buf
, double data
)
1093 /* Check for plus infinity in a way that won't lose
1094 if there is no plus infinity. */
1095 if (data
== data
/ 2 && data
> 1.0)
1097 strcpy (buf
, "1.0e+INF");
1100 /* Likewise for minus infinity. */
1101 if (data
== data
/ 2 && data
< -1.0)
1103 strcpy (buf
, "-1.0e+INF");
1106 /* Check for NaN in a way that won't fail if there are no NaNs. */
1107 if (! (data
* 0.0 >= 0.0))
1109 /* Prepend "-" if the NaN's sign bit is negative.
1110 The sign bit of a double is the bit that is 1 in -0.0. */
1112 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
1114 u_minus_zero
.d
= - 0.0;
1115 for (i
= 0; i
< sizeof (double); i
++)
1116 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1122 strcpy (buf
, "0.0e+NaN");
1126 if (NILP (Vfloat_output_format
)
1127 || !STRINGP (Vfloat_output_format
))
1130 /* Generate the fewest number of digits that represent the
1131 floating point value without losing information.
1132 The following method is simple but a bit slow.
1133 For ideas about speeding things up, please see:
1135 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1136 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1138 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1139 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1141 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1143 sprintf (buf
, "%.*g", width
, data
);
1144 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1146 else /* oink oink */
1148 /* Check that the spec we have is fully valid.
1149 This means not only valid for printf,
1150 but meant for floats, and reasonable. */
1151 cp
= SDATA (Vfloat_output_format
);
1160 /* Check the width specification. */
1162 if ('0' <= *cp
&& *cp
<= '9')
1166 width
= (width
* 10) + (*cp
++ - '0');
1167 while (*cp
>= '0' && *cp
<= '9');
1169 /* A precision of zero is valid only for %f. */
1171 || (width
== 0 && *cp
!= 'f'))
1175 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1181 sprintf (buf
, SDATA (Vfloat_output_format
), data
);
1184 /* Make sure there is a decimal point with digit after, or an
1185 exponent, so that the value is readable as a float. But don't do
1186 this with "%.0f"; it's valid for that not to produce a decimal
1187 point. Note that width can be 0 only for %.0f. */
1190 for (cp
= buf
; *cp
; cp
++)
1191 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1194 if (*cp
== '.' && cp
[1] == 0)
1211 print (Lisp_Object obj
, register Lisp_Object printcharfun
, int escapeflag
)
1213 new_backquote_output
= 0;
1215 /* Reset print_number_index and Vprint_number_table only when
1216 the variable Vprint_continuous_numbering is nil. Otherwise,
1217 the values of these variables will be kept between several
1219 if (NILP (Vprint_continuous_numbering
)
1220 || NILP (Vprint_number_table
))
1222 print_number_index
= 0;
1223 Vprint_number_table
= Qnil
;
1226 /* Construct Vprint_number_table for print-gensym and print-circle. */
1227 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1229 int i
, start
, index
;
1230 start
= index
= print_number_index
;
1231 /* Construct Vprint_number_table.
1232 This increments print_number_index for the objects added. */
1234 print_preprocess (obj
);
1236 /* Remove unnecessary objects, which appear only once in OBJ;
1237 that is, whose status is Qnil. Compactify the necessary objects. */
1238 for (i
= start
; i
< print_number_index
; i
++)
1239 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1241 PRINT_NUMBER_OBJECT (Vprint_number_table
, index
)
1242 = PRINT_NUMBER_OBJECT (Vprint_number_table
, i
);
1246 /* Clear out objects outside the active part of the table. */
1247 for (i
= index
; i
< print_number_index
; i
++)
1248 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
) = Qnil
;
1250 /* Reset the status field for the next print step. Now this
1251 field means whether the object has already been printed. */
1252 for (i
= start
; i
< print_number_index
; i
++)
1253 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qnil
;
1255 print_number_index
= index
;
1259 print_object (obj
, printcharfun
, escapeflag
);
1262 /* Construct Vprint_number_table according to the structure of OBJ.
1263 OBJ itself and all its elements will be added to Vprint_number_table
1264 recursively if it is a list, vector, compiled function, char-table,
1265 string (its text properties will be traced), or a symbol that has
1266 no obarray (this is for the print-gensym feature).
1267 The status fields of Vprint_number_table mean whether each object appears
1268 more than once in OBJ: Qnil at the first time, and Qt after that . */
1270 print_preprocess (Lisp_Object obj
)
1275 Lisp_Object halftail
;
1277 /* Give up if we go so deep that print_object will get an error. */
1278 /* See similar code in print_object. */
1279 if (print_depth
>= PRINT_CIRCLE
)
1280 error ("Apparently circular structure being printed");
1282 /* Avoid infinite recursion for circular nested structure
1283 in the case where Vprint_circle is nil. */
1284 if (NILP (Vprint_circle
))
1286 for (i
= 0; i
< print_depth
; i
++)
1287 if (EQ (obj
, being_printed
[i
]))
1289 being_printed
[print_depth
] = obj
;
1296 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1297 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
)
1298 || HASH_TABLE_P (obj
)
1299 || (! NILP (Vprint_gensym
)
1301 && !SYMBOL_INTERNED_P (obj
)))
1303 /* In case print-circle is nil and print-gensym is t,
1304 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1305 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1307 for (i
= 0; i
< print_number_index
; i
++)
1308 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1310 /* OBJ appears more than once. Let's remember that. */
1311 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1316 /* OBJ is not yet recorded. Let's add to the table. */
1317 if (print_number_index
== 0)
1319 /* Initialize the table. */
1320 Vprint_number_table
= Fmake_vector (make_number (40), Qnil
);
1322 else if (XVECTOR (Vprint_number_table
)->size
== print_number_index
* 2)
1324 /* Reallocate the table. */
1325 int i
= print_number_index
* 4;
1326 Lisp_Object old_table
= Vprint_number_table
;
1327 Vprint_number_table
= Fmake_vector (make_number (i
), Qnil
);
1328 for (i
= 0; i
< print_number_index
; i
++)
1330 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
)
1331 = PRINT_NUMBER_OBJECT (old_table
, i
);
1332 PRINT_NUMBER_STATUS (Vprint_number_table
, i
)
1333 = PRINT_NUMBER_STATUS (old_table
, i
);
1336 PRINT_NUMBER_OBJECT (Vprint_number_table
, print_number_index
) = obj
;
1337 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1338 always print the gensym with a number. This is a special for
1339 the lisp function byte-compile-output-docform. */
1340 if (!NILP (Vprint_continuous_numbering
)
1342 && !SYMBOL_INTERNED_P (obj
))
1343 PRINT_NUMBER_STATUS (Vprint_number_table
, print_number_index
) = Qt
;
1344 print_number_index
++;
1347 switch (XTYPE (obj
))
1350 /* A string may have text properties, which can be circular. */
1351 traverse_intervals_noorder (STRING_INTERVALS (obj
),
1352 print_preprocess_string
, Qnil
);
1356 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1357 just as in print_object. */
1358 if (loop_count
&& EQ (obj
, halftail
))
1360 print_preprocess (XCAR (obj
));
1363 if (!(loop_count
& 1))
1364 halftail
= XCDR (halftail
);
1367 case Lisp_Vectorlike
:
1368 size
= XVECTOR (obj
)->size
;
1369 if (size
& PSEUDOVECTOR_FLAG
)
1370 size
&= PSEUDOVECTOR_SIZE_MASK
;
1371 for (i
= 0; i
< size
; i
++)
1372 print_preprocess (XVECTOR (obj
)->contents
[i
]);
1373 if (HASH_TABLE_P (obj
))
1374 { /* For hash tables, the key_and_value slot is past
1375 `size' because it needs to be marked specially in case
1376 the table is weak. */
1377 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1378 print_preprocess (h
->key_and_value
);
1390 print_preprocess_string (INTERVAL interval
, Lisp_Object arg
)
1392 print_preprocess (interval
->plist
);
1395 /* A flag to control printing of `charset' text property.
1396 The default value is Qdefault. */
1397 Lisp_Object Vprint_charset_text_property
;
1399 static void print_check_string_charset_prop (INTERVAL interval
, Lisp_Object string
);
1401 #define PRINT_STRING_NON_CHARSET_FOUND 1
1402 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
1404 /* Bitwize or of the abobe macros. */
1405 static int print_check_string_result
;
1408 print_check_string_charset_prop (INTERVAL interval
, Lisp_Object string
)
1412 if (NILP (interval
->plist
)
1413 || (print_check_string_result
== (PRINT_STRING_NON_CHARSET_FOUND
1414 | PRINT_STRING_UNSAFE_CHARSET_FOUND
)))
1416 for (val
= interval
->plist
; CONSP (val
) && ! EQ (XCAR (val
), Qcharset
);
1417 val
= XCDR (XCDR (val
)));
1420 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1423 if (! (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
))
1425 if (! EQ (val
, interval
->plist
)
1426 || CONSP (XCDR (XCDR (val
))))
1427 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1429 if (NILP (Vprint_charset_text_property
)
1430 || ! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1433 int charpos
= interval
->position
;
1434 int bytepos
= string_char_to_byte (string
, charpos
);
1435 Lisp_Object charset
;
1437 charset
= XCAR (XCDR (val
));
1438 for (i
= 0; i
< LENGTH (interval
); i
++)
1440 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1441 if (! ASCII_CHAR_P (c
)
1442 && ! EQ (CHARSET_NAME (CHAR_CHARSET (c
)), charset
))
1444 print_check_string_result
|= PRINT_STRING_UNSAFE_CHARSET_FOUND
;
1451 /* The value is (charset . nil). */
1452 static Lisp_Object print_prune_charset_plist
;
1455 print_prune_string_charset (Lisp_Object string
)
1457 print_check_string_result
= 0;
1458 traverse_intervals (STRING_INTERVALS (string
), 0,
1459 print_check_string_charset_prop
, string
);
1460 if (! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1462 string
= Fcopy_sequence (string
);
1463 if (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
)
1465 if (NILP (print_prune_charset_plist
))
1466 print_prune_charset_plist
= Fcons (Qcharset
, Qnil
);
1467 Fremove_text_properties (make_number (0),
1468 make_number (SCHARS (string
)),
1469 print_prune_charset_plist
, string
);
1472 Fset_text_properties (make_number (0), make_number (SCHARS (string
)),
1479 print_object (Lisp_Object obj
, register Lisp_Object printcharfun
, int escapeflag
)
1485 /* See similar code in print_preprocess. */
1486 if (print_depth
>= PRINT_CIRCLE
)
1487 error ("Apparently circular structure being printed");
1489 /* Detect circularities and truncate them. */
1490 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1491 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
)
1492 || HASH_TABLE_P (obj
)
1493 || (! NILP (Vprint_gensym
)
1495 && !SYMBOL_INTERNED_P (obj
)))
1497 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1499 /* Simple but incomplete way. */
1501 for (i
= 0; i
< print_depth
; i
++)
1502 if (EQ (obj
, being_printed
[i
]))
1504 sprintf (buf
, "#%d", i
);
1505 strout (buf
, -1, -1, printcharfun
, 0);
1508 being_printed
[print_depth
] = obj
;
1512 /* With the print-circle feature. */
1514 for (i
= 0; i
< print_number_index
; i
++)
1515 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1517 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1519 /* Add a prefix #n= if OBJ has not yet been printed;
1520 that is, its status field is nil. */
1521 sprintf (buf
, "#%d=", i
+ 1);
1522 strout (buf
, -1, -1, printcharfun
, 0);
1523 /* OBJ is going to be printed. Set the status to t. */
1524 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1529 /* Just print #n# if OBJ has already been printed. */
1530 sprintf (buf
, "#%d#", i
+ 1);
1531 strout (buf
, -1, -1, printcharfun
, 0);
1540 switch (XTYPE (obj
))
1543 if (sizeof (int) == sizeof (EMACS_INT
))
1544 sprintf (buf
, "%d", (int) XINT (obj
));
1545 else if (sizeof (long) == sizeof (EMACS_INT
))
1546 sprintf (buf
, "%ld", (long) XINT (obj
));
1549 strout (buf
, -1, -1, printcharfun
, 0);
1554 char pigbuf
[350]; /* see comments in float_to_string */
1556 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1557 strout (pigbuf
, -1, -1, printcharfun
, 0);
1563 print_string (obj
, printcharfun
);
1566 register int i
, i_byte
;
1567 struct gcpro gcpro1
;
1570 /* 1 means we must ensure that the next character we output
1571 cannot be taken as part of a hex character escape. */
1572 int need_nonhex
= 0;
1573 int multibyte
= STRING_MULTIBYTE (obj
);
1577 if (! EQ (Vprint_charset_text_property
, Qt
))
1578 obj
= print_prune_string_charset (obj
);
1580 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1588 size_byte
= SBYTES (obj
);
1590 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1592 /* Here, we must convert each multi-byte form to the
1593 corresponding character code before handing it to PRINTCHAR. */
1599 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
, len
);
1607 if (c
== '\n' && print_escape_newlines
)
1612 else if (c
== '\f' && print_escape_newlines
)
1618 && (CHAR_BYTE8_P (c
)
1619 || (! ASCII_CHAR_P (c
) && print_escape_multibyte
)))
1621 /* When multibyte is disabled,
1622 print multibyte string chars using hex escapes.
1623 For a char code that could be in a unibyte string,
1624 when found in a multibyte string, always use a hex escape
1625 so it reads back as multibyte. */
1626 unsigned char outbuf
[50];
1628 if (CHAR_BYTE8_P (c
))
1629 sprintf (outbuf
, "\\%03o", CHAR_TO_BYTE8 (c
));
1632 sprintf (outbuf
, "\\x%04x", c
);
1635 strout (outbuf
, -1, -1, printcharfun
, 0);
1637 else if (! multibyte
1638 && SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1639 && print_escape_nonascii
)
1641 /* When printing in a multibyte buffer
1642 or when explicitly requested,
1643 print single-byte non-ASCII string chars
1644 using octal escapes. */
1645 unsigned char outbuf
[5];
1646 sprintf (outbuf
, "\\%03o", c
);
1647 strout (outbuf
, -1, -1, printcharfun
, 0);
1651 /* If we just had a hex escape, and this character
1652 could be taken as part of it,
1653 output `\ ' to prevent that. */
1657 if ((c
>= 'a' && c
<= 'f')
1658 || (c
>= 'A' && c
<= 'F')
1659 || (c
>= '0' && c
<= '9'))
1660 strout ("\\ ", -1, -1, printcharfun
, 0);
1663 if (c
== '\"' || c
== '\\')
1670 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1672 traverse_intervals (STRING_INTERVALS (obj
),
1673 0, print_interval
, printcharfun
);
1683 register int confusing
;
1684 register unsigned char *p
= SDATA (SYMBOL_NAME (obj
));
1685 register unsigned char *end
= p
+ SBYTES (SYMBOL_NAME (obj
));
1687 int i
, i_byte
, size_byte
;
1690 name
= SYMBOL_NAME (obj
);
1692 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1695 /* If symbol name begins with a digit, and ends with a digit,
1696 and contains nothing but digits and `e', it could be treated
1697 as a number. So set CONFUSING.
1699 Symbols that contain periods could also be taken as numbers,
1700 but periods are always escaped, so we don't have to worry
1702 else if (*p
>= '0' && *p
<= '9'
1703 && end
[-1] >= '0' && end
[-1] <= '9')
1705 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1706 /* Needed for \2e10. */
1707 || *p
== 'e' || *p
== 'E'))
1709 confusing
= (end
== p
);
1714 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1720 size_byte
= SBYTES (name
);
1722 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1724 /* Here, we must convert each multi-byte form to the
1725 corresponding character code before handing it to PRINTCHAR. */
1726 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1731 if (c
== '\"' || c
== '\\' || c
== '\''
1732 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1733 || c
== ',' || c
=='.' || c
== '`'
1734 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1736 PRINTCHAR ('\\'), confusing
= 0;
1744 /* If deeper than spec'd depth, print placeholder. */
1745 if (INTEGERP (Vprint_level
)
1746 && print_depth
> XINT (Vprint_level
))
1747 strout ("...", -1, -1, printcharfun
, 0);
1748 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1749 && (EQ (XCAR (obj
), Qquote
)))
1752 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1754 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1755 && (EQ (XCAR (obj
), Qfunction
)))
1759 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1761 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1762 && ((EQ (XCAR (obj
), Qbackquote
))))
1764 print_object (XCAR (obj
), printcharfun
, 0);
1765 new_backquote_output
++;
1766 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1767 new_backquote_output
--;
1769 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1770 && new_backquote_output
1771 && ((EQ (XCAR (obj
), Qbackquote
)
1772 || EQ (XCAR (obj
), Qcomma
)
1773 || EQ (XCAR (obj
), Qcomma_at
)
1774 || EQ (XCAR (obj
), Qcomma_dot
))))
1776 print_object (XCAR (obj
), printcharfun
, 0);
1777 new_backquote_output
--;
1778 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1779 new_backquote_output
++;
1785 /* If the first element is a backquote form,
1786 print it old-style so it won't be misunderstood. */
1787 if (print_quoted
&& CONSP (XCAR (obj
))
1788 && CONSP (XCDR (XCAR (obj
)))
1789 && NILP (XCDR (XCDR (XCAR (obj
))))
1790 && EQ (XCAR (XCAR (obj
)), Qbackquote
))
1796 print_object (Qbackquote
, printcharfun
, 0);
1799 print_object (XCAR (XCDR (tem
)), printcharfun
, 0);
1806 int print_length
, i
;
1807 Lisp_Object halftail
= obj
;
1809 /* Negative values of print-length are invalid in CL.
1810 Treat them like nil, as CMUCL does. */
1811 if (NATNUMP (Vprint_length
))
1812 print_length
= XFASTINT (Vprint_length
);
1819 /* Detect circular list. */
1820 if (NILP (Vprint_circle
))
1822 /* Simple but imcomplete way. */
1823 if (i
!= 0 && EQ (obj
, halftail
))
1825 sprintf (buf
, " . #%d", i
/ 2);
1826 strout (buf
, -1, -1, printcharfun
, 0);
1832 /* With the print-circle feature. */
1836 for (i
= 0; i
< print_number_index
; i
++)
1837 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
),
1840 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1842 strout (" . ", 3, 3, printcharfun
, 0);
1843 print_object (obj
, printcharfun
, escapeflag
);
1847 sprintf (buf
, " . #%d#", i
+ 1);
1848 strout (buf
, -1, -1, printcharfun
, 0);
1858 if (print_length
&& i
> print_length
)
1860 strout ("...", 3, 3, printcharfun
, 0);
1864 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1868 halftail
= XCDR (halftail
);
1872 /* OBJ non-nil here means it's the end of a dotted list. */
1875 strout (" . ", 3, 3, printcharfun
, 0);
1876 print_object (obj
, printcharfun
, escapeflag
);
1884 case Lisp_Vectorlike
:
1889 strout ("#<process ", -1, -1, printcharfun
, 0);
1890 print_string (XPROCESS (obj
)->name
, printcharfun
);
1894 print_string (XPROCESS (obj
)->name
, printcharfun
);
1896 else if (BOOL_VECTOR_P (obj
))
1899 register unsigned char c
;
1900 struct gcpro gcpro1
;
1902 = ((XBOOL_VECTOR (obj
)->size
+ BOOL_VECTOR_BITS_PER_CHAR
- 1)
1903 / BOOL_VECTOR_BITS_PER_CHAR
);
1909 sprintf (buf
, "%ld", (long) XBOOL_VECTOR (obj
)->size
);
1910 strout (buf
, -1, -1, printcharfun
, 0);
1913 /* Don't print more characters than the specified maximum.
1914 Negative values of print-length are invalid. Treat them
1915 like a print-length of nil. */
1916 if (NATNUMP (Vprint_length
)
1917 && XFASTINT (Vprint_length
) < size_in_chars
)
1918 size_in_chars
= XFASTINT (Vprint_length
);
1920 for (i
= 0; i
< size_in_chars
; i
++)
1923 c
= XBOOL_VECTOR (obj
)->data
[i
];
1924 if (c
== '\n' && print_escape_newlines
)
1929 else if (c
== '\f' && print_escape_newlines
)
1934 else if (c
> '\177')
1936 /* Use octal escapes to avoid encoding issues. */
1938 PRINTCHAR ('0' + ((c
>> 6) & 3));
1939 PRINTCHAR ('0' + ((c
>> 3) & 7));
1940 PRINTCHAR ('0' + (c
& 7));
1944 if (c
== '\"' || c
== '\\')
1953 else if (SUBRP (obj
))
1955 strout ("#<subr ", -1, -1, printcharfun
, 0);
1956 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1959 else if (WINDOWP (obj
))
1961 strout ("#<window ", -1, -1, printcharfun
, 0);
1962 sprintf (buf
, "%ld", (long) XFASTINT (XWINDOW (obj
)->sequence_number
));
1963 strout (buf
, -1, -1, printcharfun
, 0);
1964 if (!NILP (XWINDOW (obj
)->buffer
))
1966 strout (" on ", -1, -1, printcharfun
, 0);
1967 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1971 else if (TERMINALP (obj
))
1973 struct terminal
*t
= XTERMINAL (obj
);
1974 strout ("#<terminal ", -1, -1, printcharfun
, 0);
1975 sprintf (buf
, "%d", t
->id
);
1976 strout (buf
, -1, -1, printcharfun
, 0);
1979 strout (" on ", -1, -1, printcharfun
, 0);
1980 strout (t
->name
, -1, -1, printcharfun
, 0);
1984 else if (HASH_TABLE_P (obj
))
1986 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1987 int i
, real_size
, size
;
1989 strout ("#<hash-table", -1, -1, printcharfun
, 0);
1990 if (SYMBOLP (h
->test
))
1994 strout (SDATA (SYMBOL_NAME (h
->test
)), -1, -1, printcharfun
, 0);
1996 strout (SDATA (SYMBOL_NAME (h
->weak
)), -1, -1, printcharfun
, 0);
1998 sprintf (buf
, "%ld/%ld", (long) h
->count
,
1999 (long) XVECTOR (h
->next
)->size
);
2000 strout (buf
, -1, -1, printcharfun
, 0);
2002 sprintf (buf
, " 0x%lx", (unsigned long) h
);
2003 strout (buf
, -1, -1, printcharfun
, 0);
2006 /* Implement a readable output, e.g.:
2007 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2008 /* Always print the size. */
2009 sprintf (buf
, "#s(hash-table size %ld",
2010 (long) XVECTOR (h
->next
)->size
);
2011 strout (buf
, -1, -1, printcharfun
, 0);
2013 if (!NILP (h
->test
))
2015 strout (" test ", -1, -1, printcharfun
, 0);
2016 print_object (h
->test
, printcharfun
, 0);
2019 if (!NILP (h
->weak
))
2021 strout (" weakness ", -1, -1, printcharfun
, 0);
2022 print_object (h
->weak
, printcharfun
, 0);
2025 if (!NILP (h
->rehash_size
))
2027 strout (" rehash-size ", -1, -1, printcharfun
, 0);
2028 print_object (h
->rehash_size
, printcharfun
, 0);
2031 if (!NILP (h
->rehash_threshold
))
2033 strout (" rehash-threshold ", -1, -1, printcharfun
, 0);
2034 print_object (h
->rehash_threshold
, printcharfun
, 0);
2037 strout (" data ", -1, -1, printcharfun
, 0);
2039 /* Print the data here as a plist. */
2040 real_size
= HASH_TABLE_SIZE (h
);
2043 /* Don't print more elements than the specified maximum. */
2044 if (NATNUMP (Vprint_length
)
2045 && XFASTINT (Vprint_length
) < size
)
2046 size
= XFASTINT (Vprint_length
);
2049 for (i
= 0; i
< size
; i
++)
2050 if (!NILP (HASH_HASH (h
, i
)))
2052 if (i
) PRINTCHAR (' ');
2053 print_object (HASH_KEY (h
, i
), printcharfun
, 1);
2055 print_object (HASH_VALUE (h
, i
), printcharfun
, 1);
2058 if (size
< real_size
)
2059 strout (" ...", 4, 4, printcharfun
, 0);
2065 else if (BUFFERP (obj
))
2067 if (NILP (XBUFFER (obj
)->name
))
2068 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
2069 else if (escapeflag
)
2071 strout ("#<buffer ", -1, -1, printcharfun
, 0);
2072 print_string (XBUFFER (obj
)->name
, printcharfun
);
2076 print_string (XBUFFER (obj
)->name
, printcharfun
);
2078 else if (WINDOW_CONFIGURATIONP (obj
))
2080 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
2082 else if (FRAMEP (obj
))
2084 strout ((FRAME_LIVE_P (XFRAME (obj
))
2085 ? "#<frame " : "#<dead frame "),
2086 -1, -1, printcharfun
, 0);
2087 print_string (XFRAME (obj
)->name
, printcharfun
);
2088 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
2089 strout (buf
, -1, -1, printcharfun
, 0);
2092 else if (FONTP (obj
))
2096 if (! FONT_OBJECT_P (obj
))
2098 if (FONT_SPEC_P (obj
))
2099 strout ("#<font-spec", -1, -1, printcharfun
, 0);
2101 strout ("#<font-entity", -1, -1, printcharfun
, 0);
2102 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2105 if (i
< FONT_WEIGHT_INDEX
|| i
> FONT_WIDTH_INDEX
)
2106 print_object (AREF (obj
, i
), printcharfun
, escapeflag
);
2108 print_object (font_style_symbolic (obj
, i
, 0),
2109 printcharfun
, escapeflag
);
2114 strout ("#<font-object ", -1, -1, printcharfun
, 0);
2115 print_object (AREF (obj
, FONT_NAME_INDEX
), printcharfun
,
2122 EMACS_INT size
= XVECTOR (obj
)->size
;
2123 if (COMPILEDP (obj
))
2126 size
&= PSEUDOVECTOR_SIZE_MASK
;
2128 if (CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
))
2130 /* We print a char-table as if it were a vector,
2131 lumping the parent and default slots in with the
2132 character slots. But we add #^ as a prefix. */
2134 /* Make each lowest sub_char_table start a new line.
2135 Otherwise we'll make a line extremely long, which
2136 results in slow redisplay. */
2137 if (SUB_CHAR_TABLE_P (obj
)
2138 && XINT (XSUB_CHAR_TABLE (obj
)->depth
) == 3)
2142 if (SUB_CHAR_TABLE_P (obj
))
2144 size
&= PSEUDOVECTOR_SIZE_MASK
;
2146 if (size
& PSEUDOVECTOR_FLAG
)
2152 register Lisp_Object tem
;
2153 int real_size
= size
;
2155 /* Don't print more elements than the specified maximum. */
2156 if (NATNUMP (Vprint_length
)
2157 && XFASTINT (Vprint_length
) < size
)
2158 size
= XFASTINT (Vprint_length
);
2160 for (i
= 0; i
< size
; i
++)
2162 if (i
) PRINTCHAR (' ');
2163 tem
= XVECTOR (obj
)->contents
[i
];
2164 print_object (tem
, printcharfun
, escapeflag
);
2166 if (size
< real_size
)
2167 strout (" ...", 4, 4, printcharfun
, 0);
2174 switch (XMISCTYPE (obj
))
2176 case Lisp_Misc_Marker
:
2177 strout ("#<marker ", -1, -1, printcharfun
, 0);
2178 /* Do you think this is necessary? */
2179 if (XMARKER (obj
)->insertion_type
!= 0)
2180 strout ("(moves after insertion) ", -1, -1, printcharfun
, 0);
2181 if (! XMARKER (obj
)->buffer
)
2182 strout ("in no buffer", -1, -1, printcharfun
, 0);
2185 sprintf (buf
, "at %d", marker_position (obj
));
2186 strout (buf
, -1, -1, printcharfun
, 0);
2187 strout (" in ", -1, -1, printcharfun
, 0);
2188 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
2193 case Lisp_Misc_Overlay
:
2194 strout ("#<overlay ", -1, -1, printcharfun
, 0);
2195 if (! XMARKER (OVERLAY_START (obj
))->buffer
)
2196 strout ("in no buffer", -1, -1, printcharfun
, 0);
2199 sprintf (buf
, "from %d to %d in ",
2200 marker_position (OVERLAY_START (obj
)),
2201 marker_position (OVERLAY_END (obj
)));
2202 strout (buf
, -1, -1, printcharfun
, 0);
2203 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
2209 /* Remaining cases shouldn't happen in normal usage, but let's print
2210 them anyway for the benefit of the debugger. */
2211 case Lisp_Misc_Free
:
2212 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
2215 case Lisp_Misc_Save_Value
:
2216 strout ("#<save_value ", -1, -1, printcharfun
, 0);
2217 sprintf(buf
, "ptr=0x%08lx int=%d",
2218 (unsigned long) XSAVE_VALUE (obj
)->pointer
,
2219 XSAVE_VALUE (obj
)->integer
);
2220 strout (buf
, -1, -1, printcharfun
, 0);
2232 /* We're in trouble if this happens!
2233 Probably should just abort () */
2234 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
2236 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
2237 else if (VECTORLIKEP (obj
))
2238 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
2240 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
2241 strout (buf
, -1, -1, printcharfun
, 0);
2242 strout (" Save your buffers immediately and please report this bug>",
2243 -1, -1, printcharfun
, 0);
2251 /* Print a description of INTERVAL using PRINTCHARFUN.
2252 This is part of printing a string that has text properties. */
2255 print_interval (INTERVAL interval
, Lisp_Object printcharfun
)
2257 if (NILP (interval
->plist
))
2260 print_object (make_number (interval
->position
), printcharfun
, 1);
2262 print_object (make_number (interval
->position
+ LENGTH (interval
)),
2265 print_object (interval
->plist
, printcharfun
, 1);
2270 syms_of_print (void)
2272 Qtemp_buffer_setup_hook
= intern_c_string ("temp-buffer-setup-hook");
2273 staticpro (&Qtemp_buffer_setup_hook
);
2275 DEFVAR_LISP ("standard-output", &Vstandard_output
,
2276 doc
: /* Output stream `print' uses by default for outputting a character.
2277 This may be any function of one argument.
2278 It may also be a buffer (output is inserted before point)
2279 or a marker (output is inserted and the marker is advanced)
2280 or the symbol t (output appears in the echo area). */);
2281 Vstandard_output
= Qt
;
2282 Qstandard_output
= intern_c_string ("standard-output");
2283 staticpro (&Qstandard_output
);
2285 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
2286 doc
: /* The format descriptor string used to print floats.
2287 This is a %-spec like those accepted by `printf' in C,
2288 but with some restrictions. It must start with the two characters `%.'.
2289 After that comes an integer precision specification,
2290 and then a letter which controls the format.
2291 The letters allowed are `e', `f' and `g'.
2292 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2293 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2294 Use `g' to choose the shorter of those two formats for the number at hand.
2295 The precision in any of these cases is the number of digits following
2296 the decimal point. With `f', a precision of 0 means to omit the
2297 decimal point. 0 is not allowed with `e' or `g'.
2299 A value of nil means to use the shortest notation
2300 that represents the number without losing information. */);
2301 Vfloat_output_format
= Qnil
;
2302 Qfloat_output_format
= intern_c_string ("float-output-format");
2303 staticpro (&Qfloat_output_format
);
2305 DEFVAR_LISP ("print-length", &Vprint_length
,
2306 doc
: /* Maximum length of list to print before abbreviating.
2307 A value of nil means no limit. See also `eval-expression-print-length'. */);
2308 Vprint_length
= Qnil
;
2310 DEFVAR_LISP ("print-level", &Vprint_level
,
2311 doc
: /* Maximum depth of list nesting to print before abbreviating.
2312 A value of nil means no limit. See also `eval-expression-print-level'. */);
2313 Vprint_level
= Qnil
;
2315 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
2316 doc
: /* Non-nil means print newlines in strings as `\\n'.
2317 Also print formfeeds as `\\f'. */);
2318 print_escape_newlines
= 0;
2320 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
2321 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2322 \(OOO is the octal representation of the character code.)
2323 Only single-byte characters are affected, and only in `prin1'.
2324 When the output goes in a multibyte buffer, this feature is
2325 enabled regardless of the value of the variable. */);
2326 print_escape_nonascii
= 0;
2328 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
2329 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2330 \(XXXX is the hex representation of the character code.)
2331 This affects only `prin1'. */);
2332 print_escape_multibyte
= 0;
2334 DEFVAR_BOOL ("print-quoted", &print_quoted
,
2335 doc
: /* Non-nil means print quoted forms with reader syntax.
2336 I.e., (quote foo) prints as 'foo, (function foo) as #'foo. */);
2339 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
2340 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2341 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2342 When the uninterned symbol appears within a recursive data structure,
2343 and the symbol appears more than once, in addition use the #N# and #N=
2344 constructs as needed, so that multiple references to the same symbol are
2345 shared once again when the text is read back. */);
2346 Vprint_gensym
= Qnil
;
2348 DEFVAR_LISP ("print-circle", &Vprint_circle
,
2349 doc
: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2350 If nil, printing proceeds recursively and may lead to
2351 `max-lisp-eval-depth' being exceeded or an error may occur:
2352 \"Apparently circular structure being printed.\" Also see
2353 `print-length' and `print-level'.
2354 If non-nil, shared substructures anywhere in the structure are printed
2355 with `#N=' before the first occurrence (in the order of the print
2356 representation) and `#N#' in place of each subsequent occurrence,
2357 where N is a positive decimal integer. */);
2358 Vprint_circle
= Qnil
;
2360 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
2361 doc
: /* *Non-nil means number continuously across print calls.
2362 This affects the numbers printed for #N= labels and #M# references.
2363 See also `print-circle', `print-gensym', and `print-number-table'.
2364 This variable should not be set with `setq'; bind it with a `let' instead. */);
2365 Vprint_continuous_numbering
= Qnil
;
2367 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
2368 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2369 The Lisp printer uses this vector to detect Lisp objects referenced more
2372 When you bind `print-continuous-numbering' to t, you should probably
2373 also bind `print-number-table' to nil. This ensures that the value of
2374 `print-number-table' can be garbage-collected once the printing is
2375 done. If all elements of `print-number-table' are nil, it means that
2376 the printing done so far has not found any shared structure or objects
2377 that need to be recorded in the table. */);
2378 Vprint_number_table
= Qnil
;
2380 DEFVAR_LISP ("print-charset-text-property", &Vprint_charset_text_property
,
2381 doc
: /* A flag to control printing of `charset' text property on printing a string.
2382 The value must be nil, t, or `default'.
2384 If the value is nil, don't print the text property `charset'.
2386 If the value is t, always print the text property `charset'.
2388 If the value is `default', print the text property `charset' only when
2389 the value is different from what is guessed in the current charset
2391 Vprint_charset_text_property
= Qdefault
;
2393 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2394 staticpro (&Vprin1_to_string_buffer
);
2397 defsubr (&Sprin1_to_string
);
2398 defsubr (&Serror_message_string
);
2402 defsubr (&Swrite_char
);
2403 defsubr (&Sexternal_debugging_output
);
2404 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2405 defsubr (&Sredirect_debugging_output
);
2408 Qexternal_debugging_output
= intern_c_string ("external-debugging-output");
2409 staticpro (&Qexternal_debugging_output
);
2411 Qprint_escape_newlines
= intern_c_string ("print-escape-newlines");
2412 staticpro (&Qprint_escape_newlines
);
2414 Qprint_escape_multibyte
= intern_c_string ("print-escape-multibyte");
2415 staticpro (&Qprint_escape_multibyte
);
2417 Qprint_escape_nonascii
= intern_c_string ("print-escape-nonascii");
2418 staticpro (&Qprint_escape_nonascii
);
2420 print_prune_charset_plist
= Qnil
;
2421 staticpro (&print_prune_charset_plist
);
2423 defsubr (&Swith_output_to_temp_buffer
);
2426 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2427 (do not change this comment) */