1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997,
3 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
28 #include "character.h"
34 #include "dispextern.h"
36 #include "intervals.h"
37 #include "blockinput.h"
38 #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. */
45 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
47 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
49 /* Work around a problem that happens because math.h on hpux 7
50 defines two static variables--which, in Emacs, are not really static,
51 because `static' is defined as nothing. The problem is that they are
52 defined both here and in lread.c.
53 These macros prevent the name conflict. */
54 #if defined (HPUX) && !defined (HPUX8)
55 #define _MAXLDBL print_maxldbl
56 #define _NMAXLDBL print_nmaxldbl
65 /* Default to values appropriate for IEEE floating point. */
70 #define DBL_MANT_DIG 53
76 #define DBL_MIN 2.2250738585072014e-308
79 #ifdef DBL_MIN_REPLACEMENT
81 #define DBL_MIN DBL_MIN_REPLACEMENT
84 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
85 needed to express a float without losing information.
86 The general-case formula is valid for the usual case, IEEE floating point,
87 but many compilers can't optimize the formula to an integer constant,
88 so make a special case for it. */
89 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
90 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
92 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
95 /* Avoid actual stack overflow in print. */
98 /* Level of nesting inside outputting backquote in new style. */
99 int new_backquote_output
;
101 /* Detect most circularities to print finite output. */
102 #define PRINT_CIRCLE 200
103 Lisp_Object being_printed
[PRINT_CIRCLE
];
105 /* When printing into a buffer, first we put the text in this
106 block, then insert it all at once. */
109 /* Size allocated in print_buffer. */
110 int print_buffer_size
;
111 /* Chars stored in print_buffer. */
112 int print_buffer_pos
;
113 /* Bytes stored in print_buffer. */
114 int print_buffer_pos_byte
;
116 /* Maximum length of list to print in full; noninteger means
117 effectively infinity */
119 Lisp_Object Vprint_length
;
121 /* Maximum depth of list to print in full; noninteger means
122 effectively infinity. */
124 Lisp_Object Vprint_level
;
126 /* Nonzero means print newlines in strings as \n. */
128 int print_escape_newlines
;
130 /* Nonzero means to print single-byte non-ascii characters in strings as
133 int print_escape_nonascii
;
135 /* Nonzero means to print multibyte characters in strings as hex escapes. */
137 int print_escape_multibyte
;
139 Lisp_Object Qprint_escape_newlines
;
140 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
142 /* Nonzero means print (quote foo) forms as 'foo, etc. */
146 /* Non-nil means print #: before uninterned symbols. */
148 Lisp_Object Vprint_gensym
;
150 /* Non-nil means print recursive structures using #n= and #n# syntax. */
152 Lisp_Object Vprint_circle
;
154 /* Non-nil means keep continuous number for #n= and #n# syntax
155 between several print functions. */
157 Lisp_Object Vprint_continuous_numbering
;
159 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
160 where OBJn are objects going to be printed, and STATn are their status,
161 which may be different meanings during process. See the comments of
162 the functions print and print_preprocess for details.
163 print_number_index keeps the last position the next object should be added,
164 twice of which is the actual vector position in Vprint_number_table. */
165 int print_number_index
;
166 Lisp_Object Vprint_number_table
;
168 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
169 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
170 See the comment of the variable Vprint_number_table. */
171 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
172 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
174 /* Nonzero means print newline to stdout before next minibuffer message.
175 Defined in xdisp.c */
177 extern int noninteractive_need_newline
;
179 extern int minibuffer_auto_raise
;
181 #ifdef MAX_PRINT_CHARS
182 static int print_chars
;
183 static int max_print
;
184 #endif /* MAX_PRINT_CHARS */
186 void print_interval ();
188 /* GDB resets this to zero on W32 to disable OutputDebugString calls. */
189 int print_output_debug_flag
= 1;
192 /* Low level output routines for characters and strings */
194 /* Lisp functions to do output using a stream
195 must have the stream in a variable called printcharfun
196 and must start with PRINTPREPARE, end with PRINTFINISH,
197 and use PRINTDECLARE to declare common variables.
198 Use PRINTCHAR to output one character,
199 or call strout to output a block of characters. */
201 #define PRINTDECLARE \
202 struct buffer *old = current_buffer; \
203 int old_point = -1, start_point = -1; \
204 int old_point_byte = -1, start_point_byte = -1; \
205 int specpdl_count = SPECPDL_INDEX (); \
206 int free_print_buffer = 0; \
207 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
210 #define PRINTPREPARE \
211 original = printcharfun; \
212 if (NILP (printcharfun)) printcharfun = Qt; \
213 if (BUFFERP (printcharfun)) \
215 if (XBUFFER (printcharfun) != current_buffer) \
216 Fset_buffer (printcharfun); \
217 printcharfun = Qnil; \
219 if (MARKERP (printcharfun)) \
221 EMACS_INT marker_pos; \
222 if (! XMARKER (printcharfun)->buffer) \
223 error ("Marker does not point anywhere"); \
224 if (XMARKER (printcharfun)->buffer != current_buffer) \
225 set_buffer_internal (XMARKER (printcharfun)->buffer); \
226 marker_pos = marker_position (printcharfun); \
227 if (marker_pos < BEGV || marker_pos > ZV) \
228 error ("Marker is outside the accessible part of the buffer"); \
230 old_point_byte = PT_BYTE; \
231 SET_PT_BOTH (marker_pos, \
232 marker_byte_position (printcharfun)); \
234 start_point_byte = PT_BYTE; \
235 printcharfun = Qnil; \
237 if (NILP (printcharfun)) \
239 Lisp_Object string; \
240 if (NILP (current_buffer->enable_multibyte_characters) \
241 && ! print_escape_multibyte) \
242 specbind (Qprint_escape_multibyte, Qt); \
243 if (! NILP (current_buffer->enable_multibyte_characters) \
244 && ! print_escape_nonascii) \
245 specbind (Qprint_escape_nonascii, Qt); \
246 if (print_buffer != 0) \
248 string = make_string_from_bytes (print_buffer, \
250 print_buffer_pos_byte); \
251 record_unwind_protect (print_unwind, string); \
255 print_buffer_size = 1000; \
256 print_buffer = (char *) xmalloc (print_buffer_size); \
257 free_print_buffer = 1; \
259 print_buffer_pos = 0; \
260 print_buffer_pos_byte = 0; \
262 if (EQ (printcharfun, Qt) && ! noninteractive) \
263 setup_echo_area_for_printing (multibyte);
265 #define PRINTFINISH \
266 if (NILP (printcharfun)) \
268 if (print_buffer_pos != print_buffer_pos_byte \
269 && NILP (current_buffer->enable_multibyte_characters)) \
271 unsigned char *temp \
272 = (unsigned char *) alloca (print_buffer_pos + 1); \
273 copy_text (print_buffer, temp, print_buffer_pos_byte, \
275 insert_1_both (temp, print_buffer_pos, \
276 print_buffer_pos, 0, 1, 0); \
279 insert_1_both (print_buffer, print_buffer_pos, \
280 print_buffer_pos_byte, 0, 1, 0); \
281 signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
283 if (free_print_buffer) \
285 xfree (print_buffer); \
288 unbind_to (specpdl_count, Qnil); \
289 if (MARKERP (original)) \
290 set_marker_both (original, Qnil, PT, PT_BYTE); \
291 if (old_point >= 0) \
292 SET_PT_BOTH (old_point + (old_point >= start_point \
293 ? PT - start_point : 0), \
294 old_point_byte + (old_point_byte >= start_point_byte \
295 ? PT_BYTE - start_point_byte : 0)); \
296 if (old != current_buffer) \
297 set_buffer_internal (old);
299 #define PRINTCHAR(ch) printchar (ch, printcharfun)
301 /* This is used to restore the saved contents of print_buffer
302 when there is a recursive call to print. */
305 print_unwind (saved_text
)
306 Lisp_Object saved_text
;
308 bcopy (SDATA (saved_text
), print_buffer
, SCHARS (saved_text
));
313 /* Print character CH using method FUN. FUN nil means print to
314 print_buffer. FUN t means print to echo area or stdout if
315 non-interactive. If FUN is neither nil nor t, call FUN with CH as
323 #ifdef MAX_PRINT_CHARS
326 #endif /* MAX_PRINT_CHARS */
328 if (!NILP (fun
) && !EQ (fun
, Qt
))
329 call1 (fun
, make_number (ch
));
332 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
333 int len
= CHAR_STRING (ch
, str
);
339 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
340 print_buffer
= (char *) xrealloc (print_buffer
,
341 print_buffer_size
*= 2);
342 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
343 print_buffer_pos
+= 1;
344 print_buffer_pos_byte
+= len
;
346 else if (noninteractive
)
348 fwrite (str
, 1, len
, stdout
);
349 noninteractive_need_newline
= 1;
354 = !NILP (current_buffer
->enable_multibyte_characters
);
356 setup_echo_area_for_printing (multibyte_p
);
358 message_dolog (str
, len
, 0, multibyte_p
);
364 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
365 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
366 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
367 print_buffer. PRINTCHARFUN t means output to the echo area or to
368 stdout if non-interactive. If neither nil nor t, call Lisp
369 function PRINTCHARFUN for each character printed. MULTIBYTE
370 non-zero means PTR contains multibyte characters.
372 In the case where PRINTCHARFUN is nil, it is safe for PTR to point
373 to data in a Lisp string. Otherwise that is not safe. */
376 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
379 Lisp_Object printcharfun
;
383 size_byte
= size
= strlen (ptr
);
385 if (NILP (printcharfun
))
387 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
389 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
390 print_buffer
= (char *) xrealloc (print_buffer
,
393 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
394 print_buffer_pos
+= size
;
395 print_buffer_pos_byte
+= size_byte
;
397 #ifdef MAX_PRINT_CHARS
400 #endif /* MAX_PRINT_CHARS */
402 else if (noninteractive
&& EQ (printcharfun
, Qt
))
404 fwrite (ptr
, 1, size_byte
, stdout
);
405 noninteractive_need_newline
= 1;
407 else if (EQ (printcharfun
, Qt
))
409 /* Output to echo area. We're trying to avoid a little overhead
410 here, that's the reason we don't call printchar to do the
414 = !NILP (current_buffer
->enable_multibyte_characters
);
416 setup_echo_area_for_printing (multibyte_p
);
417 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
419 if (size
== size_byte
)
421 for (i
= 0; i
< size
; ++i
)
422 insert_char ((unsigned char) *ptr
++);
427 for (i
= 0; i
< size_byte
; i
+= len
)
429 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
434 #ifdef MAX_PRINT_CHARS
437 #endif /* MAX_PRINT_CHARS */
441 /* PRINTCHARFUN is a Lisp function. */
444 if (size
== size_byte
)
446 while (i
< size_byte
)
454 while (i
< size_byte
)
456 /* Here, we must convert each multi-byte form to the
457 corresponding character code before handing it to
460 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
468 /* Print the contents of a string STRING using PRINTCHARFUN.
469 It isn't safe to use strout in many cases,
470 because printing one char can relocate. */
473 print_string (string
, printcharfun
)
475 Lisp_Object printcharfun
;
477 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
481 if (print_escape_nonascii
)
482 string
= string_escape_byte8 (string
);
484 if (STRING_MULTIBYTE (string
))
485 chars
= SCHARS (string
);
486 else if (! print_escape_nonascii
487 && (EQ (printcharfun
, Qt
)
488 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
489 : ! NILP (current_buffer
->enable_multibyte_characters
)))
491 /* If unibyte string STRING contains 8-bit codes, we must
492 convert STRING to a multibyte string containing the same
497 chars
= SBYTES (string
);
498 bytes
= parse_str_to_multibyte (SDATA (string
), chars
);
501 newstr
= make_uninit_multibyte_string (chars
, bytes
);
502 bcopy (SDATA (string
), SDATA (newstr
), chars
);
503 str_to_multibyte (SDATA (newstr
), bytes
, chars
);
508 chars
= SBYTES (string
);
510 if (EQ (printcharfun
, Qt
))
512 /* Output to echo area. */
513 int nbytes
= SBYTES (string
);
516 /* Copy the string contents so that relocation of STRING by
517 GC does not cause trouble. */
520 SAFE_ALLOCA (buffer
, char *, nbytes
);
521 bcopy (SDATA (string
), buffer
, nbytes
);
523 strout (buffer
, chars
, SBYTES (string
),
524 printcharfun
, STRING_MULTIBYTE (string
));
529 /* No need to copy, since output to print_buffer can't GC. */
530 strout (SDATA (string
),
531 chars
, SBYTES (string
),
532 printcharfun
, STRING_MULTIBYTE (string
));
536 /* Otherwise, string may be relocated by printing one char.
537 So re-fetch the string address for each character. */
539 int size
= SCHARS (string
);
540 int size_byte
= SBYTES (string
);
543 if (size
== size_byte
)
544 for (i
= 0; i
< size
; i
++)
545 PRINTCHAR (SREF (string
, i
));
547 for (i
= 0; i
< size_byte
; )
549 /* Here, we must convert each multi-byte form to the
550 corresponding character code before handing it to PRINTCHAR. */
552 int ch
= STRING_CHAR_AND_LENGTH (SDATA (string
) + i
,
561 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
562 doc
: /* Output character CHARACTER to stream PRINTCHARFUN.
563 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
564 (character
, printcharfun
)
565 Lisp_Object character
, printcharfun
;
569 if (NILP (printcharfun
))
570 printcharfun
= Vstandard_output
;
571 CHECK_NUMBER (character
);
573 PRINTCHAR (XINT (character
));
578 /* Used from outside of print.c to print a block of SIZE
579 single-byte chars at DATA on the default output stream.
580 Do not use this on the contents of a Lisp string. */
583 write_string (data
, size
)
588 Lisp_Object printcharfun
;
590 printcharfun
= Vstandard_output
;
593 strout (data
, size
, size
, printcharfun
, 0);
597 /* Used from outside of print.c to print a block of SIZE
598 single-byte chars at DATA on a specified stream PRINTCHARFUN.
599 Do not use this on the contents of a Lisp string. */
602 write_string_1 (data
, size
, printcharfun
)
605 Lisp_Object printcharfun
;
610 strout (data
, size
, size
, printcharfun
, 0);
616 temp_output_buffer_setup (bufname
)
619 int count
= SPECPDL_INDEX ();
620 register struct buffer
*old
= current_buffer
;
621 register Lisp_Object buf
;
623 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
625 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
627 Fkill_all_local_variables ();
628 delete_all_overlays (current_buffer
);
629 current_buffer
->directory
= old
->directory
;
630 current_buffer
->read_only
= Qnil
;
631 current_buffer
->filename
= Qnil
;
632 current_buffer
->undo_list
= Qt
;
633 eassert (current_buffer
->overlays_before
== NULL
);
634 eassert (current_buffer
->overlays_after
== NULL
);
635 current_buffer
->enable_multibyte_characters
636 = buffer_defaults
.enable_multibyte_characters
;
637 specbind (Qinhibit_read_only
, Qt
);
638 specbind (Qinhibit_modification_hooks
, Qt
);
640 XSETBUFFER (buf
, current_buffer
);
642 Frun_hooks (1, &Qtemp_buffer_setup_hook
);
644 unbind_to (count
, Qnil
);
646 specbind (Qstandard_output
, buf
);
650 internal_with_output_to_temp_buffer (bufname
, function
, args
)
652 Lisp_Object (*function
) P_ ((Lisp_Object
));
655 int count
= SPECPDL_INDEX ();
656 Lisp_Object buf
, val
;
660 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
661 temp_output_buffer_setup (bufname
);
662 buf
= Vstandard_output
;
665 val
= (*function
) (args
);
668 temp_output_buffer_show (buf
);
671 return unbind_to (count
, val
);
674 DEFUN ("with-output-to-temp-buffer",
675 Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
677 doc
: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
678 The buffer is cleared out initially, and marked as unmodified when done.
679 All output done by BODY is inserted in that buffer by default.
680 The buffer is displayed in another window, but not selected.
681 The value of the last form in BODY is returned.
682 If BODY does not finish normally, the buffer BUFNAME is not displayed.
684 The hook `temp-buffer-setup-hook' is run before BODY,
685 with the buffer BUFNAME temporarily current.
686 The hook `temp-buffer-show-hook' is run after the buffer is displayed,
687 with the buffer temporarily current, and the window that was used
688 to display it temporarily selected.
690 If variable `temp-buffer-show-function' is non-nil, call it at the end
691 to get the buffer displayed instead of just displaying the non-selected
692 buffer and calling the hook. It gets one argument, the buffer to display.
694 usage: (with-output-to-temp-buffer BUFNAME BODY...) */)
700 int count
= SPECPDL_INDEX ();
701 Lisp_Object buf
, val
;
704 name
= Feval (Fcar (args
));
706 temp_output_buffer_setup (SDATA (name
));
707 buf
= Vstandard_output
;
710 val
= Fprogn (XCDR (args
));
713 temp_output_buffer_show (buf
);
716 return unbind_to (count
, val
);
720 static void print ();
721 static void print_preprocess ();
722 static void print_preprocess_string ();
723 static void print_object ();
725 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
726 doc
: /* Output a newline to stream PRINTCHARFUN.
727 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
729 Lisp_Object printcharfun
;
733 if (NILP (printcharfun
))
734 printcharfun
= Vstandard_output
;
741 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
742 doc
: /* Output the printed representation of OBJECT, any Lisp object.
743 Quoting characters are printed when needed to make output that `read'
744 can handle, whenever this is possible. For complex objects, the behavior
745 is controlled by `print-level' and `print-length', which see.
747 OBJECT is any of the Lisp data types: a number, a string, a symbol,
748 a list, a buffer, a window, a frame, etc.
750 A printed representation of an object is text which describes that object.
752 Optional argument PRINTCHARFUN is the output stream, which can be one
755 - a buffer, in which case output is inserted into that buffer at point;
756 - a marker, in which case output is inserted at marker's position;
757 - a function, in which case that function is called once for each
758 character of OBJECT's printed representation;
759 - a symbol, in which case that symbol's function definition is called; or
760 - t, in which case the output is displayed in the echo area.
762 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
764 (object
, printcharfun
)
765 Lisp_Object object
, printcharfun
;
769 #ifdef MAX_PRINT_CHARS
771 #endif /* MAX_PRINT_CHARS */
772 if (NILP (printcharfun
))
773 printcharfun
= Vstandard_output
;
775 print (object
, printcharfun
, 1);
780 /* a buffer which is used to hold output being built by prin1-to-string */
781 Lisp_Object Vprin1_to_string_buffer
;
783 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
784 doc
: /* Return a string containing the printed representation of OBJECT.
785 OBJECT can be any Lisp object. This function outputs quoting characters
786 when necessary to make output that `read' can handle, whenever possible,
787 unless the optional second argument NOESCAPE is non-nil. For complex objects,
788 the behavior is controlled by `print-level' and `print-length', which see.
790 OBJECT is any of the Lisp data types: a number, a string, a symbol,
791 a list, a buffer, a window, a frame, etc.
793 A printed representation of an object is text which describes that object. */)
795 Lisp_Object object
, noescape
;
797 Lisp_Object printcharfun
;
798 /* struct gcpro gcpro1, gcpro2; */
799 Lisp_Object save_deactivate_mark
;
800 int count
= SPECPDL_INDEX ();
801 struct buffer
*previous
;
803 specbind (Qinhibit_modification_hooks
, Qt
);
808 /* Save and restore this--we are altering a buffer
809 but we don't want to deactivate the mark just for that.
810 No need for specbind, since errors deactivate the mark. */
811 save_deactivate_mark
= Vdeactivate_mark
;
812 /* GCPRO2 (object, save_deactivate_mark); */
815 printcharfun
= Vprin1_to_string_buffer
;
817 print (object
, printcharfun
, NILP (noescape
));
818 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
822 previous
= current_buffer
;
823 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
824 object
= Fbuffer_string ();
825 if (SBYTES (object
) == SCHARS (object
))
826 STRING_SET_UNIBYTE (object
);
828 /* Note that this won't make prepare_to_modify_buffer call
829 ask-user-about-supersession-threat because this buffer
830 does not visit a file. */
832 set_buffer_internal (previous
);
834 Vdeactivate_mark
= save_deactivate_mark
;
838 return unbind_to (count
, object
);
841 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
842 doc
: /* Output the printed representation of OBJECT, any Lisp object.
843 No quoting characters are used; no delimiters are printed around
844 the contents of strings.
846 OBJECT is any of the Lisp data types: a number, a string, a symbol,
847 a list, a buffer, a window, a frame, etc.
849 A printed representation of an object is text which describes that object.
851 Optional argument PRINTCHARFUN is the output stream, which can be one
854 - a buffer, in which case output is inserted into that buffer at point;
855 - a marker, in which case output is inserted at marker's position;
856 - a function, in which case that function is called once for each
857 character of OBJECT's printed representation;
858 - a symbol, in which case that symbol's function definition is called; or
859 - t, in which case the output is displayed in the echo area.
861 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
863 (object
, printcharfun
)
864 Lisp_Object object
, printcharfun
;
868 if (NILP (printcharfun
))
869 printcharfun
= Vstandard_output
;
871 print (object
, printcharfun
, 0);
876 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
877 doc
: /* Output the printed representation of OBJECT, with newlines around it.
878 Quoting characters are printed when needed to make output that `read'
879 can handle, whenever this is possible. For complex objects, the behavior
880 is controlled by `print-level' and `print-length', which see.
882 OBJECT is any of the Lisp data types: a number, a string, a symbol,
883 a list, a buffer, a window, a frame, etc.
885 A printed representation of an object is text which describes that object.
887 Optional argument PRINTCHARFUN is the output stream, which can be one
890 - a buffer, in which case output is inserted into that buffer at point;
891 - a marker, in which case output is inserted at marker's position;
892 - a function, in which case that function is called once for each
893 character of OBJECT's printed representation;
894 - a symbol, in which case that symbol's function definition is called; or
895 - t, in which case the output is displayed in the echo area.
897 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
899 (object
, printcharfun
)
900 Lisp_Object object
, printcharfun
;
905 #ifdef MAX_PRINT_CHARS
907 max_print
= MAX_PRINT_CHARS
;
908 #endif /* MAX_PRINT_CHARS */
909 if (NILP (printcharfun
))
910 printcharfun
= Vstandard_output
;
914 print (object
, printcharfun
, 1);
917 #ifdef MAX_PRINT_CHARS
920 #endif /* MAX_PRINT_CHARS */
925 /* The subroutine object for external-debugging-output is kept here
926 for the convenience of the debugger. */
927 Lisp_Object Qexternal_debugging_output
;
929 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
930 doc
: /* Write CHARACTER to stderr.
931 You can call print while debugging emacs, and pass it this function
932 to make it write to the debugging output. */)
934 Lisp_Object character
;
936 CHECK_NUMBER (character
);
937 putc (XINT (character
), stderr
);
940 /* Send the output to a debugger (nothing happens if there isn't one). */
941 if (print_output_debug_flag
)
943 char buf
[2] = {(char) XINT (character
), '\0'};
944 OutputDebugString (buf
);
951 /* This function is never called. Its purpose is to prevent
952 print_output_debug_flag from being optimized away. */
955 debug_output_compilation_hack (x
)
958 print_output_debug_flag
= x
;
961 #if defined (GNU_LINUX)
963 /* This functionality is not vitally important in general, so we rely on
964 non-portable ability to use stderr as lvalue. */
966 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
968 FILE *initial_stderr_stream
= NULL
;
970 DEFUN ("redirect-debugging-output", Fredirect_debugging_output
, Sredirect_debugging_output
,
972 "FDebug output file: \nP",
973 doc
: /* Redirect debugging output (stderr stream) to file FILE.
974 If FILE is nil, reset target to the initial stderr stream.
975 Optional arg APPEND non-nil (interactively, with prefix arg) means
976 append to existing target file. */)
978 Lisp_Object file
, append
;
980 if (initial_stderr_stream
!= NULL
)
986 stderr
= initial_stderr_stream
;
987 initial_stderr_stream
= NULL
;
991 file
= Fexpand_file_name (file
, Qnil
);
992 initial_stderr_stream
= stderr
;
993 stderr
= fopen (SDATA (file
), NILP (append
) ? "w" : "a");
996 stderr
= initial_stderr_stream
;
997 initial_stderr_stream
= NULL
;
998 report_file_error ("Cannot open debugging output stream",
1004 #endif /* GNU_LINUX */
1007 /* This is the interface for debugging printing. */
1013 Fprin1 (arg
, Qexternal_debugging_output
);
1014 fprintf (stderr
, "\r\n");
1018 safe_debug_print (arg
)
1021 int valid
= valid_lisp_object_p (arg
);
1026 fprintf (stderr
, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
1027 !valid
? "INVALID" : "SOME",
1028 (unsigned long) XHASH (arg
)
1033 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
1035 doc
: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
1036 See Info anchor `(elisp)Definition of signal' for some details on how this
1037 error message is constructed. */)
1041 struct buffer
*old
= current_buffer
;
1043 struct gcpro gcpro1
;
1045 /* If OBJ is (error STRING), just return STRING.
1046 That is not only faster, it also avoids the need to allocate
1047 space here when the error is due to memory full. */
1048 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
1049 && CONSP (XCDR (obj
))
1050 && STRINGP (XCAR (XCDR (obj
)))
1051 && NILP (XCDR (XCDR (obj
))))
1052 return XCAR (XCDR (obj
));
1054 print_error_message (obj
, Vprin1_to_string_buffer
, 0, Qnil
);
1056 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
1057 value
= Fbuffer_string ();
1061 set_buffer_internal (old
);
1067 /* Print an error message for the error DATA onto Lisp output stream
1068 STREAM (suitable for the print functions).
1069 CONTEXT is a C string describing the context of the error.
1070 CALLER is the Lisp function inside which the error was signaled. */
1073 print_error_message (data
, stream
, context
, caller
)
1074 Lisp_Object data
, stream
;
1078 Lisp_Object errname
, errmsg
, file_error
, tail
;
1079 struct gcpro gcpro1
;
1083 write_string_1 (context
, -1, stream
);
1085 /* If we know from where the error was signaled, show it in
1087 if (!NILP (caller
) && SYMBOLP (caller
))
1089 Lisp_Object cname
= SYMBOL_NAME (caller
);
1090 char *name
= alloca (SBYTES (cname
));
1091 bcopy (SDATA (cname
), name
, SBYTES (cname
));
1092 message_dolog (name
, SBYTES (cname
), 0, 0);
1093 message_dolog (": ", 2, 0, 0);
1096 errname
= Fcar (data
);
1098 if (EQ (errname
, Qerror
))
1103 errmsg
= Fcar (data
);
1108 Lisp_Object error_conditions
;
1109 errmsg
= Fget (errname
, Qerror_message
);
1110 error_conditions
= Fget (errname
, Qerror_conditions
);
1111 file_error
= Fmemq (Qfile_error
, error_conditions
);
1114 /* Print an error message including the data items. */
1116 tail
= Fcdr_safe (data
);
1119 /* For file-error, make error message by concatenating
1120 all the data items. They are all strings. */
1121 if (!NILP (file_error
) && CONSP (tail
))
1122 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
1124 if (STRINGP (errmsg
))
1125 Fprinc (errmsg
, stream
);
1127 write_string_1 ("peculiar error", -1, stream
);
1129 for (i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
1133 write_string_1 (i
? ", " : ": ", 2, stream
);
1135 if (!NILP (file_error
) || EQ (errname
, Qend_of_file
))
1136 Fprinc (obj
, stream
);
1138 Fprin1 (obj
, stream
);
1147 * The buffer should be at least as large as the max string size of the
1148 * largest float, printed in the biggest notation. This is undoubtedly
1149 * 20d float_output_format, with the negative of the C-constant "HUGE"
1152 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1154 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1155 * case of -1e307 in 20d float_output_format. What is one to do (short of
1156 * re-writing _doprnt to be more sane)?
1161 float_to_string (buf
, data
)
1168 /* Check for plus infinity in a way that won't lose
1169 if there is no plus infinity. */
1170 if (data
== data
/ 2 && data
> 1.0)
1172 strcpy (buf
, "1.0e+INF");
1175 /* Likewise for minus infinity. */
1176 if (data
== data
/ 2 && data
< -1.0)
1178 strcpy (buf
, "-1.0e+INF");
1181 /* Check for NaN in a way that won't fail if there are no NaNs. */
1182 if (! (data
* 0.0 >= 0.0))
1184 /* Prepend "-" if the NaN's sign bit is negative.
1185 The sign bit of a double is the bit that is 1 in -0.0. */
1187 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
1189 u_minus_zero
.d
= - 0.0;
1190 for (i
= 0; i
< sizeof (double); i
++)
1191 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1197 strcpy (buf
, "0.0e+NaN");
1201 if (NILP (Vfloat_output_format
)
1202 || !STRINGP (Vfloat_output_format
))
1205 /* Generate the fewest number of digits that represent the
1206 floating point value without losing information.
1207 The following method is simple but a bit slow.
1208 For ideas about speeding things up, please see:
1210 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1211 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1213 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1214 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1216 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1218 sprintf (buf
, "%.*g", width
, data
);
1219 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1221 else /* oink oink */
1223 /* Check that the spec we have is fully valid.
1224 This means not only valid for printf,
1225 but meant for floats, and reasonable. */
1226 cp
= SDATA (Vfloat_output_format
);
1235 /* Check the width specification. */
1237 if ('0' <= *cp
&& *cp
<= '9')
1241 width
= (width
* 10) + (*cp
++ - '0');
1242 while (*cp
>= '0' && *cp
<= '9');
1244 /* A precision of zero is valid only for %f. */
1246 || (width
== 0 && *cp
!= 'f'))
1250 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1256 sprintf (buf
, SDATA (Vfloat_output_format
), data
);
1259 /* Make sure there is a decimal point with digit after, or an
1260 exponent, so that the value is readable as a float. But don't do
1261 this with "%.0f"; it's valid for that not to produce a decimal
1262 point. Note that width can be 0 only for %.0f. */
1265 for (cp
= buf
; *cp
; cp
++)
1266 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1269 if (*cp
== '.' && cp
[1] == 0)
1286 print (obj
, printcharfun
, escapeflag
)
1288 register Lisp_Object printcharfun
;
1291 new_backquote_output
= 0;
1293 /* Reset print_number_index and Vprint_number_table only when
1294 the variable Vprint_continuous_numbering is nil. Otherwise,
1295 the values of these variables will be kept between several
1297 if (NILP (Vprint_continuous_numbering
)
1298 || NILP (Vprint_number_table
))
1300 print_number_index
= 0;
1301 Vprint_number_table
= Qnil
;
1304 /* Construct Vprint_number_table for print-gensym and print-circle. */
1305 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1307 int i
, start
, index
;
1308 start
= index
= print_number_index
;
1309 /* Construct Vprint_number_table.
1310 This increments print_number_index for the objects added. */
1312 print_preprocess (obj
);
1314 /* Remove unnecessary objects, which appear only once in OBJ;
1315 that is, whose status is Qnil. Compactify the necessary objects. */
1316 for (i
= start
; i
< print_number_index
; i
++)
1317 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1319 PRINT_NUMBER_OBJECT (Vprint_number_table
, index
)
1320 = PRINT_NUMBER_OBJECT (Vprint_number_table
, i
);
1324 /* Clear out objects outside the active part of the table. */
1325 for (i
= index
; i
< print_number_index
; i
++)
1326 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
) = Qnil
;
1328 /* Reset the status field for the next print step. Now this
1329 field means whether the object has already been printed. */
1330 for (i
= start
; i
< print_number_index
; i
++)
1331 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qnil
;
1333 print_number_index
= index
;
1337 print_object (obj
, printcharfun
, escapeflag
);
1340 /* Construct Vprint_number_table according to the structure of OBJ.
1341 OBJ itself and all its elements will be added to Vprint_number_table
1342 recursively if it is a list, vector, compiled function, char-table,
1343 string (its text properties will be traced), or a symbol that has
1344 no obarray (this is for the print-gensym feature).
1345 The status fields of Vprint_number_table mean whether each object appears
1346 more than once in OBJ: Qnil at the first time, and Qt after that . */
1348 print_preprocess (obj
)
1354 Lisp_Object halftail
;
1356 /* Give up if we go so deep that print_object will get an error. */
1357 /* See similar code in print_object. */
1358 if (print_depth
>= PRINT_CIRCLE
)
1359 error ("Apparently circular structure being printed");
1361 /* Avoid infinite recursion for circular nested structure
1362 in the case where Vprint_circle is nil. */
1363 if (NILP (Vprint_circle
))
1365 for (i
= 0; i
< print_depth
; i
++)
1366 if (EQ (obj
, being_printed
[i
]))
1368 being_printed
[print_depth
] = obj
;
1375 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1376 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1377 || (! NILP (Vprint_gensym
)
1379 && !SYMBOL_INTERNED_P (obj
)))
1381 /* In case print-circle is nil and print-gensym is t,
1382 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1383 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1385 for (i
= 0; i
< print_number_index
; i
++)
1386 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1388 /* OBJ appears more than once. Let's remember that. */
1389 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1394 /* OBJ is not yet recorded. Let's add to the table. */
1395 if (print_number_index
== 0)
1397 /* Initialize the table. */
1398 Vprint_number_table
= Fmake_vector (make_number (40), Qnil
);
1400 else if (XVECTOR (Vprint_number_table
)->size
== print_number_index
* 2)
1402 /* Reallocate the table. */
1403 int i
= print_number_index
* 4;
1404 Lisp_Object old_table
= Vprint_number_table
;
1405 Vprint_number_table
= Fmake_vector (make_number (i
), Qnil
);
1406 for (i
= 0; i
< print_number_index
; i
++)
1408 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
)
1409 = PRINT_NUMBER_OBJECT (old_table
, i
);
1410 PRINT_NUMBER_STATUS (Vprint_number_table
, i
)
1411 = PRINT_NUMBER_STATUS (old_table
, i
);
1414 PRINT_NUMBER_OBJECT (Vprint_number_table
, print_number_index
) = obj
;
1415 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1416 always print the gensym with a number. This is a special for
1417 the lisp function byte-compile-output-docform. */
1418 if (!NILP (Vprint_continuous_numbering
)
1420 && !SYMBOL_INTERNED_P (obj
))
1421 PRINT_NUMBER_STATUS (Vprint_number_table
, print_number_index
) = Qt
;
1422 print_number_index
++;
1425 switch (XTYPE (obj
))
1428 /* A string may have text properties, which can be circular. */
1429 traverse_intervals_noorder (STRING_INTERVALS (obj
),
1430 print_preprocess_string
, Qnil
);
1434 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1435 just as in print_object. */
1436 if (loop_count
&& EQ (obj
, halftail
))
1438 print_preprocess (XCAR (obj
));
1441 if (!(loop_count
& 1))
1442 halftail
= XCDR (halftail
);
1445 case Lisp_Vectorlike
:
1446 size
= XVECTOR (obj
)->size
;
1447 if (size
& PSEUDOVECTOR_FLAG
)
1448 size
&= PSEUDOVECTOR_SIZE_MASK
;
1449 for (i
= 0; i
< size
; i
++)
1450 print_preprocess (XVECTOR (obj
)->contents
[i
]);
1461 print_preprocess_string (interval
, arg
)
1465 print_preprocess (interval
->plist
);
1468 /* A flag to control printing of `charset' text property.
1469 The default value is Qdefault. */
1470 Lisp_Object Vprint_charset_text_property
;
1471 extern Lisp_Object Qdefault
;
1473 static void print_check_string_charset_prop ();
1475 #define PRINT_STRING_NON_CHARSET_FOUND 1
1476 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
1478 /* Bitwize or of the abobe macros. */
1479 static int print_check_string_result
;
1482 print_check_string_charset_prop (interval
, string
)
1488 if (NILP (interval
->plist
)
1489 || (print_check_string_result
== (PRINT_STRING_NON_CHARSET_FOUND
1490 | PRINT_STRING_UNSAFE_CHARSET_FOUND
)))
1492 for (val
= interval
->plist
; CONSP (val
) && ! EQ (XCAR (val
), Qcharset
);
1493 val
= XCDR (XCDR (val
)));
1496 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1499 if (! (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
))
1501 if (! EQ (val
, interval
->plist
)
1502 || CONSP (XCDR (XCDR (val
))))
1503 print_check_string_result
|= PRINT_STRING_NON_CHARSET_FOUND
;
1505 if (NILP (Vprint_charset_text_property
)
1506 || ! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1509 int charpos
= interval
->position
;
1510 int bytepos
= string_char_to_byte (string
, charpos
);
1511 Lisp_Object charset
;
1513 charset
= XCAR (XCDR (val
));
1514 for (i
= 0; i
< LENGTH (interval
); i
++)
1516 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1517 if (! ASCII_CHAR_P (c
)
1518 && ! EQ (CHARSET_NAME (CHAR_CHARSET (c
)), charset
))
1520 print_check_string_result
|= PRINT_STRING_UNSAFE_CHARSET_FOUND
;
1527 /* The value is (charset . nil). */
1528 static Lisp_Object print_prune_charset_plist
;
1531 print_prune_string_charset (string
)
1534 print_check_string_result
= 0;
1535 traverse_intervals (STRING_INTERVALS (string
), 0,
1536 print_check_string_charset_prop
, string
);
1537 if (! (print_check_string_result
& PRINT_STRING_UNSAFE_CHARSET_FOUND
))
1539 string
= Fcopy_sequence (string
);
1540 if (print_check_string_result
& PRINT_STRING_NON_CHARSET_FOUND
)
1542 if (NILP (print_prune_charset_plist
))
1543 print_prune_charset_plist
= Fcons (Qcharset
, Qnil
);
1544 Fremove_text_properties (make_number (0),
1545 make_number (SCHARS (string
)),
1546 print_prune_charset_plist
, string
);
1549 Fset_text_properties (make_number (0), make_number (SCHARS (string
)),
1556 print_object (obj
, printcharfun
, escapeflag
)
1558 register Lisp_Object printcharfun
;
1565 /* Detect circularities and truncate them. */
1566 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1567 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
)
1568 || (! NILP (Vprint_gensym
)
1570 && !SYMBOL_INTERNED_P (obj
)))
1572 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1574 /* Simple but incomplete way. */
1576 for (i
= 0; i
< print_depth
; i
++)
1577 if (EQ (obj
, being_printed
[i
]))
1579 sprintf (buf
, "#%d", i
);
1580 strout (buf
, -1, -1, printcharfun
, 0);
1583 being_printed
[print_depth
] = obj
;
1587 /* With the print-circle feature. */
1589 for (i
= 0; i
< print_number_index
; i
++)
1590 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1592 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1594 /* Add a prefix #n= if OBJ has not yet been printed;
1595 that is, its status field is nil. */
1596 sprintf (buf
, "#%d=", i
+ 1);
1597 strout (buf
, -1, -1, printcharfun
, 0);
1598 /* OBJ is going to be printed. Set the status to t. */
1599 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1604 /* Just print #n# if OBJ has already been printed. */
1605 sprintf (buf
, "#%d#", i
+ 1);
1606 strout (buf
, -1, -1, printcharfun
, 0);
1615 /* See similar code in print_preprocess. */
1616 if (print_depth
> PRINT_CIRCLE
)
1617 error ("Apparently circular structure being printed");
1618 #ifdef MAX_PRINT_CHARS
1619 if (max_print
&& print_chars
> max_print
)
1624 #endif /* MAX_PRINT_CHARS */
1626 switch (XTYPE (obj
))
1629 if (sizeof (int) == sizeof (EMACS_INT
))
1630 sprintf (buf
, "%d", XINT (obj
));
1631 else if (sizeof (long) == sizeof (EMACS_INT
))
1632 sprintf (buf
, "%ld", (long) XINT (obj
));
1635 strout (buf
, -1, -1, printcharfun
, 0);
1640 char pigbuf
[350]; /* see comments in float_to_string */
1642 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1643 strout (pigbuf
, -1, -1, printcharfun
, 0);
1649 print_string (obj
, printcharfun
);
1652 register int i
, i_byte
;
1653 struct gcpro gcpro1
;
1656 /* 1 means we must ensure that the next character we output
1657 cannot be taken as part of a hex character escape. */
1658 int need_nonhex
= 0;
1659 int multibyte
= STRING_MULTIBYTE (obj
);
1663 if (! EQ (Vprint_charset_text_property
, Qt
))
1664 obj
= print_prune_string_charset (obj
);
1666 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1674 size_byte
= SBYTES (obj
);
1676 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1678 /* Here, we must convert each multi-byte form to the
1679 corresponding character code before handing it to PRINTCHAR. */
1685 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
,
1686 size_byte
- i_byte
, len
);
1694 if (c
== '\n' && print_escape_newlines
)
1699 else if (c
== '\f' && print_escape_newlines
)
1705 && (CHAR_BYTE8_P (c
)
1706 || (! ASCII_CHAR_P (c
) && print_escape_multibyte
)))
1708 /* When multibyte is disabled,
1709 print multibyte string chars using hex escapes.
1710 For a char code that could be in a unibyte string,
1711 when found in a multibyte string, always use a hex escape
1712 so it reads back as multibyte. */
1713 unsigned char outbuf
[50];
1715 if (CHAR_BYTE8_P (c
))
1716 sprintf (outbuf
, "\\%03o", CHAR_TO_BYTE8 (c
));
1719 sprintf (outbuf
, "\\x%04x", c
);
1722 strout (outbuf
, -1, -1, printcharfun
, 0);
1724 else if (! multibyte
1725 && SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1726 && print_escape_nonascii
)
1728 /* When printing in a multibyte buffer
1729 or when explicitly requested,
1730 print single-byte non-ASCII string chars
1731 using octal escapes. */
1732 unsigned char outbuf
[5];
1733 sprintf (outbuf
, "\\%03o", c
);
1734 strout (outbuf
, -1, -1, printcharfun
, 0);
1738 /* If we just had a hex escape, and this character
1739 could be taken as part of it,
1740 output `\ ' to prevent that. */
1744 if ((c
>= 'a' && c
<= 'f')
1745 || (c
>= 'A' && c
<= 'F')
1746 || (c
>= '0' && c
<= '9'))
1747 strout ("\\ ", -1, -1, printcharfun
, 0);
1750 if (c
== '\"' || c
== '\\')
1757 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1759 traverse_intervals (STRING_INTERVALS (obj
),
1760 0, print_interval
, printcharfun
);
1770 register int confusing
;
1771 register unsigned char *p
= SDATA (SYMBOL_NAME (obj
));
1772 register unsigned char *end
= p
+ SBYTES (SYMBOL_NAME (obj
));
1774 int i
, i_byte
, size_byte
;
1777 name
= SYMBOL_NAME (obj
);
1779 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1782 /* If symbol name begins with a digit, and ends with a digit,
1783 and contains nothing but digits and `e', it could be treated
1784 as a number. So set CONFUSING.
1786 Symbols that contain periods could also be taken as numbers,
1787 but periods are always escaped, so we don't have to worry
1789 else if (*p
>= '0' && *p
<= '9'
1790 && end
[-1] >= '0' && end
[-1] <= '9')
1792 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1793 /* Needed for \2e10. */
1796 confusing
= (end
== p
);
1801 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1807 size_byte
= SBYTES (name
);
1809 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1811 /* Here, we must convert each multi-byte form to the
1812 corresponding character code before handing it to PRINTCHAR. */
1813 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1818 if (c
== '\"' || c
== '\\' || c
== '\''
1819 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1820 || c
== ',' || c
=='.' || c
== '`'
1821 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1823 PRINTCHAR ('\\'), confusing
= 0;
1831 /* If deeper than spec'd depth, print placeholder. */
1832 if (INTEGERP (Vprint_level
)
1833 && print_depth
> XINT (Vprint_level
))
1834 strout ("...", -1, -1, printcharfun
, 0);
1835 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1836 && (EQ (XCAR (obj
), Qquote
)))
1839 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1841 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1842 && (EQ (XCAR (obj
), Qfunction
)))
1846 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1848 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1849 && ((EQ (XCAR (obj
), Qbackquote
))))
1851 print_object (XCAR (obj
), printcharfun
, 0);
1852 new_backquote_output
++;
1853 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1854 new_backquote_output
--;
1856 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1857 && new_backquote_output
1858 && ((EQ (XCAR (obj
), Qbackquote
)
1859 || EQ (XCAR (obj
), Qcomma
)
1860 || EQ (XCAR (obj
), Qcomma_at
)
1861 || EQ (XCAR (obj
), Qcomma_dot
))))
1863 print_object (XCAR (obj
), printcharfun
, 0);
1864 new_backquote_output
--;
1865 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1866 new_backquote_output
++;
1872 /* If the first element is a backquote form,
1873 print it old-style so it won't be misunderstood. */
1874 if (print_quoted
&& CONSP (XCAR (obj
))
1875 && CONSP (XCDR (XCAR (obj
)))
1876 && NILP (XCDR (XCDR (XCAR (obj
))))
1877 && EQ (XCAR (XCAR (obj
)), Qbackquote
))
1883 print_object (Qbackquote
, printcharfun
, 0);
1886 print_object (XCAR (XCDR (tem
)), printcharfun
, 0);
1893 int print_length
, i
;
1894 Lisp_Object halftail
= obj
;
1896 /* Negative values of print-length are invalid in CL.
1897 Treat them like nil, as CMUCL does. */
1898 if (NATNUMP (Vprint_length
))
1899 print_length
= XFASTINT (Vprint_length
);
1906 /* Detect circular list. */
1907 if (NILP (Vprint_circle
))
1909 /* Simple but imcomplete way. */
1910 if (i
!= 0 && EQ (obj
, halftail
))
1912 sprintf (buf
, " . #%d", i
/ 2);
1913 strout (buf
, -1, -1, printcharfun
, 0);
1919 /* With the print-circle feature. */
1923 for (i
= 0; i
< print_number_index
; i
++)
1924 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
),
1927 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1929 strout (" . ", 3, 3, printcharfun
, 0);
1930 print_object (obj
, printcharfun
, escapeflag
);
1934 sprintf (buf
, " . #%d#", i
+ 1);
1935 strout (buf
, -1, -1, printcharfun
, 0);
1945 if (print_length
&& i
> print_length
)
1947 strout ("...", 3, 3, printcharfun
, 0);
1951 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1955 halftail
= XCDR (halftail
);
1959 /* OBJ non-nil here means it's the end of a dotted list. */
1962 strout (" . ", 3, 3, printcharfun
, 0);
1963 print_object (obj
, printcharfun
, escapeflag
);
1971 case Lisp_Vectorlike
:
1976 strout ("#<process ", -1, -1, printcharfun
, 0);
1977 print_string (XPROCESS (obj
)->name
, printcharfun
);
1981 print_string (XPROCESS (obj
)->name
, printcharfun
);
1983 else if (BOOL_VECTOR_P (obj
))
1986 register unsigned char c
;
1987 struct gcpro gcpro1
;
1989 = ((XBOOL_VECTOR (obj
)->size
+ BOOL_VECTOR_BITS_PER_CHAR
- 1)
1990 / BOOL_VECTOR_BITS_PER_CHAR
);
1996 sprintf (buf
, "%ld", (long) XBOOL_VECTOR (obj
)->size
);
1997 strout (buf
, -1, -1, printcharfun
, 0);
2000 /* Don't print more characters than the specified maximum.
2001 Negative values of print-length are invalid. Treat them
2002 like a print-length of nil. */
2003 if (NATNUMP (Vprint_length
)
2004 && XFASTINT (Vprint_length
) < size_in_chars
)
2005 size_in_chars
= XFASTINT (Vprint_length
);
2007 for (i
= 0; i
< size_in_chars
; i
++)
2010 c
= XBOOL_VECTOR (obj
)->data
[i
];
2011 if (! ASCII_BYTE_P (c
))
2013 sprintf (buf
, "\\%03o", c
);
2014 strout (buf
, -1, -1, printcharfun
, 0);
2016 else if (c
== '\n' && print_escape_newlines
)
2021 else if (c
== '\f' && print_escape_newlines
)
2026 else if (c
> '\177')
2028 /* Use octal escapes to avoid encoding issues. */
2030 PRINTCHAR ('0' + ((c
>> 6) & 3));
2031 PRINTCHAR ('0' + ((c
>> 3) & 7));
2032 PRINTCHAR ('0' + (c
& 7));
2036 if (c
== '\"' || c
== '\\')
2045 else if (SUBRP (obj
))
2047 strout ("#<subr ", -1, -1, printcharfun
, 0);
2048 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
2051 else if (WINDOWP (obj
))
2053 strout ("#<window ", -1, -1, printcharfun
, 0);
2054 sprintf (buf
, "%ld", (long) XFASTINT (XWINDOW (obj
)->sequence_number
));
2055 strout (buf
, -1, -1, printcharfun
, 0);
2056 if (!NILP (XWINDOW (obj
)->buffer
))
2058 strout (" on ", -1, -1, printcharfun
, 0);
2059 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
2063 else if (TERMINALP (obj
))
2065 struct terminal
*t
= XTERMINAL (obj
);
2066 strout ("#<terminal ", -1, -1, printcharfun
, 0);
2067 sprintf (buf
, "%d", t
->id
);
2068 strout (buf
, -1, -1, printcharfun
, 0);
2071 strout (" on ", -1, -1, printcharfun
, 0);
2072 strout (t
->name
, -1, -1, printcharfun
, 0);
2076 else if (HASH_TABLE_P (obj
))
2078 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
2079 strout ("#<hash-table", -1, -1, printcharfun
, 0);
2080 if (SYMBOLP (h
->test
))
2084 strout (SDATA (SYMBOL_NAME (h
->test
)), -1, -1, printcharfun
, 0);
2086 strout (SDATA (SYMBOL_NAME (h
->weak
)), -1, -1, printcharfun
, 0);
2088 sprintf (buf
, "%ld/%ld", (long) h
->count
,
2089 (long) XVECTOR (h
->next
)->size
);
2090 strout (buf
, -1, -1, printcharfun
, 0);
2092 sprintf (buf
, " 0x%lx", (unsigned long) h
);
2093 strout (buf
, -1, -1, printcharfun
, 0);
2096 else if (BUFFERP (obj
))
2098 if (NILP (XBUFFER (obj
)->name
))
2099 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
2100 else if (escapeflag
)
2102 strout ("#<buffer ", -1, -1, printcharfun
, 0);
2103 print_string (XBUFFER (obj
)->name
, printcharfun
);
2107 print_string (XBUFFER (obj
)->name
, printcharfun
);
2109 else if (WINDOW_CONFIGURATIONP (obj
))
2111 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
2113 else if (FRAMEP (obj
))
2115 strout ((FRAME_LIVE_P (XFRAME (obj
))
2116 ? "#<frame " : "#<dead frame "),
2117 -1, -1, printcharfun
, 0);
2118 print_string (XFRAME (obj
)->name
, printcharfun
);
2119 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
2120 strout (buf
, -1, -1, printcharfun
, 0);
2125 EMACS_INT size
= XVECTOR (obj
)->size
;
2126 if (COMPILEDP (obj
))
2129 size
&= PSEUDOVECTOR_SIZE_MASK
;
2131 if (CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
))
2133 /* We print a char-table as if it were a vector,
2134 lumping the parent and default slots in with the
2135 character slots. But we add #^ as a prefix. */
2138 if (SUB_CHAR_TABLE_P (obj
))
2140 size
&= PSEUDOVECTOR_SIZE_MASK
;
2142 if (size
& PSEUDOVECTOR_FLAG
)
2148 register Lisp_Object tem
;
2149 int real_size
= size
;
2151 /* Don't print more elements than the specified maximum. */
2152 if (NATNUMP (Vprint_length
)
2153 && XFASTINT (Vprint_length
) < size
)
2154 size
= XFASTINT (Vprint_length
);
2156 for (i
= 0; i
< size
; i
++)
2158 if (i
) PRINTCHAR (' ');
2159 tem
= XVECTOR (obj
)->contents
[i
];
2160 print_object (tem
, printcharfun
, escapeflag
);
2162 if (size
< real_size
)
2163 strout (" ...", 4, 4, printcharfun
, 0);
2170 switch (XMISCTYPE (obj
))
2172 case Lisp_Misc_Marker
:
2173 strout ("#<marker ", -1, -1, printcharfun
, 0);
2174 /* Do you think this is necessary? */
2175 if (XMARKER (obj
)->insertion_type
!= 0)
2176 strout ("(moves after insertion) ", -1, -1, printcharfun
, 0);
2177 if (! XMARKER (obj
)->buffer
)
2178 strout ("in no buffer", -1, -1, printcharfun
, 0);
2181 sprintf (buf
, "at %d", marker_position (obj
));
2182 strout (buf
, -1, -1, printcharfun
, 0);
2183 strout (" in ", -1, -1, printcharfun
, 0);
2184 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
2189 case Lisp_Misc_Overlay
:
2190 strout ("#<overlay ", -1, -1, printcharfun
, 0);
2191 if (! XMARKER (OVERLAY_START (obj
))->buffer
)
2192 strout ("in no buffer", -1, -1, printcharfun
, 0);
2195 sprintf (buf
, "from %d to %d in ",
2196 marker_position (OVERLAY_START (obj
)),
2197 marker_position (OVERLAY_END (obj
)));
2198 strout (buf
, -1, -1, printcharfun
, 0);
2199 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
2205 /* Remaining cases shouldn't happen in normal usage, but let's print
2206 them anyway for the benefit of the debugger. */
2207 case Lisp_Misc_Free
:
2208 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
2211 case Lisp_Misc_Intfwd
:
2212 sprintf (buf
, "#<intfwd to %ld>", (long) *XINTFWD (obj
)->intvar
);
2213 strout (buf
, -1, -1, printcharfun
, 0);
2216 case Lisp_Misc_Boolfwd
:
2217 sprintf (buf
, "#<boolfwd to %s>",
2218 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
2219 strout (buf
, -1, -1, printcharfun
, 0);
2222 case Lisp_Misc_Objfwd
:
2223 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
2224 print_object (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
2228 case Lisp_Misc_Buffer_Objfwd
:
2229 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
2230 print_object (PER_BUFFER_VALUE (current_buffer
,
2231 XBUFFER_OBJFWD (obj
)->offset
),
2232 printcharfun
, escapeflag
);
2236 case Lisp_Misc_Kboard_Objfwd
:
2237 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
2238 print_object (*(Lisp_Object
*) ((char *) current_kboard
2239 + XKBOARD_OBJFWD (obj
)->offset
),
2240 printcharfun
, escapeflag
);
2244 case Lisp_Misc_Buffer_Local_Value
:
2245 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
2246 if (XBUFFER_LOCAL_VALUE (obj
)->local_if_set
)
2247 strout ("[local-if-set] ", -1, -1, printcharfun
, 0);
2248 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
2249 print_object (XBUFFER_LOCAL_VALUE (obj
)->realvalue
,
2250 printcharfun
, escapeflag
);
2251 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
2252 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
2254 strout ("[buffer] ", -1, -1, printcharfun
, 0);
2255 print_object (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
2256 printcharfun
, escapeflag
);
2257 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
2259 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
2260 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
2262 strout ("[frame] ", -1, -1, printcharfun
, 0);
2263 print_object (XBUFFER_LOCAL_VALUE (obj
)->frame
,
2264 printcharfun
, escapeflag
);
2266 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
2267 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2268 printcharfun
, escapeflag
);
2269 strout ("[default-value] ", -1, -1, printcharfun
, 0);
2270 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2271 printcharfun
, escapeflag
);
2275 case Lisp_Misc_Save_Value
:
2276 strout ("#<save_value ", -1, -1, printcharfun
, 0);
2277 sprintf(buf
, "ptr=0x%08lx int=%d",
2278 (unsigned long) XSAVE_VALUE (obj
)->pointer
,
2279 XSAVE_VALUE (obj
)->integer
);
2280 strout (buf
, -1, -1, printcharfun
, 0);
2292 /* We're in trouble if this happens!
2293 Probably should just abort () */
2294 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
2296 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
2297 else if (VECTORLIKEP (obj
))
2298 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
2300 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
2301 strout (buf
, -1, -1, printcharfun
, 0);
2302 strout (" Save your buffers immediately and please report this bug>",
2303 -1, -1, printcharfun
, 0);
2311 /* Print a description of INTERVAL using PRINTCHARFUN.
2312 This is part of printing a string that has text properties. */
2315 print_interval (interval
, printcharfun
)
2317 Lisp_Object printcharfun
;
2319 if (NILP (interval
->plist
))
2322 print_object (make_number (interval
->position
), printcharfun
, 1);
2324 print_object (make_number (interval
->position
+ LENGTH (interval
)),
2327 print_object (interval
->plist
, printcharfun
, 1);
2334 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
2335 staticpro (&Qtemp_buffer_setup_hook
);
2337 DEFVAR_LISP ("standard-output", &Vstandard_output
,
2338 doc
: /* Output stream `print' uses by default for outputting a character.
2339 This may be any function of one argument.
2340 It may also be a buffer (output is inserted before point)
2341 or a marker (output is inserted and the marker is advanced)
2342 or the symbol t (output appears in the echo area). */);
2343 Vstandard_output
= Qt
;
2344 Qstandard_output
= intern ("standard-output");
2345 staticpro (&Qstandard_output
);
2347 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
2348 doc
: /* The format descriptor string used to print floats.
2349 This is a %-spec like those accepted by `printf' in C,
2350 but with some restrictions. It must start with the two characters `%.'.
2351 After that comes an integer precision specification,
2352 and then a letter which controls the format.
2353 The letters allowed are `e', `f' and `g'.
2354 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2355 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2356 Use `g' to choose the shorter of those two formats for the number at hand.
2357 The precision in any of these cases is the number of digits following
2358 the decimal point. With `f', a precision of 0 means to omit the
2359 decimal point. 0 is not allowed with `e' or `g'.
2361 A value of nil means to use the shortest notation
2362 that represents the number without losing information. */);
2363 Vfloat_output_format
= Qnil
;
2364 Qfloat_output_format
= intern ("float-output-format");
2365 staticpro (&Qfloat_output_format
);
2367 DEFVAR_LISP ("print-length", &Vprint_length
,
2368 doc
: /* Maximum length of list to print before abbreviating.
2369 A value of nil means no limit. See also `eval-expression-print-length'. */);
2370 Vprint_length
= Qnil
;
2372 DEFVAR_LISP ("print-level", &Vprint_level
,
2373 doc
: /* Maximum depth of list nesting to print before abbreviating.
2374 A value of nil means no limit. See also `eval-expression-print-level'. */);
2375 Vprint_level
= Qnil
;
2377 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
2378 doc
: /* Non-nil means print newlines in strings as `\\n'.
2379 Also print formfeeds as `\\f'. */);
2380 print_escape_newlines
= 0;
2382 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
2383 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2384 \(OOO is the octal representation of the character code.)
2385 Only single-byte characters are affected, and only in `prin1'.
2386 When the output goes in a multibyte buffer, this feature is
2387 enabled regardless of the value of the variable. */);
2388 print_escape_nonascii
= 0;
2390 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
2391 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2392 \(XXXX is the hex representation of the character code.)
2393 This affects only `prin1'. */);
2394 print_escape_multibyte
= 0;
2396 DEFVAR_BOOL ("print-quoted", &print_quoted
,
2397 doc
: /* Non-nil means print quoted forms with reader syntax.
2398 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2399 forms print as in the new syntax. */);
2402 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
2403 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2404 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2405 When the uninterned symbol appears within a recursive data structure,
2406 and the symbol appears more than once, in addition use the #N# and #N=
2407 constructs as needed, so that multiple references to the same symbol are
2408 shared once again when the text is read back. */);
2409 Vprint_gensym
= Qnil
;
2411 DEFVAR_LISP ("print-circle", &Vprint_circle
,
2412 doc
: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2413 If nil, printing proceeds recursively and may lead to
2414 `max-lisp-eval-depth' being exceeded or an error may occur:
2415 \"Apparently circular structure being printed.\" Also see
2416 `print-length' and `print-level'.
2417 If non-nil, shared substructures anywhere in the structure are printed
2418 with `#N=' before the first occurrence (in the order of the print
2419 representation) and `#N#' in place of each subsequent occurrence,
2420 where N is a positive decimal integer. */);
2421 Vprint_circle
= Qnil
;
2423 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
2424 doc
: /* *Non-nil means number continuously across print calls.
2425 This affects the numbers printed for #N= labels and #M# references.
2426 See also `print-circle', `print-gensym', and `print-number-table'.
2427 This variable should not be set with `setq'; bind it with a `let' instead. */);
2428 Vprint_continuous_numbering
= Qnil
;
2430 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
2431 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2432 The Lisp printer uses this vector to detect Lisp objects referenced more
2435 When you bind `print-continuous-numbering' to t, you should probably
2436 also bind `print-number-table' to nil. This ensures that the value of
2437 `print-number-table' can be garbage-collected once the printing is
2438 done. If all elements of `print-number-table' are nil, it means that
2439 the printing done so far has not found any shared structure or objects
2440 that need to be recorded in the table. */);
2441 Vprint_number_table
= Qnil
;
2443 DEFVAR_LISP ("print-charset-text-property", &Vprint_charset_text_property
,
2444 doc
: /* A flag to control printing of `charset' text property on printing a string.
2445 The value must be nil, t, or `default'.
2447 If the value is nil, don't print the text property `charset'.
2449 If the value is t, always print the text property `charset'.
2451 If the value is `default', print the text property `charset' only when
2452 the value is different from what is guessed in the current charset
2454 Vprint_charset_text_property
= Qdefault
;
2456 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2457 staticpro (&Vprin1_to_string_buffer
);
2460 defsubr (&Sprin1_to_string
);
2461 defsubr (&Serror_message_string
);
2465 defsubr (&Swrite_char
);
2466 defsubr (&Sexternal_debugging_output
);
2467 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2468 defsubr (&Sredirect_debugging_output
);
2471 Qexternal_debugging_output
= intern ("external-debugging-output");
2472 staticpro (&Qexternal_debugging_output
);
2474 Qprint_escape_newlines
= intern ("print-escape-newlines");
2475 staticpro (&Qprint_escape_newlines
);
2477 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
2478 staticpro (&Qprint_escape_multibyte
);
2480 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
2481 staticpro (&Qprint_escape_nonascii
);
2483 print_prune_charset_plist
= Qnil
;
2484 staticpro (&print_prune_charset_plist
);
2486 defsubr (&Swith_output_to_temp_buffer
);
2489 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2490 (do not change this comment) */