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 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
28 #include "character.h"
34 #include "dispextern.h"
36 #include "intervals.h"
38 Lisp_Object Vstandard_output
, Qstandard_output
;
40 Lisp_Object Qtemp_buffer_setup_hook
;
42 /* These are used to print like we read. */
43 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
45 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
47 /* Work around a problem that happens because math.h on hpux 7
48 defines two static variables--which, in Emacs, are not really static,
49 because `static' is defined as nothing. The problem is that they are
50 defined both here and in lread.c.
51 These macros prevent the name conflict. */
52 #if defined (HPUX) && !defined (HPUX8)
53 #define _MAXLDBL print_maxldbl
54 #define _NMAXLDBL print_nmaxldbl
63 /* Default to values appropriate for IEEE floating point. */
68 #define DBL_MANT_DIG 53
74 #define DBL_MIN 2.2250738585072014e-308
77 #ifdef DBL_MIN_REPLACEMENT
79 #define DBL_MIN DBL_MIN_REPLACEMENT
82 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
83 needed to express a float without losing information.
84 The general-case formula is valid for the usual case, IEEE floating point,
85 but many compilers can't optimize the formula to an integer constant,
86 so make a special case for it. */
87 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
88 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
90 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
93 /* Avoid actual stack overflow in print. */
96 /* Nonzero if inside outputting backquote in old style. */
97 int old_backquote_output
;
99 /* Detect most circularities to print finite output. */
100 #define PRINT_CIRCLE 200
101 Lisp_Object being_printed
[PRINT_CIRCLE
];
103 /* When printing into a buffer, first we put the text in this
104 block, then insert it all at once. */
107 /* Size allocated in print_buffer. */
108 int print_buffer_size
;
109 /* Chars stored in print_buffer. */
110 int print_buffer_pos
;
111 /* Bytes stored in print_buffer. */
112 int print_buffer_pos_byte
;
114 /* Maximum length of list to print in full; noninteger means
115 effectively infinity */
117 Lisp_Object Vprint_length
;
119 /* Maximum depth of list to print in full; noninteger means
120 effectively infinity. */
122 Lisp_Object Vprint_level
;
124 /* Nonzero means print newlines in strings as \n. */
126 int print_escape_newlines
;
128 /* Nonzero means to print single-byte non-ascii characters in strings as
131 int print_escape_nonascii
;
133 /* Nonzero means to print multibyte characters in strings as hex escapes. */
135 int print_escape_multibyte
;
137 Lisp_Object Qprint_escape_newlines
;
138 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
140 /* Nonzero means print (quote foo) forms as 'foo, etc. */
144 /* Non-nil means print #: before uninterned symbols. */
146 Lisp_Object Vprint_gensym
;
148 /* Non-nil means print recursive structures using #n= and #n# syntax. */
150 Lisp_Object Vprint_circle
;
152 /* Non-nil means keep continuous number for #n= and #n# syntax
153 between several print functions. */
155 Lisp_Object Vprint_continuous_numbering
;
157 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
158 where OBJn are objects going to be printed, and STATn are their status,
159 which may be different meanings during process. See the comments of
160 the functions print and print_preprocess for details.
161 print_number_index keeps the last position the next object should be added,
162 twice of which is the actual vector position in Vprint_number_table. */
163 int print_number_index
;
164 Lisp_Object Vprint_number_table
;
166 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
167 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
168 See the comment of the variable Vprint_number_table. */
169 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
170 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
172 /* Nonzero means print newline to stdout before next minibuffer message.
173 Defined in xdisp.c */
175 extern int noninteractive_need_newline
;
177 extern int minibuffer_auto_raise
;
179 #ifdef MAX_PRINT_CHARS
180 static int print_chars
;
181 static int max_print
;
182 #endif /* MAX_PRINT_CHARS */
184 void print_interval ();
186 /* GDB resets this to zero on W32 to disable OutputDebugString calls. */
187 int print_output_debug_flag
= 1;
190 /* Low level output routines for characters and strings */
192 /* Lisp functions to do output using a stream
193 must have the stream in a variable called printcharfun
194 and must start with PRINTPREPARE, end with PRINTFINISH,
195 and use PRINTDECLARE to declare common variables.
196 Use PRINTCHAR to output one character,
197 or call strout to output a block of characters. */
199 #define PRINTDECLARE \
200 struct buffer *old = current_buffer; \
201 int old_point = -1, start_point = -1; \
202 int old_point_byte = -1, start_point_byte = -1; \
203 int specpdl_count = SPECPDL_INDEX (); \
204 int free_print_buffer = 0; \
205 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
208 #define PRINTPREPARE \
209 original = printcharfun; \
210 if (NILP (printcharfun)) printcharfun = Qt; \
211 if (BUFFERP (printcharfun)) \
213 if (XBUFFER (printcharfun) != current_buffer) \
214 Fset_buffer (printcharfun); \
215 printcharfun = Qnil; \
217 if (MARKERP (printcharfun)) \
219 EMACS_INT marker_pos; \
220 if (! XMARKER (printcharfun)->buffer) \
221 error ("Marker does not point anywhere"); \
222 if (XMARKER (printcharfun)->buffer != current_buffer) \
223 set_buffer_internal (XMARKER (printcharfun)->buffer); \
224 marker_pos = marker_position (printcharfun); \
225 if (marker_pos < BEGV || marker_pos > ZV) \
226 error ("Marker is outside the accessible part of the buffer"); \
228 old_point_byte = PT_BYTE; \
229 SET_PT_BOTH (marker_pos, \
230 marker_byte_position (printcharfun)); \
232 start_point_byte = PT_BYTE; \
233 printcharfun = Qnil; \
235 if (NILP (printcharfun)) \
237 Lisp_Object string; \
238 if (NILP (current_buffer->enable_multibyte_characters) \
239 && ! print_escape_multibyte) \
240 specbind (Qprint_escape_multibyte, Qt); \
241 if (! NILP (current_buffer->enable_multibyte_characters) \
242 && ! print_escape_nonascii) \
243 specbind (Qprint_escape_nonascii, Qt); \
244 if (print_buffer != 0) \
246 string = make_string_from_bytes (print_buffer, \
248 print_buffer_pos_byte); \
249 record_unwind_protect (print_unwind, string); \
253 print_buffer_size = 1000; \
254 print_buffer = (char *) xmalloc (print_buffer_size); \
255 free_print_buffer = 1; \
257 print_buffer_pos = 0; \
258 print_buffer_pos_byte = 0; \
260 if (EQ (printcharfun, Qt) && ! noninteractive) \
261 setup_echo_area_for_printing (multibyte);
263 #define PRINTFINISH \
264 if (NILP (printcharfun)) \
266 if (print_buffer_pos != print_buffer_pos_byte \
267 && NILP (current_buffer->enable_multibyte_characters)) \
269 unsigned char *temp \
270 = (unsigned char *) alloca (print_buffer_pos + 1); \
271 copy_text (print_buffer, temp, print_buffer_pos_byte, \
273 insert_1_both (temp, print_buffer_pos, \
274 print_buffer_pos, 0, 1, 0); \
277 insert_1_both (print_buffer, print_buffer_pos, \
278 print_buffer_pos_byte, 0, 1, 0); \
279 signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
281 if (free_print_buffer) \
283 xfree (print_buffer); \
286 unbind_to (specpdl_count, Qnil); \
287 if (MARKERP (original)) \
288 set_marker_both (original, Qnil, PT, PT_BYTE); \
289 if (old_point >= 0) \
290 SET_PT_BOTH (old_point + (old_point >= start_point \
291 ? PT - start_point : 0), \
292 old_point_byte + (old_point_byte >= start_point_byte \
293 ? PT_BYTE - start_point_byte : 0)); \
294 if (old != current_buffer) \
295 set_buffer_internal (old);
297 #define PRINTCHAR(ch) printchar (ch, printcharfun)
299 /* This is used to restore the saved contents of print_buffer
300 when there is a recursive call to print. */
303 print_unwind (saved_text
)
304 Lisp_Object saved_text
;
306 bcopy (SDATA (saved_text
), print_buffer
, SCHARS (saved_text
));
311 /* Print character CH using method FUN. FUN nil means print to
312 print_buffer. FUN t means print to echo area or stdout if
313 non-interactive. If FUN is neither nil nor t, call FUN with CH as
321 #ifdef MAX_PRINT_CHARS
324 #endif /* MAX_PRINT_CHARS */
326 if (!NILP (fun
) && !EQ (fun
, Qt
))
327 call1 (fun
, make_number (ch
));
330 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
331 int len
= CHAR_STRING (ch
, str
);
337 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
338 print_buffer
= (char *) xrealloc (print_buffer
,
339 print_buffer_size
*= 2);
340 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
341 print_buffer_pos
+= 1;
342 print_buffer_pos_byte
+= len
;
344 else if (noninteractive
)
346 fwrite (str
, 1, len
, stdout
);
347 noninteractive_need_newline
= 1;
352 = !NILP (current_buffer
->enable_multibyte_characters
);
354 setup_echo_area_for_printing (multibyte_p
);
356 message_dolog (str
, len
, 0, multibyte_p
);
362 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
363 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
364 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
365 print_buffer. PRINTCHARFUN t means output to the echo area or to
366 stdout if non-interactive. If neither nil nor t, call Lisp
367 function PRINTCHARFUN for each character printed. MULTIBYTE
368 non-zero means PTR contains multibyte characters.
370 In the case where PRINTCHARFUN is nil, it is safe for PTR to point
371 to data in a Lisp string. Otherwise that is not safe. */
374 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
377 Lisp_Object printcharfun
;
381 size_byte
= size
= strlen (ptr
);
383 if (NILP (printcharfun
))
385 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
387 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
388 print_buffer
= (char *) xrealloc (print_buffer
,
391 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
392 print_buffer_pos
+= size
;
393 print_buffer_pos_byte
+= size_byte
;
395 #ifdef MAX_PRINT_CHARS
398 #endif /* MAX_PRINT_CHARS */
400 else if (noninteractive
&& EQ (printcharfun
, Qt
))
402 fwrite (ptr
, 1, size_byte
, stdout
);
403 noninteractive_need_newline
= 1;
405 else if (EQ (printcharfun
, Qt
))
407 /* Output to echo area. We're trying to avoid a little overhead
408 here, that's the reason we don't call printchar to do the
412 = !NILP (current_buffer
->enable_multibyte_characters
);
414 setup_echo_area_for_printing (multibyte_p
);
415 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
417 if (size
== size_byte
)
419 for (i
= 0; i
< size
; ++i
)
420 insert_char ((unsigned char) *ptr
++);
425 for (i
= 0; i
< size_byte
; i
+= len
)
427 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
432 #ifdef MAX_PRINT_CHARS
435 #endif /* MAX_PRINT_CHARS */
439 /* PRINTCHARFUN is a Lisp function. */
442 if (size
== size_byte
)
444 while (i
< size_byte
)
452 while (i
< size_byte
)
454 /* Here, we must convert each multi-byte form to the
455 corresponding character code before handing it to
458 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
466 /* Print the contents of a string STRING using PRINTCHARFUN.
467 It isn't safe to use strout in many cases,
468 because printing one char can relocate. */
471 print_string (string
, printcharfun
)
473 Lisp_Object printcharfun
;
475 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
479 if (print_escape_nonascii
)
480 string
= string_escape_byte8 (string
);
482 if (STRING_MULTIBYTE (string
))
483 chars
= SCHARS (string
);
484 else if (! print_escape_nonascii
485 && (EQ (printcharfun
, Qt
)
486 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
487 : ! NILP (current_buffer
->enable_multibyte_characters
)))
489 /* If unibyte string STRING contains 8-bit codes, we must
490 convert STRING to a multibyte string containing the same
495 chars
= SBYTES (string
);
496 bytes
= parse_str_to_multibyte (SDATA (string
), chars
);
499 newstr
= make_uninit_multibyte_string (chars
, bytes
);
500 bcopy (SDATA (string
), SDATA (newstr
), chars
);
501 str_to_multibyte (SDATA (newstr
), bytes
, chars
);
506 chars
= SBYTES (string
);
508 if (EQ (printcharfun
, Qt
))
510 /* Output to echo area. */
511 int nbytes
= SBYTES (string
);
514 /* Copy the string contents so that relocation of STRING by
515 GC does not cause trouble. */
518 SAFE_ALLOCA (buffer
, char *, nbytes
);
519 bcopy (SDATA (string
), buffer
, nbytes
);
521 strout (buffer
, chars
, SBYTES (string
),
522 printcharfun
, STRING_MULTIBYTE (string
));
527 /* No need to copy, since output to print_buffer can't GC. */
528 strout (SDATA (string
),
529 chars
, SBYTES (string
),
530 printcharfun
, STRING_MULTIBYTE (string
));
534 /* Otherwise, string may be relocated by printing one char.
535 So re-fetch the string address for each character. */
537 int size
= SCHARS (string
);
538 int size_byte
= SBYTES (string
);
541 if (size
== size_byte
)
542 for (i
= 0; i
< size
; i
++)
543 PRINTCHAR (SREF (string
, i
));
545 for (i
= 0; i
< size_byte
; )
547 /* Here, we must convert each multi-byte form to the
548 corresponding character code before handing it to PRINTCHAR. */
550 int ch
= STRING_CHAR_AND_LENGTH (SDATA (string
) + i
,
559 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
560 doc
: /* Output character CHARACTER to stream PRINTCHARFUN.
561 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
562 (character
, printcharfun
)
563 Lisp_Object character
, printcharfun
;
567 if (NILP (printcharfun
))
568 printcharfun
= Vstandard_output
;
569 CHECK_NUMBER (character
);
571 PRINTCHAR (XINT (character
));
576 /* Used from outside of print.c to print a block of SIZE
577 single-byte chars at DATA on the default output stream.
578 Do not use this on the contents of a Lisp string. */
581 write_string (data
, size
)
586 Lisp_Object printcharfun
;
588 printcharfun
= Vstandard_output
;
591 strout (data
, size
, size
, printcharfun
, 0);
595 /* Used from outside of print.c to print a block of SIZE
596 single-byte chars at DATA on a specified stream PRINTCHARFUN.
597 Do not use this on the contents of a Lisp string. */
600 write_string_1 (data
, size
, printcharfun
)
603 Lisp_Object printcharfun
;
608 strout (data
, size
, size
, printcharfun
, 0);
614 temp_output_buffer_setup (bufname
)
617 int count
= SPECPDL_INDEX ();
618 register struct buffer
*old
= current_buffer
;
619 register Lisp_Object buf
;
621 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
623 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
625 Fkill_all_local_variables ();
626 delete_all_overlays (current_buffer
);
627 current_buffer
->directory
= old
->directory
;
628 current_buffer
->read_only
= Qnil
;
629 current_buffer
->filename
= Qnil
;
630 current_buffer
->undo_list
= Qt
;
631 eassert (current_buffer
->overlays_before
== NULL
);
632 eassert (current_buffer
->overlays_after
== NULL
);
633 current_buffer
->enable_multibyte_characters
634 = buffer_defaults
.enable_multibyte_characters
;
635 specbind (Qinhibit_read_only
, Qt
);
636 specbind (Qinhibit_modification_hooks
, Qt
);
638 XSETBUFFER (buf
, current_buffer
);
640 Frun_hooks (1, &Qtemp_buffer_setup_hook
);
642 unbind_to (count
, Qnil
);
644 specbind (Qstandard_output
, buf
);
648 internal_with_output_to_temp_buffer (bufname
, function
, args
)
650 Lisp_Object (*function
) P_ ((Lisp_Object
));
653 int count
= SPECPDL_INDEX ();
654 Lisp_Object buf
, val
;
658 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
659 temp_output_buffer_setup (bufname
);
660 buf
= Vstandard_output
;
663 val
= (*function
) (args
);
666 temp_output_buffer_show (buf
);
669 return unbind_to (count
, val
);
672 DEFUN ("with-output-to-temp-buffer",
673 Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
675 doc
: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
676 The buffer is cleared out initially, and marked as unmodified when done.
677 All output done by BODY is inserted in that buffer by default.
678 The buffer is displayed in another window, but not selected.
679 The value of the last form in BODY is returned.
680 If BODY does not finish normally, the buffer BUFNAME is not displayed.
682 The hook `temp-buffer-setup-hook' is run before BODY,
683 with the buffer BUFNAME temporarily current.
684 The hook `temp-buffer-show-hook' is run after the buffer is displayed,
685 with the buffer temporarily current, and the window that was used
686 to display it temporarily selected.
688 If variable `temp-buffer-show-function' is non-nil, call it at the end
689 to get the buffer displayed instead of just displaying the non-selected
690 buffer and calling the hook. It gets one argument, the buffer to display.
692 usage: (with-output-to-temp-buffer BUFNAME BODY ...) */)
698 int count
= SPECPDL_INDEX ();
699 Lisp_Object buf
, val
;
702 name
= Feval (Fcar (args
));
704 temp_output_buffer_setup (SDATA (name
));
705 buf
= Vstandard_output
;
708 val
= Fprogn (XCDR (args
));
711 temp_output_buffer_show (buf
);
714 return unbind_to (count
, val
);
718 static void print ();
719 static void print_preprocess ();
720 static void print_preprocess_string ();
721 static void print_object ();
723 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
724 doc
: /* Output a newline to stream PRINTCHARFUN.
725 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
727 Lisp_Object printcharfun
;
731 if (NILP (printcharfun
))
732 printcharfun
= Vstandard_output
;
739 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
740 doc
: /* Output the printed representation of OBJECT, any Lisp object.
741 Quoting characters are printed when needed to make output that `read'
742 can handle, whenever this is possible. For complex objects, the behavior
743 is controlled by `print-level' and `print-length', which see.
745 OBJECT is any of the Lisp data types: a number, a string, a symbol,
746 a list, a buffer, a window, a frame, etc.
748 A printed representation of an object is text which describes that object.
750 Optional argument PRINTCHARFUN is the output stream, which can be one
753 - a buffer, in which case output is inserted into that buffer at point;
754 - a marker, in which case output is inserted at marker's position;
755 - a function, in which case that function is called once for each
756 character of OBJECT's printed representation;
757 - a symbol, in which case that symbol's function definition is called; or
758 - t, in which case the output is displayed in the echo area.
760 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
762 (object
, printcharfun
)
763 Lisp_Object object
, printcharfun
;
767 #ifdef MAX_PRINT_CHARS
769 #endif /* MAX_PRINT_CHARS */
770 if (NILP (printcharfun
))
771 printcharfun
= Vstandard_output
;
773 print (object
, printcharfun
, 1);
778 /* a buffer which is used to hold output being built by prin1-to-string */
779 Lisp_Object Vprin1_to_string_buffer
;
781 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
782 doc
: /* Return a string containing the printed representation of OBJECT.
783 OBJECT can be any Lisp object. This function outputs quoting characters
784 when necessary to make output that `read' can handle, whenever possible,
785 unless the optional second argument NOESCAPE is non-nil. For complex objects,
786 the behavior is controlled by `print-level' and `print-length', which see.
788 OBJECT is any of the Lisp data types: a number, a string, a symbol,
789 a list, a buffer, a window, a frame, etc.
791 A printed representation of an object is text which describes that object. */)
793 Lisp_Object object
, noescape
;
795 Lisp_Object printcharfun
;
796 /* struct gcpro gcpro1, gcpro2; */
797 Lisp_Object save_deactivate_mark
;
798 int count
= specpdl_ptr
- specpdl
;
799 struct buffer
*previous
;
801 specbind (Qinhibit_modification_hooks
, Qt
);
806 /* Save and restore this--we are altering a buffer
807 but we don't want to deactivate the mark just for that.
808 No need for specbind, since errors deactivate the mark. */
809 save_deactivate_mark
= Vdeactivate_mark
;
810 /* GCPRO2 (object, save_deactivate_mark); */
813 printcharfun
= Vprin1_to_string_buffer
;
815 print (object
, printcharfun
, NILP (noescape
));
816 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
820 previous
= current_buffer
;
821 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
822 object
= Fbuffer_string ();
823 if (SBYTES (object
) == SCHARS (object
))
824 STRING_SET_UNIBYTE (object
);
826 /* Note that this won't make prepare_to_modify_buffer call
827 ask-user-about-supersession-threat because this buffer
828 does not visit a file. */
830 set_buffer_internal (previous
);
832 Vdeactivate_mark
= save_deactivate_mark
;
836 return unbind_to (count
, object
);
839 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
840 doc
: /* Output the printed representation of OBJECT, any Lisp object.
841 No quoting characters are used; no delimiters are printed around
842 the contents of strings.
844 OBJECT is any of the Lisp data types: a number, a string, a symbol,
845 a list, a buffer, a window, a frame, etc.
847 A printed representation of an object is text which describes that object.
849 Optional argument PRINTCHARFUN is the output stream, which can be one
852 - a buffer, in which case output is inserted into that buffer at point;
853 - a marker, in which case output is inserted at marker's position;
854 - a function, in which case that function is called once for each
855 character of OBJECT's printed representation;
856 - a symbol, in which case that symbol's function definition is called; or
857 - t, in which case the output is displayed in the echo area.
859 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
861 (object
, printcharfun
)
862 Lisp_Object object
, printcharfun
;
866 if (NILP (printcharfun
))
867 printcharfun
= Vstandard_output
;
869 print (object
, printcharfun
, 0);
874 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
875 doc
: /* Output the printed representation of OBJECT, with newlines around it.
876 Quoting characters are printed when needed to make output that `read'
877 can handle, whenever this is possible. For complex objects, the behavior
878 is controlled by `print-level' and `print-length', which see.
880 OBJECT is any of the Lisp data types: a number, a string, a symbol,
881 a list, a buffer, a window, a frame, etc.
883 A printed representation of an object is text which describes that object.
885 Optional argument PRINTCHARFUN is the output stream, which can be one
888 - a buffer, in which case output is inserted into that buffer at point;
889 - a marker, in which case output is inserted at marker's position;
890 - a function, in which case that function is called once for each
891 character of OBJECT's printed representation;
892 - a symbol, in which case that symbol's function definition is called; or
893 - t, in which case the output is displayed in the echo area.
895 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
897 (object
, printcharfun
)
898 Lisp_Object object
, printcharfun
;
903 #ifdef MAX_PRINT_CHARS
905 max_print
= MAX_PRINT_CHARS
;
906 #endif /* MAX_PRINT_CHARS */
907 if (NILP (printcharfun
))
908 printcharfun
= Vstandard_output
;
912 print (object
, printcharfun
, 1);
915 #ifdef MAX_PRINT_CHARS
918 #endif /* MAX_PRINT_CHARS */
923 /* The subroutine object for external-debugging-output is kept here
924 for the convenience of the debugger. */
925 Lisp_Object Qexternal_debugging_output
;
927 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
928 doc
: /* Write CHARACTER to stderr.
929 You can call print while debugging emacs, and pass it this function
930 to make it write to the debugging output. */)
932 Lisp_Object character
;
934 CHECK_NUMBER (character
);
935 putc (XINT (character
), stderr
);
938 /* Send the output to a debugger (nothing happens if there isn't one). */
939 if (print_output_debug_flag
)
941 char buf
[2] = {(char) XINT (character
), '\0'};
942 OutputDebugString (buf
);
949 /* This function is never called. Its purpose is to prevent
950 print_output_debug_flag from being optimized away. */
953 debug_output_compilation_hack (x
)
956 print_output_debug_flag
= x
;
959 #if defined (GNU_LINUX)
961 /* This functionality is not vitally important in general, so we rely on
962 non-portable ability to use stderr as lvalue. */
964 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
966 FILE *initial_stderr_stream
= NULL
;
968 DEFUN ("redirect-debugging-output", Fredirect_debugging_output
, Sredirect_debugging_output
,
970 "FDebug output file: \nP",
971 doc
: /* Redirect debugging output (stderr stream) to file FILE.
972 If FILE is nil, reset target to the initial stderr stream.
973 Optional arg APPEND non-nil (interactively, with prefix arg) means
974 append to existing target file. */)
976 Lisp_Object file
, append
;
978 if (initial_stderr_stream
!= NULL
)
980 stderr
= initial_stderr_stream
;
981 initial_stderr_stream
= NULL
;
985 file
= Fexpand_file_name (file
, Qnil
);
986 initial_stderr_stream
= stderr
;
987 stderr
= fopen (SDATA (file
), NILP (append
) ? "w" : "a");
990 stderr
= initial_stderr_stream
;
991 initial_stderr_stream
= NULL
;
992 report_file_error ("Cannot open debugging output stream",
998 #endif /* GNU_LINUX */
1001 /* This is the interface for debugging printing. */
1007 Fprin1 (arg
, Qexternal_debugging_output
);
1008 fprintf (stderr
, "\r\n");
1012 safe_debug_print (arg
)
1015 int valid
= valid_lisp_object_p (arg
);
1020 fprintf (stderr
, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
1021 !valid
? "INVALID" : "SOME",
1022 #ifdef NO_UNION_TYPE
1025 (unsigned long) arg
.i
1031 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
1033 doc
: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
1034 See Info anchor `(elisp)Definition of signal' for some details on how this
1035 error message is constructed. */)
1039 struct buffer
*old
= current_buffer
;
1041 struct gcpro gcpro1
;
1043 /* If OBJ is (error STRING), just return STRING.
1044 That is not only faster, it also avoids the need to allocate
1045 space here when the error is due to memory full. */
1046 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
1047 && CONSP (XCDR (obj
))
1048 && STRINGP (XCAR (XCDR (obj
)))
1049 && NILP (XCDR (XCDR (obj
))))
1050 return XCAR (XCDR (obj
));
1052 print_error_message (obj
, Vprin1_to_string_buffer
, 0, Qnil
);
1054 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
1055 value
= Fbuffer_string ();
1059 set_buffer_internal (old
);
1065 /* Print an error message for the error DATA onto Lisp output stream
1066 STREAM (suitable for the print functions).
1067 CONTEXT is a C string describing the context of the error.
1068 CALLER is the Lisp function inside which the error was signaled. */
1071 print_error_message (data
, stream
, context
, caller
)
1072 Lisp_Object data
, stream
;
1076 Lisp_Object errname
, errmsg
, file_error
, tail
;
1077 struct gcpro gcpro1
;
1081 write_string_1 (context
, -1, stream
);
1083 /* If we know from where the error was signaled, show it in
1085 if (!NILP (caller
) && SYMBOLP (caller
))
1087 Lisp_Object cname
= SYMBOL_NAME (caller
);
1088 char *name
= alloca (SBYTES (cname
));
1089 bcopy (SDATA (cname
), name
, SBYTES (cname
));
1090 message_dolog (name
, SBYTES (cname
), 0, 0);
1091 message_dolog (": ", 2, 0, 0);
1094 errname
= Fcar (data
);
1096 if (EQ (errname
, Qerror
))
1101 errmsg
= Fcar (data
);
1106 Lisp_Object error_conditions
;
1107 errmsg
= Fget (errname
, Qerror_message
);
1108 error_conditions
= Fget (errname
, Qerror_conditions
);
1109 file_error
= Fmemq (Qfile_error
, error_conditions
);
1112 /* Print an error message including the data items. */
1114 tail
= Fcdr_safe (data
);
1117 /* For file-error, make error message by concatenating
1118 all the data items. They are all strings. */
1119 if (!NILP (file_error
) && CONSP (tail
))
1120 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
1122 if (STRINGP (errmsg
))
1123 Fprinc (errmsg
, stream
);
1125 write_string_1 ("peculiar error", -1, stream
);
1127 for (i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
1131 write_string_1 (i
? ", " : ": ", 2, stream
);
1133 if (!NILP (file_error
) || EQ (errname
, Qend_of_file
))
1134 Fprinc (obj
, stream
);
1136 Fprin1 (obj
, stream
);
1145 * The buffer should be at least as large as the max string size of the
1146 * largest float, printed in the biggest notation. This is undoubtedly
1147 * 20d float_output_format, with the negative of the C-constant "HUGE"
1150 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1152 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1153 * case of -1e307 in 20d float_output_format. What is one to do (short of
1154 * re-writing _doprnt to be more sane)?
1159 float_to_string (buf
, data
)
1166 /* Check for plus infinity in a way that won't lose
1167 if there is no plus infinity. */
1168 if (data
== data
/ 2 && data
> 1.0)
1170 strcpy (buf
, "1.0e+INF");
1173 /* Likewise for minus infinity. */
1174 if (data
== data
/ 2 && data
< -1.0)
1176 strcpy (buf
, "-1.0e+INF");
1179 /* Check for NaN in a way that won't fail if there are no NaNs. */
1180 if (! (data
* 0.0 >= 0.0))
1182 /* Prepend "-" if the NaN's sign bit is negative.
1183 The sign bit of a double is the bit that is 1 in -0.0. */
1185 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
1187 u_minus_zero
.d
= - 0.0;
1188 for (i
= 0; i
< sizeof (double); i
++)
1189 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1195 strcpy (buf
, "0.0e+NaN");
1199 if (NILP (Vfloat_output_format
)
1200 || !STRINGP (Vfloat_output_format
))
1203 /* Generate the fewest number of digits that represent the
1204 floating point value without losing information.
1205 The following method is simple but a bit slow.
1206 For ideas about speeding things up, please see:
1208 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1209 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1211 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1212 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1214 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1216 sprintf (buf
, "%.*g", width
, data
);
1217 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1219 else /* oink oink */
1221 /* Check that the spec we have is fully valid.
1222 This means not only valid for printf,
1223 but meant for floats, and reasonable. */
1224 cp
= SDATA (Vfloat_output_format
);
1233 /* Check the width specification. */
1235 if ('0' <= *cp
&& *cp
<= '9')
1239 width
= (width
* 10) + (*cp
++ - '0');
1240 while (*cp
>= '0' && *cp
<= '9');
1242 /* A precision of zero is valid only for %f. */
1244 || (width
== 0 && *cp
!= 'f'))
1248 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1254 sprintf (buf
, SDATA (Vfloat_output_format
), data
);
1257 /* Make sure there is a decimal point with digit after, or an
1258 exponent, so that the value is readable as a float. But don't do
1259 this with "%.0f"; it's valid for that not to produce a decimal
1260 point. Note that width can be 0 only for %.0f. */
1263 for (cp
= buf
; *cp
; cp
++)
1264 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1267 if (*cp
== '.' && cp
[1] == 0)
1284 print (obj
, printcharfun
, escapeflag
)
1286 register Lisp_Object printcharfun
;
1289 old_backquote_output
= 0;
1291 /* Reset print_number_index and Vprint_number_table only when
1292 the variable Vprint_continuous_numbering is nil. Otherwise,
1293 the values of these variables will be kept between several
1295 if (NILP (Vprint_continuous_numbering
))
1297 print_number_index
= 0;
1298 Vprint_number_table
= Qnil
;
1301 /* Construct Vprint_number_table for print-gensym and print-circle. */
1302 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1304 int i
, start
, index
;
1305 start
= index
= print_number_index
;
1306 /* Construct Vprint_number_table.
1307 This increments print_number_index for the objects added. */
1309 print_preprocess (obj
);
1311 /* Remove unnecessary objects, which appear only once in OBJ;
1312 that is, whose status is Qnil. Compactify the necessary objects. */
1313 for (i
= start
; i
< print_number_index
; i
++)
1314 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1316 PRINT_NUMBER_OBJECT (Vprint_number_table
, index
)
1317 = PRINT_NUMBER_OBJECT (Vprint_number_table
, i
);
1321 /* Clear out objects outside the active part of the table. */
1322 for (i
= index
; i
< print_number_index
; i
++)
1323 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
) = Qnil
;
1325 /* Reset the status field for the next print step. Now this
1326 field means whether the object has already been printed. */
1327 for (i
= start
; i
< print_number_index
; i
++)
1328 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qnil
;
1330 print_number_index
= index
;
1334 print_object (obj
, printcharfun
, escapeflag
);
1337 /* Construct Vprint_number_table according to the structure of OBJ.
1338 OBJ itself and all its elements will be added to Vprint_number_table
1339 recursively if it is a list, vector, compiled function, char-table,
1340 string (its text properties will be traced), or a symbol that has
1341 no obarray (this is for the print-gensym feature).
1342 The status fields of Vprint_number_table mean whether each object appears
1343 more than once in OBJ: Qnil at the first time, and Qt after that . */
1345 print_preprocess (obj
)
1351 Lisp_Object halftail
;
1353 /* Give up if we go so deep that print_object will get an error. */
1354 /* See similar code in print_object. */
1355 if (print_depth
>= PRINT_CIRCLE
)
1356 error ("Apparently circular structure being printed");
1358 /* Avoid infinite recursion for circular nested structure
1359 in the case where Vprint_circle is nil. */
1360 if (NILP (Vprint_circle
))
1362 for (i
= 0; i
< print_depth
; i
++)
1363 if (EQ (obj
, being_printed
[i
]))
1365 being_printed
[print_depth
] = obj
;
1372 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1373 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1374 || (! NILP (Vprint_gensym
)
1376 && !SYMBOL_INTERNED_P (obj
)))
1378 /* In case print-circle is nil and print-gensym is t,
1379 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1380 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1382 for (i
= 0; i
< print_number_index
; i
++)
1383 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1385 /* OBJ appears more than once. Let's remember that. */
1386 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1391 /* OBJ is not yet recorded. Let's add to the table. */
1392 if (print_number_index
== 0)
1394 /* Initialize the table. */
1395 Vprint_number_table
= Fmake_vector (make_number (40), Qnil
);
1397 else if (XVECTOR (Vprint_number_table
)->size
== print_number_index
* 2)
1399 /* Reallocate the table. */
1400 int i
= print_number_index
* 4;
1401 Lisp_Object old_table
= Vprint_number_table
;
1402 Vprint_number_table
= Fmake_vector (make_number (i
), Qnil
);
1403 for (i
= 0; i
< print_number_index
; i
++)
1405 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
)
1406 = PRINT_NUMBER_OBJECT (old_table
, i
);
1407 PRINT_NUMBER_STATUS (Vprint_number_table
, i
)
1408 = PRINT_NUMBER_STATUS (old_table
, i
);
1411 PRINT_NUMBER_OBJECT (Vprint_number_table
, print_number_index
) = obj
;
1412 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1413 always print the gensym with a number. This is a special for
1414 the lisp function byte-compile-output-docform. */
1415 if (!NILP (Vprint_continuous_numbering
)
1417 && !SYMBOL_INTERNED_P (obj
))
1418 PRINT_NUMBER_STATUS (Vprint_number_table
, print_number_index
) = Qt
;
1419 print_number_index
++;
1422 switch (XGCTYPE (obj
))
1425 /* A string may have text properties, which can be circular. */
1426 traverse_intervals_noorder (STRING_INTERVALS (obj
),
1427 print_preprocess_string
, Qnil
);
1431 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1432 just as in print_object. */
1433 if (loop_count
&& EQ (obj
, halftail
))
1435 print_preprocess (XCAR (obj
));
1438 if (!(loop_count
& 1))
1439 halftail
= XCDR (halftail
);
1442 case Lisp_Vectorlike
:
1443 size
= XVECTOR (obj
)->size
;
1444 if (size
& PSEUDOVECTOR_FLAG
)
1445 size
&= PSEUDOVECTOR_SIZE_MASK
;
1446 for (i
= 0; i
< size
; i
++)
1447 print_preprocess (XVECTOR (obj
)->contents
[i
]);
1458 print_preprocess_string (interval
, arg
)
1462 print_preprocess (interval
->plist
);
1465 /* A flag to control printing of `charset' text property.
1466 The default value is Qdefault. */
1467 Lisp_Object Vprint_charset_text_property
;
1468 extern Lisp_Object Qdefault
;
1470 static void print_check_string_charset_prop ();
1472 #define PRINT_STRING_NON_CHARSET_FOUND 1
1473 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
1475 /* Bitwize or of the abobe macros. */
1476 static int print_check_string_result
;
1479 print_check_string_charset_prop (interval
, string
)
1485 if (NILP (interval
->plist
)
1486 || (print_check_string_result
== (PRINT_STRING_NON_CHARSET_FOUND
1487 | PRINT_STRING_UNSAFE_CHARSET_FOUND
)))
1489 for (val
= interval
->plist
; CONSP (val
) && ! EQ (XCAR (val
), Qcharset
);
1490 val
= XCDR (XCDR (val
)));
1493 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1496 if (! (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
))
1498 if (! EQ (val
, interval
->plist
)
1499 || CONSP (XCDR (XCDR (val
))))
1500 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1502 if (NILP (Vprint_charset_text_property
)
1503 || ! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1506 int charpos
= interval
->position
;
1507 int bytepos
= string_char_to_byte (string
, charpos
);
1508 Lisp_Object charset
;
1510 charset
= XCAR (XCDR (val
));
1511 for (i
= 0; i
< LENGTH (interval
); i
++)
1513 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1514 if (! ASCII_CHAR_P (c
)
1515 && ! EQ (CHARSET_NAME (CHAR_CHARSET (c
)), charset
))
1517 print_check_string_result
|= PRINT_STRING_UNSAFE_CHARSET_FOUND
;
1524 /* The value is (charset . nil). */
1525 static Lisp_Object print_prune_charset_plist
;
1528 print_prune_string_charset (string
)
1531 print_check_string_result
= 0;
1532 traverse_intervals (STRING_INTERVALS (string
), 0,
1533 print_check_string_charset_prop
, string
);
1534 if (! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1536 string
= Fcopy_sequence (string
);
1537 if (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
)
1539 if (NILP (print_prune_charset_plist
))
1540 print_prune_charset_plist
= Fcons (Qcharset
, Qnil
);
1541 Fremove_text_properties (make_number (0),
1542 make_number (SCHARS (string
)),
1543 print_prune_charset_plist
, string
);
1546 Fset_text_properties (make_number (0), make_number (SCHARS (string
)),
1553 print_object (obj
, printcharfun
, escapeflag
)
1555 register Lisp_Object printcharfun
;
1562 /* Detect circularities and truncate them. */
1563 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1564 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
)
1565 || (! NILP (Vprint_gensym
)
1567 && !SYMBOL_INTERNED_P (obj
)))
1569 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1571 /* Simple but incomplete way. */
1573 for (i
= 0; i
< print_depth
; i
++)
1574 if (EQ (obj
, being_printed
[i
]))
1576 sprintf (buf
, "#%d", i
);
1577 strout (buf
, -1, -1, printcharfun
, 0);
1580 being_printed
[print_depth
] = obj
;
1584 /* With the print-circle feature. */
1586 for (i
= 0; i
< print_number_index
; i
++)
1587 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1589 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1591 /* Add a prefix #n= if OBJ has not yet been printed;
1592 that is, its status field is nil. */
1593 sprintf (buf
, "#%d=", i
+ 1);
1594 strout (buf
, -1, -1, printcharfun
, 0);
1595 /* OBJ is going to be printed. Set the status to t. */
1596 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1601 /* Just print #n# if OBJ has already been printed. */
1602 sprintf (buf
, "#%d#", i
+ 1);
1603 strout (buf
, -1, -1, printcharfun
, 0);
1612 /* See similar code in print_preprocess. */
1613 if (print_depth
> PRINT_CIRCLE
)
1614 error ("Apparently circular structure being printed");
1615 #ifdef MAX_PRINT_CHARS
1616 if (max_print
&& print_chars
> max_print
)
1621 #endif /* MAX_PRINT_CHARS */
1623 switch (XGCTYPE (obj
))
1626 if (sizeof (int) == sizeof (EMACS_INT
))
1627 sprintf (buf
, "%d", XINT (obj
));
1628 else if (sizeof (long) == sizeof (EMACS_INT
))
1629 sprintf (buf
, "%ld", (long) XINT (obj
));
1632 strout (buf
, -1, -1, printcharfun
, 0);
1637 char pigbuf
[350]; /* see comments in float_to_string */
1639 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1640 strout (pigbuf
, -1, -1, printcharfun
, 0);
1646 print_string (obj
, printcharfun
);
1649 register int i
, i_byte
;
1650 struct gcpro gcpro1
;
1653 /* 1 means we must ensure that the next character we output
1654 cannot be taken as part of a hex character escape. */
1655 int need_nonhex
= 0;
1656 int multibyte
= STRING_MULTIBYTE (obj
);
1660 if (! EQ (Vprint_charset_text_property
, Qt
))
1661 obj
= print_prune_string_charset (obj
);
1663 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1671 size_byte
= SBYTES (obj
);
1673 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1675 /* Here, we must convert each multi-byte form to the
1676 corresponding character code before handing it to PRINTCHAR. */
1682 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
,
1683 size_byte
- i_byte
, len
);
1691 if (c
== '\n' && print_escape_newlines
)
1696 else if (c
== '\f' && print_escape_newlines
)
1702 && (CHAR_BYTE8_P (c
)
1703 || (! ASCII_CHAR_P (c
) && print_escape_multibyte
)))
1705 /* When multibyte is disabled,
1706 print multibyte string chars using hex escapes.
1707 For a char code that could be in a unibyte string,
1708 when found in a multibyte string, always use a hex escape
1709 so it reads back as multibyte. */
1710 unsigned char outbuf
[50];
1712 if (CHAR_BYTE8_P (c
))
1713 sprintf (outbuf
, "\\%03o", CHAR_TO_BYTE8 (c
));
1716 sprintf (outbuf
, "\\x%04x", c
);
1719 strout (outbuf
, -1, -1, printcharfun
, 0);
1721 else if (! multibyte
1722 && SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1723 && print_escape_nonascii
)
1725 /* When printing in a multibyte buffer
1726 or when explicitly requested,
1727 print single-byte non-ASCII string chars
1728 using octal escapes. */
1729 unsigned char outbuf
[5];
1730 sprintf (outbuf
, "\\%03o", c
);
1731 strout (outbuf
, -1, -1, printcharfun
, 0);
1735 /* If we just had a hex escape, and this character
1736 could be taken as part of it,
1737 output `\ ' to prevent that. */
1741 if ((c
>= 'a' && c
<= 'f')
1742 || (c
>= 'A' && c
<= 'F')
1743 || (c
>= '0' && c
<= '9'))
1744 strout ("\\ ", -1, -1, printcharfun
, 0);
1747 if (c
== '\"' || c
== '\\')
1754 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1756 traverse_intervals (STRING_INTERVALS (obj
),
1757 0, print_interval
, printcharfun
);
1767 register int confusing
;
1768 register unsigned char *p
= SDATA (SYMBOL_NAME (obj
));
1769 register unsigned char *end
= p
+ SBYTES (SYMBOL_NAME (obj
));
1771 int i
, i_byte
, size_byte
;
1774 name
= SYMBOL_NAME (obj
);
1776 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1779 /* If symbol name begins with a digit, and ends with a digit,
1780 and contains nothing but digits and `e', it could be treated
1781 as a number. So set CONFUSING.
1783 Symbols that contain periods could also be taken as numbers,
1784 but periods are always escaped, so we don't have to worry
1786 else if (*p
>= '0' && *p
<= '9'
1787 && end
[-1] >= '0' && end
[-1] <= '9')
1789 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1790 /* Needed for \2e10. */
1793 confusing
= (end
== p
);
1798 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1804 size_byte
= SBYTES (name
);
1806 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1808 /* Here, we must convert each multi-byte form to the
1809 corresponding character code before handing it to PRINTCHAR. */
1810 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1815 if (c
== '\"' || c
== '\\' || c
== '\''
1816 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1817 || c
== ',' || c
=='.' || c
== '`'
1818 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1820 PRINTCHAR ('\\'), confusing
= 0;
1828 /* If deeper than spec'd depth, print placeholder. */
1829 if (INTEGERP (Vprint_level
)
1830 && print_depth
> XINT (Vprint_level
))
1831 strout ("...", -1, -1, printcharfun
, 0);
1832 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1833 && (EQ (XCAR (obj
), Qquote
)))
1836 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1838 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1839 && (EQ (XCAR (obj
), Qfunction
)))
1843 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1845 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1846 && ! old_backquote_output
1847 && ((EQ (XCAR (obj
), Qbackquote
)
1848 || EQ (XCAR (obj
), Qcomma
)
1849 || EQ (XCAR (obj
), Qcomma_at
)
1850 || EQ (XCAR (obj
), Qcomma_dot
))))
1852 print_object (XCAR (obj
), printcharfun
, 0);
1853 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1859 /* If the first element is a backquote form,
1860 print it old-style so it won't be misunderstood. */
1861 if (print_quoted
&& CONSP (XCAR (obj
))
1862 && CONSP (XCDR (XCAR (obj
)))
1863 && NILP (XCDR (XCDR (XCAR (obj
))))
1864 && EQ (XCAR (XCAR (obj
)), Qbackquote
))
1870 print_object (Qbackquote
, printcharfun
, 0);
1873 ++old_backquote_output
;
1874 print_object (XCAR (XCDR (tem
)), printcharfun
, 0);
1875 --old_backquote_output
;
1882 int print_length
, i
;
1883 Lisp_Object halftail
= obj
;
1885 /* Negative values of print-length are invalid in CL.
1886 Treat them like nil, as CMUCL does. */
1887 if (NATNUMP (Vprint_length
))
1888 print_length
= XFASTINT (Vprint_length
);
1895 /* Detect circular list. */
1896 if (NILP (Vprint_circle
))
1898 /* Simple but imcomplete way. */
1899 if (i
!= 0 && EQ (obj
, halftail
))
1901 sprintf (buf
, " . #%d", i
/ 2);
1902 strout (buf
, -1, -1, printcharfun
, 0);
1908 /* With the print-circle feature. */
1912 for (i
= 0; i
< print_number_index
; i
++)
1913 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
),
1916 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1918 strout (" . ", 3, 3, printcharfun
, 0);
1919 print_object (obj
, printcharfun
, escapeflag
);
1923 sprintf (buf
, " . #%d#", i
+ 1);
1924 strout (buf
, -1, -1, printcharfun
, 0);
1934 if (print_length
&& i
> print_length
)
1936 strout ("...", 3, 3, printcharfun
, 0);
1940 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1944 halftail
= XCDR (halftail
);
1948 /* OBJ non-nil here means it's the end of a dotted list. */
1951 strout (" . ", 3, 3, printcharfun
, 0);
1952 print_object (obj
, printcharfun
, escapeflag
);
1960 case Lisp_Vectorlike
:
1965 strout ("#<process ", -1, -1, printcharfun
, 0);
1966 print_string (XPROCESS (obj
)->name
, printcharfun
);
1970 print_string (XPROCESS (obj
)->name
, printcharfun
);
1972 else if (BOOL_VECTOR_P (obj
))
1975 register unsigned char c
;
1976 struct gcpro gcpro1
;
1978 = ((XBOOL_VECTOR (obj
)->size
+ BOOL_VECTOR_BITS_PER_CHAR
- 1)
1979 / BOOL_VECTOR_BITS_PER_CHAR
);
1985 sprintf (buf
, "%ld", (long) XBOOL_VECTOR (obj
)->size
);
1986 strout (buf
, -1, -1, printcharfun
, 0);
1989 /* Don't print more characters than the specified maximum.
1990 Negative values of print-length are invalid. Treat them
1991 like a print-length of nil. */
1992 if (NATNUMP (Vprint_length
)
1993 && XFASTINT (Vprint_length
) < size_in_chars
)
1994 size_in_chars
= XFASTINT (Vprint_length
);
1996 for (i
= 0; i
< size_in_chars
; i
++)
1999 c
= XBOOL_VECTOR (obj
)->data
[i
];
2000 if (! ASCII_BYTE_P (c
))
2002 sprintf (buf
, "\\%03o", c
);
2003 strout (buf
, -1, -1, printcharfun
, 0);
2005 else if (c
== '\n' && print_escape_newlines
)
2010 else if (c
== '\f' && print_escape_newlines
)
2015 else if (c
> '\177')
2017 /* Use octal escapes to avoid encoding issues. */
2019 PRINTCHAR ('0' + ((c
>> 6) & 3));
2020 PRINTCHAR ('0' + ((c
>> 3) & 7));
2021 PRINTCHAR ('0' + (c
& 7));
2025 if (c
== '\"' || c
== '\\')
2034 else if (SUBRP (obj
))
2036 strout ("#<subr ", -1, -1, printcharfun
, 0);
2037 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
2040 else if (WINDOWP (obj
))
2042 strout ("#<window ", -1, -1, printcharfun
, 0);
2043 sprintf (buf
, "%ld", (long) XFASTINT (XWINDOW (obj
)->sequence_number
));
2044 strout (buf
, -1, -1, printcharfun
, 0);
2045 if (!NILP (XWINDOW (obj
)->buffer
))
2047 strout (" on ", -1, -1, printcharfun
, 0);
2048 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
2052 else if (HASH_TABLE_P (obj
))
2054 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
2055 strout ("#<hash-table", -1, -1, printcharfun
, 0);
2056 if (SYMBOLP (h
->test
))
2060 strout (SDATA (SYMBOL_NAME (h
->test
)), -1, -1, printcharfun
, 0);
2062 strout (SDATA (SYMBOL_NAME (h
->weak
)), -1, -1, printcharfun
, 0);
2064 sprintf (buf
, "%ld/%ld", (long) XFASTINT (h
->count
),
2065 (long) XVECTOR (h
->next
)->size
);
2066 strout (buf
, -1, -1, printcharfun
, 0);
2068 sprintf (buf
, " 0x%lx", (unsigned long) h
);
2069 strout (buf
, -1, -1, printcharfun
, 0);
2072 else if (BUFFERP (obj
))
2074 if (NILP (XBUFFER (obj
)->name
))
2075 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
2076 else if (escapeflag
)
2078 strout ("#<buffer ", -1, -1, printcharfun
, 0);
2079 print_string (XBUFFER (obj
)->name
, printcharfun
);
2083 print_string (XBUFFER (obj
)->name
, printcharfun
);
2085 else if (WINDOW_CONFIGURATIONP (obj
))
2087 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
2089 else if (FRAMEP (obj
))
2091 strout ((FRAME_LIVE_P (XFRAME (obj
))
2092 ? "#<frame " : "#<dead frame "),
2093 -1, -1, printcharfun
, 0);
2094 print_string (XFRAME (obj
)->name
, printcharfun
);
2095 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
2096 strout (buf
, -1, -1, printcharfun
, 0);
2101 EMACS_INT size
= XVECTOR (obj
)->size
;
2102 if (COMPILEDP (obj
))
2105 size
&= PSEUDOVECTOR_SIZE_MASK
;
2107 if (CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
))
2109 /* We print a char-table as if it were a vector,
2110 lumping the parent and default slots in with the
2111 character slots. But we add #^ as a prefix. */
2114 if (SUB_CHAR_TABLE_P (obj
))
2116 size
&= PSEUDOVECTOR_SIZE_MASK
;
2118 if (size
& PSEUDOVECTOR_FLAG
)
2124 register Lisp_Object tem
;
2125 int real_size
= size
;
2127 /* Don't print more elements than the specified maximum. */
2128 if (NATNUMP (Vprint_length
)
2129 && XFASTINT (Vprint_length
) < size
)
2130 size
= XFASTINT (Vprint_length
);
2132 for (i
= 0; i
< size
; i
++)
2134 if (i
) PRINTCHAR (' ');
2135 tem
= XVECTOR (obj
)->contents
[i
];
2136 print_object (tem
, printcharfun
, escapeflag
);
2138 if (size
< real_size
)
2139 strout (" ...", 4, 4, printcharfun
, 0);
2146 switch (XMISCTYPE (obj
))
2148 case Lisp_Misc_Marker
:
2149 strout ("#<marker ", -1, -1, printcharfun
, 0);
2150 /* Do you think this is necessary? */
2151 if (XMARKER (obj
)->insertion_type
!= 0)
2152 strout ("(moves after insertion) ", -1, -1, printcharfun
, 0);
2153 if (! XMARKER (obj
)->buffer
)
2154 strout ("in no buffer", -1, -1, printcharfun
, 0);
2157 sprintf (buf
, "at %d", marker_position (obj
));
2158 strout (buf
, -1, -1, printcharfun
, 0);
2159 strout (" in ", -1, -1, printcharfun
, 0);
2160 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
2165 case Lisp_Misc_Overlay
:
2166 strout ("#<overlay ", -1, -1, printcharfun
, 0);
2167 if (! XMARKER (OVERLAY_START (obj
))->buffer
)
2168 strout ("in no buffer", -1, -1, printcharfun
, 0);
2171 sprintf (buf
, "from %d to %d in ",
2172 marker_position (OVERLAY_START (obj
)),
2173 marker_position (OVERLAY_END (obj
)));
2174 strout (buf
, -1, -1, printcharfun
, 0);
2175 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
2181 /* Remaining cases shouldn't happen in normal usage, but let's print
2182 them anyway for the benefit of the debugger. */
2183 case Lisp_Misc_Free
:
2184 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
2187 case Lisp_Misc_Intfwd
:
2188 sprintf (buf
, "#<intfwd to %ld>", (long) *XINTFWD (obj
)->intvar
);
2189 strout (buf
, -1, -1, printcharfun
, 0);
2192 case Lisp_Misc_Boolfwd
:
2193 sprintf (buf
, "#<boolfwd to %s>",
2194 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
2195 strout (buf
, -1, -1, printcharfun
, 0);
2198 case Lisp_Misc_Objfwd
:
2199 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
2200 print_object (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
2204 case Lisp_Misc_Buffer_Objfwd
:
2205 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
2206 print_object (PER_BUFFER_VALUE (current_buffer
,
2207 XBUFFER_OBJFWD (obj
)->offset
),
2208 printcharfun
, escapeflag
);
2212 case Lisp_Misc_Kboard_Objfwd
:
2213 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
2214 print_object (*(Lisp_Object
*) ((char *) current_kboard
2215 + XKBOARD_OBJFWD (obj
)->offset
),
2216 printcharfun
, escapeflag
);
2220 case Lisp_Misc_Buffer_Local_Value
:
2221 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
2222 goto do_buffer_local
;
2223 case Lisp_Misc_Some_Buffer_Local_Value
:
2224 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
2226 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
2227 print_object (XBUFFER_LOCAL_VALUE (obj
)->realvalue
,
2228 printcharfun
, escapeflag
);
2229 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
2230 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
2232 strout ("[buffer] ", -1, -1, printcharfun
, 0);
2233 print_object (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
2234 printcharfun
, escapeflag
);
2235 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
2237 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
2238 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
2240 strout ("[frame] ", -1, -1, printcharfun
, 0);
2241 print_object (XBUFFER_LOCAL_VALUE (obj
)->frame
,
2242 printcharfun
, escapeflag
);
2244 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
2245 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2246 printcharfun
, escapeflag
);
2247 strout ("[default-value] ", -1, -1, printcharfun
, 0);
2248 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2249 printcharfun
, escapeflag
);
2253 case Lisp_Misc_Save_Value
:
2254 strout ("#<save_value ", -1, -1, printcharfun
, 0);
2255 sprintf(buf
, "ptr=0x%08lx int=%d",
2256 (unsigned long) XSAVE_VALUE (obj
)->pointer
,
2257 XSAVE_VALUE (obj
)->integer
);
2258 strout (buf
, -1, -1, printcharfun
, 0);
2270 /* We're in trouble if this happens!
2271 Probably should just abort () */
2272 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
2274 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
2275 else if (VECTORLIKEP (obj
))
2276 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
2278 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
2279 strout (buf
, -1, -1, printcharfun
, 0);
2280 strout (" Save your buffers immediately and please report this bug>",
2281 -1, -1, printcharfun
, 0);
2289 /* Print a description of INTERVAL using PRINTCHARFUN.
2290 This is part of printing a string that has text properties. */
2293 print_interval (interval
, printcharfun
)
2295 Lisp_Object printcharfun
;
2297 if (NILP (interval
->plist
))
2300 print_object (make_number (interval
->position
), printcharfun
, 1);
2302 print_object (make_number (interval
->position
+ LENGTH (interval
)),
2305 print_object (interval
->plist
, printcharfun
, 1);
2312 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
2313 staticpro (&Qtemp_buffer_setup_hook
);
2315 DEFVAR_LISP ("standard-output", &Vstandard_output
,
2316 doc
: /* Output stream `print' uses by default for outputting a character.
2317 This may be any function of one argument.
2318 It may also be a buffer (output is inserted before point)
2319 or a marker (output is inserted and the marker is advanced)
2320 or the symbol t (output appears in the echo area). */);
2321 Vstandard_output
= Qt
;
2322 Qstandard_output
= intern ("standard-output");
2323 staticpro (&Qstandard_output
);
2325 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
2326 doc
: /* The format descriptor string used to print floats.
2327 This is a %-spec like those accepted by `printf' in C,
2328 but with some restrictions. It must start with the two characters `%.'.
2329 After that comes an integer precision specification,
2330 and then a letter which controls the format.
2331 The letters allowed are `e', `f' and `g'.
2332 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2333 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2334 Use `g' to choose the shorter of those two formats for the number at hand.
2335 The precision in any of these cases is the number of digits following
2336 the decimal point. With `f', a precision of 0 means to omit the
2337 decimal point. 0 is not allowed with `e' or `g'.
2339 A value of nil means to use the shortest notation
2340 that represents the number without losing information. */);
2341 Vfloat_output_format
= Qnil
;
2342 Qfloat_output_format
= intern ("float-output-format");
2343 staticpro (&Qfloat_output_format
);
2345 DEFVAR_LISP ("print-length", &Vprint_length
,
2346 doc
: /* Maximum length of list to print before abbreviating.
2347 A value of nil means no limit. See also `eval-expression-print-length'. */);
2348 Vprint_length
= Qnil
;
2350 DEFVAR_LISP ("print-level", &Vprint_level
,
2351 doc
: /* Maximum depth of list nesting to print before abbreviating.
2352 A value of nil means no limit. See also `eval-expression-print-level'. */);
2353 Vprint_level
= Qnil
;
2355 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
2356 doc
: /* Non-nil means print newlines in strings as `\\n'.
2357 Also print formfeeds as `\\f'. */);
2358 print_escape_newlines
= 0;
2360 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
2361 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2362 \(OOO is the octal representation of the character code.)
2363 Only single-byte characters are affected, and only in `prin1'.
2364 When the output goes in a multibyte buffer, this feature is
2365 enabled regardless of the value of the variable. */);
2366 print_escape_nonascii
= 0;
2368 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
2369 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2370 \(XXXX is the hex representation of the character code.)
2371 This affects only `prin1'. */);
2372 print_escape_multibyte
= 0;
2374 DEFVAR_BOOL ("print-quoted", &print_quoted
,
2375 doc
: /* Non-nil means print quoted forms with reader syntax.
2376 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2377 forms print as in the new syntax. */);
2380 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
2381 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2382 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2383 When the uninterned symbol appears within a recursive data structure,
2384 and the symbol appears more than once, in addition use the #N# and #N=
2385 constructs as needed, so that multiple references to the same symbol are
2386 shared once again when the text is read back. */);
2387 Vprint_gensym
= Qnil
;
2389 DEFVAR_LISP ("print-circle", &Vprint_circle
,
2390 doc
: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2391 If nil, printing proceeds recursively and may lead to
2392 `max-lisp-eval-depth' being exceeded or an error may occur:
2393 \"Apparently circular structure being printed.\" Also see
2394 `print-length' and `print-level'.
2395 If non-nil, shared substructures anywhere in the structure are printed
2396 with `#N=' before the first occurrence (in the order of the print
2397 representation) and `#N#' in place of each subsequent occurrence,
2398 where N is a positive decimal integer. */);
2399 Vprint_circle
= Qnil
;
2401 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
2402 doc
: /* *Non-nil means number continuously across print calls.
2403 This affects the numbers printed for #N= labels and #M# references.
2404 See also `print-circle', `print-gensym', and `print-number-table'.
2405 This variable should not be set with `setq'; bind it with a `let' instead. */);
2406 Vprint_continuous_numbering
= Qnil
;
2408 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
2409 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2410 The Lisp printer uses this vector to detect Lisp objects referenced more
2413 When you bind `print-continuous-numbering' to t, you should probably
2414 also bind `print-number-table' to nil. This ensures that the value of
2415 `print-number-table' can be garbage-collected once the printing is
2416 done. If all elements of `print-number-table' are nil, it means that
2417 the printing done so far has not found any shared structure or objects
2418 that need to be recorded in the table. */);
2419 Vprint_number_table
= Qnil
;
2421 DEFVAR_LISP ("print-charset-text-property", &Vprint_charset_text_property
,
2422 doc
: /* A flag to control printing of `charset' text property on printing a string.
2423 The value must be nil, t, or `default'.
2425 If the value is nil, don't print the text property `charset'.
2427 If the value is t, always print the text property `charset'.
2429 If the value is `default', print the text property `charset' only when
2430 the value is different from what is guessed in the current charset
2432 Vprint_charset_text_property
= Qdefault
;
2434 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2435 staticpro (&Vprin1_to_string_buffer
);
2438 defsubr (&Sprin1_to_string
);
2439 defsubr (&Serror_message_string
);
2443 defsubr (&Swrite_char
);
2444 defsubr (&Sexternal_debugging_output
);
2445 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2446 defsubr (&Sredirect_debugging_output
);
2449 Qexternal_debugging_output
= intern ("external-debugging-output");
2450 staticpro (&Qexternal_debugging_output
);
2452 Qprint_escape_newlines
= intern ("print-escape-newlines");
2453 staticpro (&Qprint_escape_newlines
);
2455 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
2456 staticpro (&Qprint_escape_multibyte
);
2458 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
2459 staticpro (&Qprint_escape_nonascii
);
2461 print_prune_charset_plist
= Qnil
;
2462 staticpro (&print_prune_charset_plist
);
2464 defsubr (&Swith_output_to_temp_buffer
);
2467 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2468 (do not change this comment) */