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. */
33 #include "dispextern.h"
35 #include "intervals.h"
36 #include "blockinput.h"
37 #include "termhooks.h" /* For struct terminal. */
39 Lisp_Object Vstandard_output
, Qstandard_output
;
41 Lisp_Object Qtemp_buffer_setup_hook
;
43 /* These are used to print like we read. */
44 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
46 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
48 /* Work around a problem that happens because math.h on hpux 7
49 defines two static variables--which, in Emacs, are not really static,
50 because `static' is defined as nothing. The problem is that they are
51 defined both here and in lread.c.
52 These macros prevent the name conflict. */
53 #if defined (HPUX) && !defined (HPUX8)
54 #define _MAXLDBL print_maxldbl
55 #define _NMAXLDBL print_nmaxldbl
64 /* Default to values appropriate for IEEE floating point. */
69 #define DBL_MANT_DIG 53
75 #define DBL_MIN 2.2250738585072014e-308
78 #ifdef DBL_MIN_REPLACEMENT
80 #define DBL_MIN DBL_MIN_REPLACEMENT
83 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
84 needed to express a float without losing information.
85 The general-case formula is valid for the usual case, IEEE floating point,
86 but many compilers can't optimize the formula to an integer constant,
87 so make a special case for it. */
88 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
89 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
91 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
94 /* Avoid actual stack overflow in print. */
97 /* Level of nesting inside outputting backquote in new style. */
98 int new_backquote_output
;
100 /* Detect most circularities to print finite output. */
101 #define PRINT_CIRCLE 200
102 Lisp_Object being_printed
[PRINT_CIRCLE
];
104 /* When printing into a buffer, first we put the text in this
105 block, then insert it all at once. */
108 /* Size allocated in print_buffer. */
109 int print_buffer_size
;
110 /* Chars stored in print_buffer. */
111 int print_buffer_pos
;
112 /* Bytes stored in print_buffer. */
113 int print_buffer_pos_byte
;
115 /* Maximum length of list to print in full; noninteger means
116 effectively infinity */
118 Lisp_Object Vprint_length
;
120 /* Maximum depth of list to print in full; noninteger means
121 effectively infinity. */
123 Lisp_Object Vprint_level
;
125 /* Nonzero means print newlines in strings as \n. */
127 int print_escape_newlines
;
129 /* Nonzero means to print single-byte non-ascii characters in strings as
132 int print_escape_nonascii
;
134 /* Nonzero means to print multibyte characters in strings as hex escapes. */
136 int print_escape_multibyte
;
138 Lisp_Object Qprint_escape_newlines
;
139 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
141 /* Nonzero means print (quote foo) forms as 'foo, etc. */
145 /* Non-nil means print #: before uninterned symbols. */
147 Lisp_Object Vprint_gensym
;
149 /* Non-nil means print recursive structures using #n= and #n# syntax. */
151 Lisp_Object Vprint_circle
;
153 /* Non-nil means keep continuous number for #n= and #n# syntax
154 between several print functions. */
156 Lisp_Object Vprint_continuous_numbering
;
158 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
159 where OBJn are objects going to be printed, and STATn are their status,
160 which may be different meanings during process. See the comments of
161 the functions print and print_preprocess for details.
162 print_number_index keeps the last position the next object should be added,
163 twice of which is the actual vector position in Vprint_number_table. */
164 int print_number_index
;
165 Lisp_Object Vprint_number_table
;
167 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
168 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
169 See the comment of the variable Vprint_number_table. */
170 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
171 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
173 /* Nonzero means print newline to stdout before next minibuffer message.
174 Defined in xdisp.c */
176 extern int noninteractive_need_newline
;
178 extern int minibuffer_auto_raise
;
180 #ifdef MAX_PRINT_CHARS
181 static int print_chars
;
182 static int max_print
;
183 #endif /* MAX_PRINT_CHARS */
185 void print_interval ();
187 /* GDB resets this to zero on W32 to disable OutputDebugString calls. */
188 int print_output_debug_flag
= 1;
191 /* Low level output routines for characters and strings */
193 /* Lisp functions to do output using a stream
194 must have the stream in a variable called printcharfun
195 and must start with PRINTPREPARE, end with PRINTFINISH,
196 and use PRINTDECLARE to declare common variables.
197 Use PRINTCHAR to output one character,
198 or call strout to output a block of characters. */
200 #define PRINTDECLARE \
201 struct buffer *old = current_buffer; \
202 int old_point = -1, start_point = -1; \
203 int old_point_byte = -1, start_point_byte = -1; \
204 int specpdl_count = SPECPDL_INDEX (); \
205 int free_print_buffer = 0; \
206 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
209 #define PRINTPREPARE \
210 original = printcharfun; \
211 if (NILP (printcharfun)) printcharfun = Qt; \
212 if (BUFFERP (printcharfun)) \
214 if (XBUFFER (printcharfun) != current_buffer) \
215 Fset_buffer (printcharfun); \
216 printcharfun = Qnil; \
218 if (MARKERP (printcharfun)) \
220 EMACS_INT marker_pos; \
221 if (! XMARKER (printcharfun)->buffer) \
222 error ("Marker does not point anywhere"); \
223 if (XMARKER (printcharfun)->buffer != current_buffer) \
224 set_buffer_internal (XMARKER (printcharfun)->buffer); \
225 marker_pos = marker_position (printcharfun); \
226 if (marker_pos < BEGV || marker_pos > ZV) \
227 error ("Marker is outside the accessible part of the buffer"); \
229 old_point_byte = PT_BYTE; \
230 SET_PT_BOTH (marker_pos, \
231 marker_byte_position (printcharfun)); \
233 start_point_byte = PT_BYTE; \
234 printcharfun = Qnil; \
236 if (NILP (printcharfun)) \
238 Lisp_Object string; \
239 if (NILP (current_buffer->enable_multibyte_characters) \
240 && ! print_escape_multibyte) \
241 specbind (Qprint_escape_multibyte, Qt); \
242 if (! NILP (current_buffer->enable_multibyte_characters) \
243 && ! print_escape_nonascii) \
244 specbind (Qprint_escape_nonascii, Qt); \
245 if (print_buffer != 0) \
247 string = make_string_from_bytes (print_buffer, \
249 print_buffer_pos_byte); \
250 record_unwind_protect (print_unwind, string); \
254 print_buffer_size = 1000; \
255 print_buffer = (char *) xmalloc (print_buffer_size); \
256 free_print_buffer = 1; \
258 print_buffer_pos = 0; \
259 print_buffer_pos_byte = 0; \
261 if (EQ (printcharfun, Qt) && ! noninteractive) \
262 setup_echo_area_for_printing (multibyte);
264 #define PRINTFINISH \
265 if (NILP (printcharfun)) \
267 if (print_buffer_pos != print_buffer_pos_byte \
268 && NILP (current_buffer->enable_multibyte_characters)) \
270 unsigned char *temp \
271 = (unsigned char *) alloca (print_buffer_pos + 1); \
272 copy_text (print_buffer, temp, print_buffer_pos_byte, \
274 insert_1_both (temp, print_buffer_pos, \
275 print_buffer_pos, 0, 1, 0); \
278 insert_1_both (print_buffer, print_buffer_pos, \
279 print_buffer_pos_byte, 0, 1, 0); \
280 signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
282 if (free_print_buffer) \
284 xfree (print_buffer); \
287 unbind_to (specpdl_count, Qnil); \
288 if (MARKERP (original)) \
289 set_marker_both (original, Qnil, PT, PT_BYTE); \
290 if (old_point >= 0) \
291 SET_PT_BOTH (old_point + (old_point >= start_point \
292 ? PT - start_point : 0), \
293 old_point_byte + (old_point_byte >= start_point_byte \
294 ? PT_BYTE - start_point_byte : 0)); \
295 if (old != current_buffer) \
296 set_buffer_internal (old);
298 #define PRINTCHAR(ch) printchar (ch, printcharfun)
300 /* This is used to restore the saved contents of print_buffer
301 when there is a recursive call to print. */
304 print_unwind (saved_text
)
305 Lisp_Object saved_text
;
307 bcopy (SDATA (saved_text
), print_buffer
, SCHARS (saved_text
));
312 /* Print character CH using method FUN. FUN nil means print to
313 print_buffer. FUN t means print to echo area or stdout if
314 non-interactive. If FUN is neither nil nor t, call FUN with CH as
322 #ifdef MAX_PRINT_CHARS
325 #endif /* MAX_PRINT_CHARS */
327 if (!NILP (fun
) && !EQ (fun
, Qt
))
328 call1 (fun
, make_number (ch
));
331 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
332 int len
= CHAR_STRING (ch
, str
);
338 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
339 print_buffer
= (char *) xrealloc (print_buffer
,
340 print_buffer_size
*= 2);
341 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
342 print_buffer_pos
+= 1;
343 print_buffer_pos_byte
+= len
;
345 else if (noninteractive
)
347 fwrite (str
, 1, len
, stdout
);
348 noninteractive_need_newline
= 1;
353 = !NILP (current_buffer
->enable_multibyte_characters
);
355 setup_echo_area_for_printing (multibyte_p
);
357 message_dolog (str
, len
, 0, multibyte_p
);
363 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
364 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
365 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
366 print_buffer. PRINTCHARFUN t means output to the echo area or to
367 stdout if non-interactive. If neither nil nor t, call Lisp
368 function PRINTCHARFUN for each character printed. MULTIBYTE
369 non-zero means PTR contains multibyte characters.
371 In the case where PRINTCHARFUN is nil, it is safe for PTR to point
372 to data in a Lisp string. Otherwise that is not safe. */
375 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
378 Lisp_Object printcharfun
;
382 size_byte
= size
= strlen (ptr
);
384 if (NILP (printcharfun
))
386 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
388 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
389 print_buffer
= (char *) xrealloc (print_buffer
,
392 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
393 print_buffer_pos
+= size
;
394 print_buffer_pos_byte
+= size_byte
;
396 #ifdef MAX_PRINT_CHARS
399 #endif /* MAX_PRINT_CHARS */
401 else if (noninteractive
&& EQ (printcharfun
, Qt
))
403 fwrite (ptr
, 1, size_byte
, stdout
);
404 noninteractive_need_newline
= 1;
406 else if (EQ (printcharfun
, Qt
))
408 /* Output to echo area. We're trying to avoid a little overhead
409 here, that's the reason we don't call printchar to do the
413 = !NILP (current_buffer
->enable_multibyte_characters
);
415 setup_echo_area_for_printing (multibyte_p
);
416 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
418 if (size
== size_byte
)
420 for (i
= 0; i
< size
; ++i
)
421 insert_char ((unsigned char) *ptr
++);
426 for (i
= 0; i
< size_byte
; i
+= len
)
428 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
433 #ifdef MAX_PRINT_CHARS
436 #endif /* MAX_PRINT_CHARS */
440 /* PRINTCHARFUN is a Lisp function. */
443 if (size
== size_byte
)
445 while (i
< size_byte
)
453 while (i
< size_byte
)
455 /* Here, we must convert each multi-byte form to the
456 corresponding character code before handing it to
459 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
467 /* Print the contents of a string STRING using PRINTCHARFUN.
468 It isn't safe to use strout in many cases,
469 because printing one char can relocate. */
472 print_string (string
, printcharfun
)
474 Lisp_Object printcharfun
;
476 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
480 if (STRING_MULTIBYTE (string
))
481 chars
= SCHARS (string
);
482 else if (EQ (printcharfun
, Qt
)
483 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
484 : ! NILP (current_buffer
->enable_multibyte_characters
))
486 /* If unibyte string STRING contains 8-bit codes, we must
487 convert STRING to a multibyte string containing the same
492 chars
= SBYTES (string
);
493 bytes
= parse_str_to_multibyte (SDATA (string
), chars
);
496 newstr
= make_uninit_multibyte_string (chars
, bytes
);
497 bcopy (SDATA (string
), SDATA (newstr
), chars
);
498 str_to_multibyte (SDATA (newstr
), bytes
, chars
);
503 chars
= SBYTES (string
);
505 if (EQ (printcharfun
, Qt
))
507 /* Output to echo area. */
508 int nbytes
= SBYTES (string
);
511 /* Copy the string contents so that relocation of STRING by
512 GC does not cause trouble. */
515 SAFE_ALLOCA (buffer
, char *, nbytes
);
516 bcopy (SDATA (string
), buffer
, nbytes
);
518 strout (buffer
, chars
, SBYTES (string
),
519 printcharfun
, STRING_MULTIBYTE (string
));
524 /* No need to copy, since output to print_buffer can't GC. */
525 strout (SDATA (string
),
526 chars
, SBYTES (string
),
527 printcharfun
, STRING_MULTIBYTE (string
));
531 /* Otherwise, string may be relocated by printing one char.
532 So re-fetch the string address for each character. */
534 int size
= SCHARS (string
);
535 int size_byte
= SBYTES (string
);
538 if (size
== size_byte
)
539 for (i
= 0; i
< size
; i
++)
540 PRINTCHAR (SREF (string
, i
));
542 for (i
= 0; i
< size_byte
; )
544 /* Here, we must convert each multi-byte form to the
545 corresponding character code before handing it to PRINTCHAR. */
547 int ch
= STRING_CHAR_AND_LENGTH (SDATA (string
) + i
,
549 if (!CHAR_VALID_P (ch
, 0))
551 ch
= SREF (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 (XGCTYPE (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
);
1469 print_object (obj
, printcharfun
, escapeflag
)
1471 register Lisp_Object printcharfun
;
1478 /* Detect circularities and truncate them. */
1479 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1480 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1481 || (! NILP (Vprint_gensym
)
1483 && !SYMBOL_INTERNED_P (obj
)))
1485 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1487 /* Simple but incomplete way. */
1489 for (i
= 0; i
< print_depth
; i
++)
1490 if (EQ (obj
, being_printed
[i
]))
1492 sprintf (buf
, "#%d", i
);
1493 strout (buf
, -1, -1, printcharfun
, 0);
1496 being_printed
[print_depth
] = obj
;
1500 /* With the print-circle feature. */
1502 for (i
= 0; i
< print_number_index
; i
++)
1503 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1505 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1507 /* Add a prefix #n= if OBJ has not yet been printed;
1508 that is, its status field is nil. */
1509 sprintf (buf
, "#%d=", i
+ 1);
1510 strout (buf
, -1, -1, printcharfun
, 0);
1511 /* OBJ is going to be printed. Set the status to t. */
1512 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1517 /* Just print #n# if OBJ has already been printed. */
1518 sprintf (buf
, "#%d#", i
+ 1);
1519 strout (buf
, -1, -1, printcharfun
, 0);
1528 /* See similar code in print_preprocess. */
1529 if (print_depth
> PRINT_CIRCLE
)
1530 error ("Apparently circular structure being printed");
1531 #ifdef MAX_PRINT_CHARS
1532 if (max_print
&& print_chars
> max_print
)
1537 #endif /* MAX_PRINT_CHARS */
1539 switch (XGCTYPE (obj
))
1542 if (sizeof (int) == sizeof (EMACS_INT
))
1543 sprintf (buf
, "%d", XINT (obj
));
1544 else if (sizeof (long) == sizeof (EMACS_INT
))
1545 sprintf (buf
, "%ld", (long) XINT (obj
));
1548 strout (buf
, -1, -1, printcharfun
, 0);
1553 char pigbuf
[350]; /* see comments in float_to_string */
1555 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1556 strout (pigbuf
, -1, -1, printcharfun
, 0);
1562 print_string (obj
, printcharfun
);
1565 register int i
, i_byte
;
1566 struct gcpro gcpro1
;
1569 /* 1 means we must ensure that the next character we output
1570 cannot be taken as part of a hex character escape. */
1571 int need_nonhex
= 0;
1572 int multibyte
= STRING_MULTIBYTE (obj
);
1576 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1584 size_byte
= SBYTES (obj
);
1586 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1588 /* Here, we must convert each multi-byte form to the
1589 corresponding character code before handing it to PRINTCHAR. */
1595 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
,
1596 size_byte
- i_byte
, len
);
1597 if (CHAR_VALID_P (c
, 0))
1607 if (c
== '\n' && print_escape_newlines
)
1612 else if (c
== '\f' && print_escape_newlines
)
1618 && ! ASCII_BYTE_P (c
)
1619 && (SINGLE_BYTE_CHAR_P (c
) || print_escape_multibyte
))
1621 /* When multibyte is disabled,
1622 print multibyte string chars using hex escapes.
1623 For a char code that could be in a unibyte string,
1624 when found in a multibyte string, always use a hex escape
1625 so it reads back as multibyte. */
1626 unsigned char outbuf
[50];
1627 sprintf (outbuf
, "\\x%x", c
);
1628 strout (outbuf
, -1, -1, printcharfun
, 0);
1631 else if (! multibyte
1632 && SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1633 && print_escape_nonascii
)
1635 /* When printing in a multibyte buffer
1636 or when explicitly requested,
1637 print single-byte non-ASCII string chars
1638 using octal escapes. */
1639 unsigned char outbuf
[5];
1640 sprintf (outbuf
, "\\%03o", c
);
1641 strout (outbuf
, -1, -1, printcharfun
, 0);
1645 /* If we just had a hex escape, and this character
1646 could be taken as part of it,
1647 output `\ ' to prevent that. */
1651 if ((c
>= 'a' && c
<= 'f')
1652 || (c
>= 'A' && c
<= 'F')
1653 || (c
>= '0' && c
<= '9'))
1654 strout ("\\ ", -1, -1, printcharfun
, 0);
1657 if (c
== '\"' || c
== '\\')
1664 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1666 traverse_intervals (STRING_INTERVALS (obj
),
1667 0, print_interval
, printcharfun
);
1677 register int confusing
;
1678 register unsigned char *p
= SDATA (SYMBOL_NAME (obj
));
1679 register unsigned char *end
= p
+ SBYTES (SYMBOL_NAME (obj
));
1681 int i
, i_byte
, size_byte
;
1684 name
= SYMBOL_NAME (obj
);
1686 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1689 /* If symbol name begins with a digit, and ends with a digit,
1690 and contains nothing but digits and `e', it could be treated
1691 as a number. So set CONFUSING.
1693 Symbols that contain periods could also be taken as numbers,
1694 but periods are always escaped, so we don't have to worry
1696 else if (*p
>= '0' && *p
<= '9'
1697 && end
[-1] >= '0' && end
[-1] <= '9')
1699 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1700 /* Needed for \2e10. */
1703 confusing
= (end
== p
);
1708 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1714 size_byte
= SBYTES (name
);
1716 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1718 /* Here, we must convert each multi-byte form to the
1719 corresponding character code before handing it to PRINTCHAR. */
1720 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1725 if (c
== '\"' || c
== '\\' || c
== '\''
1726 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1727 || c
== ',' || c
=='.' || c
== '`'
1728 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1730 PRINTCHAR ('\\'), confusing
= 0;
1738 /* If deeper than spec'd depth, print placeholder. */
1739 if (INTEGERP (Vprint_level
)
1740 && print_depth
> XINT (Vprint_level
))
1741 strout ("...", -1, -1, printcharfun
, 0);
1742 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1743 && (EQ (XCAR (obj
), Qquote
)))
1746 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1748 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1749 && (EQ (XCAR (obj
), Qfunction
)))
1753 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1755 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1756 && ((EQ (XCAR (obj
), Qbackquote
))))
1758 print_object (XCAR (obj
), printcharfun
, 0);
1759 new_backquote_output
++;
1760 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1761 new_backquote_output
--;
1763 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1764 && new_backquote_output
1765 && ((EQ (XCAR (obj
), Qbackquote
)
1766 || EQ (XCAR (obj
), Qcomma
)
1767 || EQ (XCAR (obj
), Qcomma_at
)
1768 || EQ (XCAR (obj
), Qcomma_dot
))))
1770 print_object (XCAR (obj
), printcharfun
, 0);
1771 new_backquote_output
--;
1772 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1773 new_backquote_output
++;
1779 /* If the first element is a backquote form,
1780 print it old-style so it won't be misunderstood. */
1781 if (print_quoted
&& CONSP (XCAR (obj
))
1782 && CONSP (XCDR (XCAR (obj
)))
1783 && NILP (XCDR (XCDR (XCAR (obj
))))
1784 && EQ (XCAR (XCAR (obj
)), Qbackquote
))
1790 print_object (Qbackquote
, printcharfun
, 0);
1793 print_object (XCAR (XCDR (tem
)), printcharfun
, 0);
1800 int print_length
, i
;
1801 Lisp_Object halftail
= obj
;
1803 /* Negative values of print-length are invalid in CL.
1804 Treat them like nil, as CMUCL does. */
1805 if (NATNUMP (Vprint_length
))
1806 print_length
= XFASTINT (Vprint_length
);
1813 /* Detect circular list. */
1814 if (NILP (Vprint_circle
))
1816 /* Simple but imcomplete way. */
1817 if (i
!= 0 && EQ (obj
, halftail
))
1819 sprintf (buf
, " . #%d", i
/ 2);
1820 strout (buf
, -1, -1, printcharfun
, 0);
1826 /* With the print-circle feature. */
1830 for (i
= 0; i
< print_number_index
; i
++)
1831 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
),
1834 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1836 strout (" . ", 3, 3, printcharfun
, 0);
1837 print_object (obj
, printcharfun
, escapeflag
);
1841 sprintf (buf
, " . #%d#", i
+ 1);
1842 strout (buf
, -1, -1, printcharfun
, 0);
1852 if (print_length
&& i
> print_length
)
1854 strout ("...", 3, 3, printcharfun
, 0);
1858 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1862 halftail
= XCDR (halftail
);
1866 /* OBJ non-nil here means it's the end of a dotted list. */
1869 strout (" . ", 3, 3, printcharfun
, 0);
1870 print_object (obj
, printcharfun
, escapeflag
);
1878 case Lisp_Vectorlike
:
1883 strout ("#<process ", -1, -1, printcharfun
, 0);
1884 print_string (XPROCESS (obj
)->name
, printcharfun
);
1888 print_string (XPROCESS (obj
)->name
, printcharfun
);
1890 else if (BOOL_VECTOR_P (obj
))
1893 register unsigned char c
;
1894 struct gcpro gcpro1
;
1896 = ((XBOOL_VECTOR (obj
)->size
+ BOOL_VECTOR_BITS_PER_CHAR
- 1)
1897 / BOOL_VECTOR_BITS_PER_CHAR
);
1903 sprintf (buf
, "%ld", (long) XBOOL_VECTOR (obj
)->size
);
1904 strout (buf
, -1, -1, printcharfun
, 0);
1907 /* Don't print more characters than the specified maximum.
1908 Negative values of print-length are invalid. Treat them
1909 like a print-length of nil. */
1910 if (NATNUMP (Vprint_length
)
1911 && XFASTINT (Vprint_length
) < size_in_chars
)
1912 size_in_chars
= XFASTINT (Vprint_length
);
1914 for (i
= 0; i
< size_in_chars
; i
++)
1917 c
= XBOOL_VECTOR (obj
)->data
[i
];
1918 if (c
== '\n' && print_escape_newlines
)
1923 else if (c
== '\f' && print_escape_newlines
)
1928 else if (c
> '\177')
1930 /* Use octal escapes to avoid encoding issues. */
1932 PRINTCHAR ('0' + ((c
>> 6) & 3));
1933 PRINTCHAR ('0' + ((c
>> 3) & 7));
1934 PRINTCHAR ('0' + (c
& 7));
1938 if (c
== '\"' || c
== '\\')
1947 else if (SUBRP (obj
))
1949 strout ("#<subr ", -1, -1, printcharfun
, 0);
1950 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1953 else if (WINDOWP (obj
))
1955 strout ("#<window ", -1, -1, printcharfun
, 0);
1956 sprintf (buf
, "%ld", (long) XFASTINT (XWINDOW (obj
)->sequence_number
));
1957 strout (buf
, -1, -1, printcharfun
, 0);
1958 if (!NILP (XWINDOW (obj
)->buffer
))
1960 strout (" on ", -1, -1, printcharfun
, 0);
1961 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1965 else if (TERMINALP (obj
))
1967 struct terminal
*t
= XTERMINAL (obj
);
1968 strout ("#<terminal ", -1, -1, printcharfun
, 0);
1969 sprintf (buf
, "%d", t
->id
);
1970 strout (buf
, -1, -1, printcharfun
, 0);
1973 strout (" on ", -1, -1, printcharfun
, 0);
1974 strout (t
->name
, -1, -1, printcharfun
, 0);
1978 else if (HASH_TABLE_P (obj
))
1980 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1981 strout ("#<hash-table", -1, -1, printcharfun
, 0);
1982 if (SYMBOLP (h
->test
))
1986 strout (SDATA (SYMBOL_NAME (h
->test
)), -1, -1, printcharfun
, 0);
1988 strout (SDATA (SYMBOL_NAME (h
->weak
)), -1, -1, printcharfun
, 0);
1990 sprintf (buf
, "%ld/%ld", (long) h
->count
,
1991 (long) XVECTOR (h
->next
)->size
);
1992 strout (buf
, -1, -1, printcharfun
, 0);
1994 sprintf (buf
, " 0x%lx", (unsigned long) h
);
1995 strout (buf
, -1, -1, printcharfun
, 0);
1998 else if (BUFFERP (obj
))
2000 if (NILP (XBUFFER (obj
)->name
))
2001 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
2002 else if (escapeflag
)
2004 strout ("#<buffer ", -1, -1, printcharfun
, 0);
2005 print_string (XBUFFER (obj
)->name
, printcharfun
);
2009 print_string (XBUFFER (obj
)->name
, printcharfun
);
2011 else if (WINDOW_CONFIGURATIONP (obj
))
2013 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
2015 else if (FRAMEP (obj
))
2017 strout ((FRAME_LIVE_P (XFRAME (obj
))
2018 ? "#<frame " : "#<dead frame "),
2019 -1, -1, printcharfun
, 0);
2020 print_string (XFRAME (obj
)->name
, printcharfun
);
2021 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
2022 strout (buf
, -1, -1, printcharfun
, 0);
2027 EMACS_INT size
= XVECTOR (obj
)->size
;
2028 if (COMPILEDP (obj
))
2031 size
&= PSEUDOVECTOR_SIZE_MASK
;
2033 if (CHAR_TABLE_P (obj
))
2035 /* We print a char-table as if it were a vector,
2036 lumping the parent and default slots in with the
2037 character slots. But we add #^ as a prefix. */
2040 if (SUB_CHAR_TABLE_P (obj
))
2042 size
&= PSEUDOVECTOR_SIZE_MASK
;
2044 if (size
& PSEUDOVECTOR_FLAG
)
2050 register Lisp_Object tem
;
2051 int real_size
= size
;
2053 /* Don't print more elements than the specified maximum. */
2054 if (NATNUMP (Vprint_length
)
2055 && XFASTINT (Vprint_length
) < size
)
2056 size
= XFASTINT (Vprint_length
);
2058 for (i
= 0; i
< size
; i
++)
2060 if (i
) PRINTCHAR (' ');
2061 tem
= XVECTOR (obj
)->contents
[i
];
2062 print_object (tem
, printcharfun
, escapeflag
);
2064 if (size
< real_size
)
2065 strout (" ...", 4, 4, printcharfun
, 0);
2072 switch (XMISCTYPE (obj
))
2074 case Lisp_Misc_Marker
:
2075 strout ("#<marker ", -1, -1, printcharfun
, 0);
2076 /* Do you think this is necessary? */
2077 if (XMARKER (obj
)->insertion_type
!= 0)
2078 strout ("(moves after insertion) ", -1, -1, printcharfun
, 0);
2079 if (! XMARKER (obj
)->buffer
)
2080 strout ("in no buffer", -1, -1, printcharfun
, 0);
2083 sprintf (buf
, "at %d", marker_position (obj
));
2084 strout (buf
, -1, -1, printcharfun
, 0);
2085 strout (" in ", -1, -1, printcharfun
, 0);
2086 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
2091 case Lisp_Misc_Overlay
:
2092 strout ("#<overlay ", -1, -1, printcharfun
, 0);
2093 if (! XMARKER (OVERLAY_START (obj
))->buffer
)
2094 strout ("in no buffer", -1, -1, printcharfun
, 0);
2097 sprintf (buf
, "from %d to %d in ",
2098 marker_position (OVERLAY_START (obj
)),
2099 marker_position (OVERLAY_END (obj
)));
2100 strout (buf
, -1, -1, printcharfun
, 0);
2101 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
2107 /* Remaining cases shouldn't happen in normal usage, but let's print
2108 them anyway for the benefit of the debugger. */
2109 case Lisp_Misc_Free
:
2110 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
2113 case Lisp_Misc_Intfwd
:
2114 sprintf (buf
, "#<intfwd to %ld>", (long) *XINTFWD (obj
)->intvar
);
2115 strout (buf
, -1, -1, printcharfun
, 0);
2118 case Lisp_Misc_Boolfwd
:
2119 sprintf (buf
, "#<boolfwd to %s>",
2120 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
2121 strout (buf
, -1, -1, printcharfun
, 0);
2124 case Lisp_Misc_Objfwd
:
2125 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
2126 print_object (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
2130 case Lisp_Misc_Buffer_Objfwd
:
2131 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
2132 print_object (PER_BUFFER_VALUE (current_buffer
,
2133 XBUFFER_OBJFWD (obj
)->offset
),
2134 printcharfun
, escapeflag
);
2138 case Lisp_Misc_Kboard_Objfwd
:
2139 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
2140 print_object (*(Lisp_Object
*) ((char *) current_kboard
2141 + XKBOARD_OBJFWD (obj
)->offset
),
2142 printcharfun
, escapeflag
);
2146 case Lisp_Misc_Buffer_Local_Value
:
2147 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
2148 if (XBUFFER_LOCAL_VALUE (obj
)->local_if_set
)
2149 strout ("[local-if-set] ", -1, -1, printcharfun
, 0);
2150 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
2151 print_object (XBUFFER_LOCAL_VALUE (obj
)->realvalue
,
2152 printcharfun
, escapeflag
);
2153 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
2154 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
2156 strout ("[buffer] ", -1, -1, printcharfun
, 0);
2157 print_object (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
2158 printcharfun
, escapeflag
);
2159 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
2161 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
2162 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
2164 strout ("[frame] ", -1, -1, printcharfun
, 0);
2165 print_object (XBUFFER_LOCAL_VALUE (obj
)->frame
,
2166 printcharfun
, escapeflag
);
2168 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
2169 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2170 printcharfun
, escapeflag
);
2171 strout ("[default-value] ", -1, -1, printcharfun
, 0);
2172 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2173 printcharfun
, escapeflag
);
2177 case Lisp_Misc_Save_Value
:
2178 strout ("#<save_value ", -1, -1, printcharfun
, 0);
2179 sprintf(buf
, "ptr=0x%08lx int=%d",
2180 (unsigned long) XSAVE_VALUE (obj
)->pointer
,
2181 XSAVE_VALUE (obj
)->integer
);
2182 strout (buf
, -1, -1, printcharfun
, 0);
2194 /* We're in trouble if this happens!
2195 Probably should just abort () */
2196 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
2198 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
2199 else if (VECTORLIKEP (obj
))
2200 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
2202 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
2203 strout (buf
, -1, -1, printcharfun
, 0);
2204 strout (" Save your buffers immediately and please report this bug>",
2205 -1, -1, printcharfun
, 0);
2213 /* Print a description of INTERVAL using PRINTCHARFUN.
2214 This is part of printing a string that has text properties. */
2217 print_interval (interval
, printcharfun
)
2219 Lisp_Object printcharfun
;
2222 print_object (make_number (interval
->position
), printcharfun
, 1);
2224 print_object (make_number (interval
->position
+ LENGTH (interval
)),
2227 print_object (interval
->plist
, printcharfun
, 1);
2234 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
2235 staticpro (&Qtemp_buffer_setup_hook
);
2237 DEFVAR_LISP ("standard-output", &Vstandard_output
,
2238 doc
: /* Output stream `print' uses by default for outputting a character.
2239 This may be any function of one argument.
2240 It may also be a buffer (output is inserted before point)
2241 or a marker (output is inserted and the marker is advanced)
2242 or the symbol t (output appears in the echo area). */);
2243 Vstandard_output
= Qt
;
2244 Qstandard_output
= intern ("standard-output");
2245 staticpro (&Qstandard_output
);
2247 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
2248 doc
: /* The format descriptor string used to print floats.
2249 This is a %-spec like those accepted by `printf' in C,
2250 but with some restrictions. It must start with the two characters `%.'.
2251 After that comes an integer precision specification,
2252 and then a letter which controls the format.
2253 The letters allowed are `e', `f' and `g'.
2254 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2255 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2256 Use `g' to choose the shorter of those two formats for the number at hand.
2257 The precision in any of these cases is the number of digits following
2258 the decimal point. With `f', a precision of 0 means to omit the
2259 decimal point. 0 is not allowed with `e' or `g'.
2261 A value of nil means to use the shortest notation
2262 that represents the number without losing information. */);
2263 Vfloat_output_format
= Qnil
;
2264 Qfloat_output_format
= intern ("float-output-format");
2265 staticpro (&Qfloat_output_format
);
2267 DEFVAR_LISP ("print-length", &Vprint_length
,
2268 doc
: /* Maximum length of list to print before abbreviating.
2269 A value of nil means no limit. See also `eval-expression-print-length'. */);
2270 Vprint_length
= Qnil
;
2272 DEFVAR_LISP ("print-level", &Vprint_level
,
2273 doc
: /* Maximum depth of list nesting to print before abbreviating.
2274 A value of nil means no limit. See also `eval-expression-print-level'. */);
2275 Vprint_level
= Qnil
;
2277 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
2278 doc
: /* Non-nil means print newlines in strings as `\\n'.
2279 Also print formfeeds as `\\f'. */);
2280 print_escape_newlines
= 0;
2282 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
2283 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2284 \(OOO is the octal representation of the character code.)
2285 Only single-byte characters are affected, and only in `prin1'.
2286 When the output goes in a multibyte buffer, this feature is
2287 enabled regardless of the value of the variable. */);
2288 print_escape_nonascii
= 0;
2290 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
2291 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2292 \(XXXX is the hex representation of the character code.)
2293 This affects only `prin1'. */);
2294 print_escape_multibyte
= 0;
2296 DEFVAR_BOOL ("print-quoted", &print_quoted
,
2297 doc
: /* Non-nil means print quoted forms with reader syntax.
2298 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2299 forms print as in the new syntax. */);
2302 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
2303 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2304 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2305 When the uninterned symbol appears within a recursive data structure,
2306 and the symbol appears more than once, in addition use the #N# and #N=
2307 constructs as needed, so that multiple references to the same symbol are
2308 shared once again when the text is read back. */);
2309 Vprint_gensym
= Qnil
;
2311 DEFVAR_LISP ("print-circle", &Vprint_circle
,
2312 doc
: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2313 If nil, printing proceeds recursively and may lead to
2314 `max-lisp-eval-depth' being exceeded or an error may occur:
2315 \"Apparently circular structure being printed.\" Also see
2316 `print-length' and `print-level'.
2317 If non-nil, shared substructures anywhere in the structure are printed
2318 with `#N=' before the first occurrence (in the order of the print
2319 representation) and `#N#' in place of each subsequent occurrence,
2320 where N is a positive decimal integer. */);
2321 Vprint_circle
= Qnil
;
2323 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
2324 doc
: /* *Non-nil means number continuously across print calls.
2325 This affects the numbers printed for #N= labels and #M# references.
2326 See also `print-circle', `print-gensym', and `print-number-table'.
2327 This variable should not be set with `setq'; bind it with a `let' instead. */);
2328 Vprint_continuous_numbering
= Qnil
;
2330 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
2331 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2332 The Lisp printer uses this vector to detect Lisp objects referenced more
2335 When you bind `print-continuous-numbering' to t, you should probably
2336 also bind `print-number-table' to nil. This ensures that the value of
2337 `print-number-table' can be garbage-collected once the printing is
2338 done. If all elements of `print-number-table' are nil, it means that
2339 the printing done so far has not found any shared structure or objects
2340 that need to be recorded in the table. */);
2341 Vprint_number_table
= Qnil
;
2343 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2344 staticpro (&Vprin1_to_string_buffer
);
2347 defsubr (&Sprin1_to_string
);
2348 defsubr (&Serror_message_string
);
2352 defsubr (&Swrite_char
);
2353 defsubr (&Sexternal_debugging_output
);
2354 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2355 defsubr (&Sredirect_debugging_output
);
2358 Qexternal_debugging_output
= intern ("external-debugging-output");
2359 staticpro (&Qexternal_debugging_output
);
2361 Qprint_escape_newlines
= intern ("print-escape-newlines");
2362 staticpro (&Qprint_escape_newlines
);
2364 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
2365 staticpro (&Qprint_escape_multibyte
);
2367 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
2368 staticpro (&Qprint_escape_nonascii
);
2370 defsubr (&Swith_output_to_temp_buffer
);
2373 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2374 (do not change this comment) */