1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 01, 03, 2004
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
32 #include "dispextern.h"
34 #include "intervals.h"
36 Lisp_Object Vstandard_output
, Qstandard_output
;
38 Lisp_Object Qtemp_buffer_setup_hook
;
40 /* These are used to print like we read. */
41 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
43 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
45 /* Work around a problem that happens because math.h on hpux 7
46 defines two static variables--which, in Emacs, are not really static,
47 because `static' is defined as nothing. The problem is that they are
48 defined both here and in lread.c.
49 These macros prevent the name conflict. */
50 #if defined (HPUX) && !defined (HPUX8)
51 #define _MAXLDBL print_maxldbl
52 #define _NMAXLDBL print_nmaxldbl
61 /* Default to values appropriate for IEEE floating point. */
66 #define DBL_MANT_DIG 53
72 #define DBL_MIN 2.2250738585072014e-308
75 #ifdef DBL_MIN_REPLACEMENT
77 #define DBL_MIN DBL_MIN_REPLACEMENT
80 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
81 needed to express a float without losing information.
82 The general-case formula is valid for the usual case, IEEE floating point,
83 but many compilers can't optimize the formula to an integer constant,
84 so make a special case for it. */
85 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
86 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
88 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
91 /* Avoid actual stack overflow in print. */
94 /* Nonzero if inside outputting backquote in old style. */
95 int old_backquote_output
;
97 /* Detect most circularities to print finite output. */
98 #define PRINT_CIRCLE 200
99 Lisp_Object being_printed
[PRINT_CIRCLE
];
101 /* When printing into a buffer, first we put the text in this
102 block, then insert it all at once. */
105 /* Size allocated in print_buffer. */
106 int print_buffer_size
;
107 /* Chars stored in print_buffer. */
108 int print_buffer_pos
;
109 /* Bytes stored in print_buffer. */
110 int print_buffer_pos_byte
;
112 /* Maximum length of list to print in full; noninteger means
113 effectively infinity */
115 Lisp_Object Vprint_length
;
117 /* Maximum depth of list to print in full; noninteger means
118 effectively infinity. */
120 Lisp_Object Vprint_level
;
122 /* Nonzero means print newlines in strings as \n. */
124 int print_escape_newlines
;
126 /* Nonzero means to print single-byte non-ascii characters in strings as
129 int print_escape_nonascii
;
131 /* Nonzero means to print multibyte characters in strings as hex escapes. */
133 int print_escape_multibyte
;
135 Lisp_Object Qprint_escape_newlines
;
136 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
138 /* Nonzero means print (quote foo) forms as 'foo, etc. */
142 /* Non-nil means print #: before uninterned symbols. */
144 Lisp_Object Vprint_gensym
;
146 /* Non-nil means print recursive structures using #n= and #n# syntax. */
148 Lisp_Object Vprint_circle
;
150 /* Non-nil means keep continuous number for #n= and #n# syntax
151 between several print functions. */
153 Lisp_Object Vprint_continuous_numbering
;
155 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
156 where OBJn are objects going to be printed, and STATn are their status,
157 which may be different meanings during process. See the comments of
158 the functions print and print_preprocess for details.
159 print_number_index keeps the last position the next object should be added,
160 twice of which is the actual vector position in Vprint_number_table. */
161 int print_number_index
;
162 Lisp_Object Vprint_number_table
;
164 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
165 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
166 See the comment of the variable Vprint_number_table. */
167 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
168 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
170 /* Nonzero means print newline to stdout before next minibuffer message.
171 Defined in xdisp.c */
173 extern int noninteractive_need_newline
;
175 extern int minibuffer_auto_raise
;
177 #ifdef MAX_PRINT_CHARS
178 static int print_chars
;
179 static int max_print
;
180 #endif /* MAX_PRINT_CHARS */
182 void print_interval ();
185 /* Low level output routines for characters and strings */
187 /* Lisp functions to do output using a stream
188 must have the stream in a variable called printcharfun
189 and must start with PRINTPREPARE, end with PRINTFINISH,
190 and use PRINTDECLARE to declare common variables.
191 Use PRINTCHAR to output one character,
192 or call strout to output a block of characters. */
194 #define PRINTDECLARE \
195 struct buffer *old = current_buffer; \
196 int old_point = -1, start_point = -1; \
197 int old_point_byte = -1, start_point_byte = -1; \
198 int specpdl_count = SPECPDL_INDEX (); \
199 int free_print_buffer = 0; \
200 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
203 #define PRINTPREPARE \
204 original = printcharfun; \
205 if (NILP (printcharfun)) printcharfun = Qt; \
206 if (BUFFERP (printcharfun)) \
208 if (XBUFFER (printcharfun) != current_buffer) \
209 Fset_buffer (printcharfun); \
210 printcharfun = Qnil; \
212 if (MARKERP (printcharfun)) \
214 if (!(XMARKER (original)->buffer)) \
215 error ("Marker does not point anywhere"); \
216 if (XMARKER (original)->buffer != current_buffer) \
217 set_buffer_internal (XMARKER (original)->buffer); \
219 old_point_byte = PT_BYTE; \
220 SET_PT_BOTH (marker_position (printcharfun), \
221 marker_byte_position (printcharfun)); \
223 start_point_byte = PT_BYTE; \
224 printcharfun = Qnil; \
226 if (NILP (printcharfun)) \
228 Lisp_Object string; \
229 if (NILP (current_buffer->enable_multibyte_characters) \
230 && ! print_escape_multibyte) \
231 specbind (Qprint_escape_multibyte, Qt); \
232 if (! NILP (current_buffer->enable_multibyte_characters) \
233 && ! print_escape_nonascii) \
234 specbind (Qprint_escape_nonascii, Qt); \
235 if (print_buffer != 0) \
237 string = make_string_from_bytes (print_buffer, \
239 print_buffer_pos_byte); \
240 record_unwind_protect (print_unwind, string); \
244 print_buffer_size = 1000; \
245 print_buffer = (char *) xmalloc (print_buffer_size); \
246 free_print_buffer = 1; \
248 print_buffer_pos = 0; \
249 print_buffer_pos_byte = 0; \
251 if (EQ (printcharfun, Qt) && ! noninteractive) \
252 setup_echo_area_for_printing (multibyte);
254 #define PRINTFINISH \
255 if (NILP (printcharfun)) \
257 if (print_buffer_pos != print_buffer_pos_byte \
258 && NILP (current_buffer->enable_multibyte_characters)) \
260 unsigned char *temp \
261 = (unsigned char *) alloca (print_buffer_pos + 1); \
262 copy_text (print_buffer, temp, print_buffer_pos_byte, \
264 insert_1_both (temp, print_buffer_pos, \
265 print_buffer_pos, 0, 1, 0); \
268 insert_1_both (print_buffer, print_buffer_pos, \
269 print_buffer_pos_byte, 0, 1, 0); \
271 if (free_print_buffer) \
273 xfree (print_buffer); \
276 unbind_to (specpdl_count, Qnil); \
277 if (MARKERP (original)) \
278 set_marker_both (original, Qnil, PT, PT_BYTE); \
279 if (old_point >= 0) \
280 SET_PT_BOTH (old_point + (old_point >= start_point \
281 ? PT - start_point : 0), \
282 old_point_byte + (old_point_byte >= start_point_byte \
283 ? PT_BYTE - start_point_byte : 0)); \
284 if (old != current_buffer) \
285 set_buffer_internal (old);
287 #define PRINTCHAR(ch) printchar (ch, printcharfun)
289 /* This is used to restore the saved contents of print_buffer
290 when there is a recursive call to print. */
293 print_unwind (saved_text
)
294 Lisp_Object saved_text
;
296 bcopy (SDATA (saved_text
), print_buffer
, SCHARS (saved_text
));
301 /* Print character CH using method FUN. FUN nil means print to
302 print_buffer. FUN t means print to echo area or stdout if
303 non-interactive. If FUN is neither nil nor t, call FUN with CH as
311 #ifdef MAX_PRINT_CHARS
314 #endif /* MAX_PRINT_CHARS */
316 if (!NILP (fun
) && !EQ (fun
, Qt
))
317 call1 (fun
, make_number (ch
));
320 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
321 int len
= CHAR_STRING (ch
, str
);
327 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
328 print_buffer
= (char *) xrealloc (print_buffer
,
329 print_buffer_size
*= 2);
330 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
331 print_buffer_pos
+= 1;
332 print_buffer_pos_byte
+= len
;
334 else if (noninteractive
)
336 fwrite (str
, 1, len
, stdout
);
337 noninteractive_need_newline
= 1;
342 = !NILP (current_buffer
->enable_multibyte_characters
);
344 setup_echo_area_for_printing (multibyte_p
);
346 message_dolog (str
, len
, 0, multibyte_p
);
352 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
353 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
354 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
355 print_buffer. PRINTCHARFUN t means output to the echo area or to
356 stdout if non-interactive. If neither nil nor t, call Lisp
357 function PRINTCHARFUN for each character printed. MULTIBYTE
358 non-zero means PTR contains multibyte characters. */
361 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
364 Lisp_Object printcharfun
;
368 size_byte
= size
= strlen (ptr
);
370 if (NILP (printcharfun
))
372 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
374 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
375 print_buffer
= (char *) xrealloc (print_buffer
,
378 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
379 print_buffer_pos
+= size
;
380 print_buffer_pos_byte
+= size_byte
;
382 #ifdef MAX_PRINT_CHARS
385 #endif /* MAX_PRINT_CHARS */
387 else if (noninteractive
&& EQ (printcharfun
, Qt
))
389 fwrite (ptr
, 1, size_byte
, stdout
);
390 noninteractive_need_newline
= 1;
392 else if (EQ (printcharfun
, Qt
))
394 /* Output to echo area. We're trying to avoid a little overhead
395 here, that's the reason we don't call printchar to do the
399 = !NILP (current_buffer
->enable_multibyte_characters
);
401 setup_echo_area_for_printing (multibyte_p
);
402 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
404 if (size
== size_byte
)
406 for (i
= 0; i
< size
; ++i
)
407 insert_char ((unsigned char )*ptr
++);
412 for (i
= 0; i
< size_byte
; i
+= len
)
414 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
419 #ifdef MAX_PRINT_CHARS
422 #endif /* MAX_PRINT_CHARS */
426 /* PRINTCHARFUN is a Lisp function. */
429 if (size
== size_byte
)
431 while (i
< size_byte
)
439 while (i
< size_byte
)
441 /* Here, we must convert each multi-byte form to the
442 corresponding character code before handing it to
445 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
453 /* Print the contents of a string STRING using PRINTCHARFUN.
454 It isn't safe to use strout in many cases,
455 because printing one char can relocate. */
458 print_string (string
, printcharfun
)
460 Lisp_Object printcharfun
;
462 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
466 if (STRING_MULTIBYTE (string
))
467 chars
= SCHARS (string
);
468 else if (EQ (printcharfun
, Qt
)
469 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
470 : ! NILP (current_buffer
->enable_multibyte_characters
))
472 /* If unibyte string STRING contains 8-bit codes, we must
473 convert STRING to a multibyte string containing the same
478 chars
= SBYTES (string
);
479 bytes
= parse_str_to_multibyte (SDATA (string
), chars
);
482 newstr
= make_uninit_multibyte_string (chars
, bytes
);
483 bcopy (SDATA (string
), SDATA (newstr
), chars
);
484 str_to_multibyte (SDATA (newstr
), bytes
, chars
);
489 chars
= SBYTES (string
);
491 /* strout is safe for output to a frame (echo area) or to print_buffer. */
492 strout (SDATA (string
),
493 chars
, SBYTES (string
),
494 printcharfun
, STRING_MULTIBYTE (string
));
498 /* Otherwise, string may be relocated by printing one char.
499 So re-fetch the string address for each character. */
501 int size
= SCHARS (string
);
502 int size_byte
= SBYTES (string
);
505 if (size
== size_byte
)
506 for (i
= 0; i
< size
; i
++)
507 PRINTCHAR (SREF (string
, i
));
509 for (i
= 0; i
< size_byte
; )
511 /* Here, we must convert each multi-byte form to the
512 corresponding character code before handing it to PRINTCHAR. */
514 int ch
= STRING_CHAR_AND_LENGTH (SDATA (string
) + i
,
516 if (!CHAR_VALID_P (ch
, 0))
518 ch
= SREF (string
, i
);
528 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
529 doc
: /* Output character CHARACTER to stream PRINTCHARFUN.
530 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
531 (character
, printcharfun
)
532 Lisp_Object character
, printcharfun
;
536 if (NILP (printcharfun
))
537 printcharfun
= Vstandard_output
;
538 CHECK_NUMBER (character
);
540 PRINTCHAR (XINT (character
));
545 /* Used from outside of print.c to print a block of SIZE
546 single-byte chars at DATA on the default output stream.
547 Do not use this on the contents of a Lisp string. */
550 write_string (data
, size
)
555 Lisp_Object printcharfun
;
557 printcharfun
= Vstandard_output
;
560 strout (data
, size
, size
, printcharfun
, 0);
564 /* Used from outside of print.c to print a block of SIZE
565 single-byte chars at DATA on a specified stream PRINTCHARFUN.
566 Do not use this on the contents of a Lisp string. */
569 write_string_1 (data
, size
, printcharfun
)
572 Lisp_Object printcharfun
;
577 strout (data
, size
, size
, printcharfun
, 0);
583 temp_output_buffer_setup (bufname
)
586 int count
= SPECPDL_INDEX ();
587 register struct buffer
*old
= current_buffer
;
588 register Lisp_Object buf
;
590 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
592 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
594 Fkill_all_local_variables ();
595 delete_all_overlays (current_buffer
);
596 current_buffer
->directory
= old
->directory
;
597 current_buffer
->read_only
= Qnil
;
598 current_buffer
->filename
= Qnil
;
599 current_buffer
->undo_list
= Qt
;
600 eassert (current_buffer
->overlays_before
== NULL
);
601 eassert (current_buffer
->overlays_after
== NULL
);
602 current_buffer
->enable_multibyte_characters
603 = buffer_defaults
.enable_multibyte_characters
;
605 XSETBUFFER (buf
, current_buffer
);
607 Frun_hooks (1, &Qtemp_buffer_setup_hook
);
609 unbind_to (count
, Qnil
);
611 specbind (Qstandard_output
, buf
);
615 internal_with_output_to_temp_buffer (bufname
, function
, args
)
617 Lisp_Object (*function
) P_ ((Lisp_Object
));
620 int count
= SPECPDL_INDEX ();
621 Lisp_Object buf
, val
;
625 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
626 temp_output_buffer_setup (bufname
);
627 buf
= Vstandard_output
;
630 val
= (*function
) (args
);
633 temp_output_buffer_show (buf
);
636 return unbind_to (count
, val
);
639 DEFUN ("with-output-to-temp-buffer",
640 Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
642 doc
: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
643 The buffer is cleared out initially, and marked as unmodified when done.
644 All output done by BODY is inserted in that buffer by default.
645 The buffer is displayed in another window, but not selected.
646 The value of the last form in BODY is returned.
647 If BODY does not finish normally, the buffer BUFNAME is not displayed.
649 The hook `temp-buffer-setup-hook' is run before BODY,
650 with the buffer BUFNAME temporarily current.
651 The hook `temp-buffer-show-hook' is run after the buffer is displayed,
652 with the buffer temporarily current, and the window that was used
653 to display it temporarily selected.
655 If variable `temp-buffer-show-function' is non-nil, call it at the end
656 to get the buffer displayed instead of just displaying the non-selected
657 buffer and calling the hook. It gets one argument, the buffer to display.
659 usage: (with-output-to-temp-buffer BUFFNAME BODY ...) */)
665 int count
= SPECPDL_INDEX ();
666 Lisp_Object buf
, val
;
669 name
= Feval (Fcar (args
));
671 temp_output_buffer_setup (SDATA (name
));
672 buf
= Vstandard_output
;
675 val
= Fprogn (XCDR (args
));
678 temp_output_buffer_show (buf
);
681 return unbind_to (count
, val
);
685 static void print ();
686 static void print_preprocess ();
687 static void print_preprocess_string ();
688 static void print_object ();
690 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
691 doc
: /* Output a newline to stream PRINTCHARFUN.
692 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
694 Lisp_Object printcharfun
;
698 if (NILP (printcharfun
))
699 printcharfun
= Vstandard_output
;
706 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
707 doc
: /* Output the printed representation of OBJECT, any Lisp object.
708 Quoting characters are printed when needed to make output that `read'
709 can handle, whenever this is possible. For complex objects, the behavior
710 is controlled by `print-level' and `print-length', which see.
712 OBJECT is any of the Lisp data types: a number, a string, a symbol,
713 a list, a buffer, a window, a frame, etc.
715 A printed representation of an object is text which describes that object.
717 Optional argument PRINTCHARFUN is the output stream, which can be one
720 - a buffer, in which case output is inserted into that buffer at point;
721 - a marker, in which case output is inserted at marker's position;
722 - a function, in which case that function is called once for each
723 character of OBJECT's printed representation;
724 - a symbol, in which case that symbol's function definition is called; or
725 - t, in which case the output is displayed in the echo area.
727 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
729 (object
, printcharfun
)
730 Lisp_Object object
, printcharfun
;
734 #ifdef MAX_PRINT_CHARS
736 #endif /* MAX_PRINT_CHARS */
737 if (NILP (printcharfun
))
738 printcharfun
= Vstandard_output
;
740 print (object
, printcharfun
, 1);
745 /* a buffer which is used to hold output being built by prin1-to-string */
746 Lisp_Object Vprin1_to_string_buffer
;
748 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
749 doc
: /* Return a string containing the printed representation of OBJECT.
750 OBJECT can be any Lisp object. This function outputs quoting characters
751 when necessary to make output that `read' can handle, whenever possible,
752 unless the optional second argument NOESCAPE is non-nil.
754 OBJECT is any of the Lisp data types: a number, a string, a symbol,
755 a list, a buffer, a window, a frame, etc.
757 A printed representation of an object is text which describes that object. */)
759 Lisp_Object object
, noescape
;
761 Lisp_Object printcharfun
;
762 /* struct gcpro gcpro1, gcpro2; */
763 Lisp_Object save_deactivate_mark
;
764 int count
= specpdl_ptr
- specpdl
;
765 struct buffer
*previous
;
767 specbind (Qinhibit_modification_hooks
, Qt
);
772 /* Save and restore this--we are altering a buffer
773 but we don't want to deactivate the mark just for that.
774 No need for specbind, since errors deactivate the mark. */
775 save_deactivate_mark
= Vdeactivate_mark
;
776 /* GCPRO2 (object, save_deactivate_mark); */
779 printcharfun
= Vprin1_to_string_buffer
;
781 print (object
, printcharfun
, NILP (noescape
));
782 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
786 previous
= current_buffer
;
787 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
788 object
= Fbuffer_string ();
789 if (SBYTES (object
) == SCHARS (object
))
790 STRING_SET_UNIBYTE (object
);
792 /* Note that this won't make prepare_to_modify_buffer call
793 ask-user-about-supersession-threat because this buffer
794 does not visit a file. */
796 set_buffer_internal (previous
);
798 Vdeactivate_mark
= save_deactivate_mark
;
802 return unbind_to (count
, object
);
805 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
806 doc
: /* Output the printed representation of OBJECT, any Lisp object.
807 No quoting characters are used; no delimiters are printed around
808 the contents of strings.
810 OBJECT is any of the Lisp data types: a number, a string, a symbol,
811 a list, a buffer, a window, a frame, etc.
813 A printed representation of an object is text which describes that object.
815 Optional argument PRINTCHARFUN is the output stream, which can be one
818 - a buffer, in which case output is inserted into that buffer at point;
819 - a marker, in which case output is inserted at marker's position;
820 - a function, in which case that function is called once for each
821 character of OBJECT's printed representation;
822 - a symbol, in which case that symbol's function definition is called; or
823 - t, in which case the output is displayed in the echo area.
825 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
827 (object
, printcharfun
)
828 Lisp_Object object
, printcharfun
;
832 if (NILP (printcharfun
))
833 printcharfun
= Vstandard_output
;
835 print (object
, printcharfun
, 0);
840 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
841 doc
: /* Output the printed representation of OBJECT, with newlines around it.
842 Quoting characters are printed when needed to make output that `read'
843 can handle, whenever this is possible. For complex objects, the behavior
844 is controlled by `print-level' and `print-length', which see.
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
;
869 #ifdef MAX_PRINT_CHARS
871 max_print
= MAX_PRINT_CHARS
;
872 #endif /* MAX_PRINT_CHARS */
873 if (NILP (printcharfun
))
874 printcharfun
= Vstandard_output
;
878 print (object
, printcharfun
, 1);
881 #ifdef MAX_PRINT_CHARS
884 #endif /* MAX_PRINT_CHARS */
889 /* The subroutine object for external-debugging-output is kept here
890 for the convenience of the debugger. */
891 Lisp_Object Qexternal_debugging_output
;
893 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
894 doc
: /* Write CHARACTER to stderr.
895 You can call print while debugging emacs, and pass it this function
896 to make it write to the debugging output. */)
898 Lisp_Object character
;
900 CHECK_NUMBER (character
);
901 putc (XINT (character
), stderr
);
904 /* Send the output to a debugger (nothing happens if there isn't one). */
906 char buf
[2] = {(char) XINT (character
), '\0'};
907 OutputDebugString (buf
);
915 #if defined(GNU_LINUX)
917 /* This functionality is not vitally important in general, so we rely on
918 non-portable ability to use stderr as lvalue. */
920 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
922 FILE *initial_stderr_stream
= NULL
;
924 DEFUN ("redirect-debugging-output", Fredirect_debugging_output
, Sredirect_debugging_output
,
926 "FDebug output file: \nP",
927 doc
: /* Redirect debugging output (stderr stream) to file FILE.
928 If FILE is nil, reset target to the initial stderr stream.
929 Optional arg APPEND non-nil (interactively, with prefix arg) means
930 append to existing target file. */)
932 Lisp_Object file
, append
;
934 if (initial_stderr_stream
!= NULL
)
936 stderr
= initial_stderr_stream
;
937 initial_stderr_stream
= NULL
;
941 file
= Fexpand_file_name (file
, Qnil
);
942 initial_stderr_stream
= stderr
;
943 stderr
= fopen(SDATA (file
), NILP (append
) ? "w" : "a");
946 stderr
= initial_stderr_stream
;
947 initial_stderr_stream
= NULL
;
948 report_file_error ("Cannot open debugging output stream",
954 #endif /* GNU_LINUX */
957 /* This is the interface for debugging printing. */
963 Fprin1 (arg
, Qexternal_debugging_output
);
964 fprintf (stderr
, "\r\n");
967 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
969 doc
: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
970 See Info anchor `(elisp)Definition of signal' for some details on how this
971 error message is constructed. */)
975 struct buffer
*old
= current_buffer
;
979 /* If OBJ is (error STRING), just return STRING.
980 That is not only faster, it also avoids the need to allocate
981 space here when the error is due to memory full. */
982 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
983 && CONSP (XCDR (obj
))
984 && STRINGP (XCAR (XCDR (obj
)))
985 && NILP (XCDR (XCDR (obj
))))
986 return XCAR (XCDR (obj
));
988 print_error_message (obj
, Vprin1_to_string_buffer
, 0, Qnil
);
990 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
991 value
= Fbuffer_string ();
995 set_buffer_internal (old
);
1001 /* Print an error message for the error DATA onto Lisp output stream
1002 STREAM (suitable for the print functions). */
1005 print_error_message (data
, stream
, context
, caller
)
1006 Lisp_Object data
, stream
;
1010 Lisp_Object errname
, errmsg
, file_error
, tail
;
1011 struct gcpro gcpro1
;
1015 write_string_1 (context
, -1, stream
);
1017 /* If we know from where the error was signaled, show it in
1019 if (!NILP (caller
) && SYMBOLP (caller
))
1021 const char *name
= SDATA (SYMBOL_NAME (caller
));
1022 message_dolog (name
, strlen (name
), 0, 0);
1023 message_dolog (": ", 2, 0, 0);
1026 errname
= Fcar (data
);
1028 if (EQ (errname
, Qerror
))
1033 errmsg
= Fcar (data
);
1038 Lisp_Object error_conditions
;
1039 errmsg
= Fget (errname
, Qerror_message
);
1040 error_conditions
= Fget (errname
, Qerror_conditions
);
1041 file_error
= Fmemq (Qfile_error
, error_conditions
);
1044 /* Print an error message including the data items. */
1046 tail
= Fcdr_safe (data
);
1049 /* For file-error, make error message by concatenating
1050 all the data items. They are all strings. */
1051 if (!NILP (file_error
) && CONSP (tail
))
1052 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
1054 if (STRINGP (errmsg
))
1055 Fprinc (errmsg
, stream
);
1057 write_string_1 ("peculiar error", -1, stream
);
1059 for (i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
1063 write_string_1 (i
? ", " : ": ", 2, stream
);
1065 if (!NILP (file_error
) || EQ (errname
, Qend_of_file
))
1066 Fprinc (obj
, stream
);
1068 Fprin1 (obj
, stream
);
1077 * The buffer should be at least as large as the max string size of the
1078 * largest float, printed in the biggest notation. This is undoubtedly
1079 * 20d float_output_format, with the negative of the C-constant "HUGE"
1082 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1084 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1085 * case of -1e307 in 20d float_output_format. What is one to do (short of
1086 * re-writing _doprnt to be more sane)?
1091 float_to_string (buf
, data
)
1098 /* Check for plus infinity in a way that won't lose
1099 if there is no plus infinity. */
1100 if (data
== data
/ 2 && data
> 1.0)
1102 strcpy (buf
, "1.0e+INF");
1105 /* Likewise for minus infinity. */
1106 if (data
== data
/ 2 && data
< -1.0)
1108 strcpy (buf
, "-1.0e+INF");
1111 /* Check for NaN in a way that won't fail if there are no NaNs. */
1112 if (! (data
* 0.0 >= 0.0))
1114 /* Prepend "-" if the NaN's sign bit is negative.
1115 The sign bit of a double is the bit that is 1 in -0.0. */
1117 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
1119 u_minus_zero
.d
= - 0.0;
1120 for (i
= 0; i
< sizeof (double); i
++)
1121 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1127 strcpy (buf
, "0.0e+NaN");
1131 if (NILP (Vfloat_output_format
)
1132 || !STRINGP (Vfloat_output_format
))
1135 /* Generate the fewest number of digits that represent the
1136 floating point value without losing information.
1137 The following method is simple but a bit slow.
1138 For ideas about speeding things up, please see:
1140 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1141 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1143 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1144 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1146 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1148 sprintf (buf
, "%.*g", width
, data
);
1149 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1151 else /* oink oink */
1153 /* Check that the spec we have is fully valid.
1154 This means not only valid for printf,
1155 but meant for floats, and reasonable. */
1156 cp
= SDATA (Vfloat_output_format
);
1165 /* Check the width specification. */
1167 if ('0' <= *cp
&& *cp
<= '9')
1171 width
= (width
* 10) + (*cp
++ - '0');
1172 while (*cp
>= '0' && *cp
<= '9');
1174 /* A precision of zero is valid only for %f. */
1176 || (width
== 0 && *cp
!= 'f'))
1180 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1186 sprintf (buf
, SDATA (Vfloat_output_format
), data
);
1189 /* Make sure there is a decimal point with digit after, or an
1190 exponent, so that the value is readable as a float. But don't do
1191 this with "%.0f"; it's valid for that not to produce a decimal
1192 point. Note that width can be 0 only for %.0f. */
1195 for (cp
= buf
; *cp
; cp
++)
1196 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1199 if (*cp
== '.' && cp
[1] == 0)
1216 print (obj
, printcharfun
, escapeflag
)
1218 register Lisp_Object printcharfun
;
1222 old_backquote_output
= 0;
1224 /* Reset print_number_index and Vprint_number_table only when
1225 the variable Vprint_continuous_numbering is nil. Otherwise,
1226 the values of these variables will be kept between several
1228 if (NILP (Vprint_continuous_numbering
))
1230 print_number_index
= 0;
1231 Vprint_number_table
= Qnil
;
1234 /* Construct Vprint_number_table for print-gensym and print-circle. */
1235 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1237 int i
, start
, index
;
1238 start
= index
= print_number_index
;
1239 /* Construct Vprint_number_table.
1240 This increments print_number_index for the objects added. */
1241 print_preprocess (obj
);
1243 /* Remove unnecessary objects, which appear only once in OBJ;
1244 that is, whose status is Qnil. Compactify the necessary objects. */
1245 for (i
= start
; i
< print_number_index
; i
++)
1246 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1248 PRINT_NUMBER_OBJECT (Vprint_number_table
, index
)
1249 = PRINT_NUMBER_OBJECT (Vprint_number_table
, i
);
1253 /* Clear out objects outside the active part of the table. */
1254 for (i
= index
; i
< print_number_index
; i
++)
1255 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
) = Qnil
;
1257 /* Reset the status field for the next print step. Now this
1258 field means whether the object has already been printed. */
1259 for (i
= start
; i
< print_number_index
; i
++)
1260 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qnil
;
1262 print_number_index
= index
;
1265 print_object (obj
, printcharfun
, escapeflag
);
1268 /* Construct Vprint_number_table according to the structure of OBJ.
1269 OBJ itself and all its elements will be added to Vprint_number_table
1270 recursively if it is a list, vector, compiled function, char-table,
1271 string (its text properties will be traced), or a symbol that has
1272 no obarray (this is for the print-gensym feature).
1273 The status fields of Vprint_number_table mean whether each object appears
1274 more than once in OBJ: Qnil at the first time, and Qt after that . */
1276 print_preprocess (obj
)
1283 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1284 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1285 || (! NILP (Vprint_gensym
)
1287 && !SYMBOL_INTERNED_P (obj
)))
1289 /* In case print-circle is nil and print-gensym is t,
1290 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1291 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1293 for (i
= 0; i
< print_number_index
; i
++)
1294 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1296 /* OBJ appears more than once. Let's remember that. */
1297 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1301 /* OBJ is not yet recorded. Let's add to the table. */
1302 if (print_number_index
== 0)
1304 /* Initialize the table. */
1305 Vprint_number_table
= Fmake_vector (make_number (40), Qnil
);
1307 else if (XVECTOR (Vprint_number_table
)->size
== print_number_index
* 2)
1309 /* Reallocate the table. */
1310 int i
= print_number_index
* 4;
1311 Lisp_Object old_table
= Vprint_number_table
;
1312 Vprint_number_table
= Fmake_vector (make_number (i
), Qnil
);
1313 for (i
= 0; i
< print_number_index
; i
++)
1315 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
)
1316 = PRINT_NUMBER_OBJECT (old_table
, i
);
1317 PRINT_NUMBER_STATUS (Vprint_number_table
, i
)
1318 = PRINT_NUMBER_STATUS (old_table
, i
);
1321 PRINT_NUMBER_OBJECT (Vprint_number_table
, print_number_index
) = obj
;
1322 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1323 always print the gensym with a number. This is a special for
1324 the lisp function byte-compile-output-docform. */
1325 if (!NILP (Vprint_continuous_numbering
)
1327 && !SYMBOL_INTERNED_P (obj
))
1328 PRINT_NUMBER_STATUS (Vprint_number_table
, print_number_index
) = Qt
;
1329 print_number_index
++;
1332 switch (XGCTYPE (obj
))
1335 /* A string may have text properties, which can be circular. */
1336 traverse_intervals_noorder (STRING_INTERVALS (obj
),
1337 print_preprocess_string
, Qnil
);
1341 print_preprocess (XCAR (obj
));
1345 case Lisp_Vectorlike
:
1346 size
= XVECTOR (obj
)->size
;
1347 if (size
& PSEUDOVECTOR_FLAG
)
1348 size
&= PSEUDOVECTOR_SIZE_MASK
;
1349 for (i
= 0; i
< size
; i
++)
1350 print_preprocess (XVECTOR (obj
)->contents
[i
]);
1360 print_preprocess_string (interval
, arg
)
1364 print_preprocess (interval
->plist
);
1368 print_object (obj
, printcharfun
, escapeflag
)
1370 register Lisp_Object printcharfun
;
1377 /* Detect circularities and truncate them. */
1378 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1379 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1380 || (! NILP (Vprint_gensym
)
1382 && !SYMBOL_INTERNED_P (obj
)))
1384 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1386 /* Simple but incomplete way. */
1388 for (i
= 0; i
< print_depth
; i
++)
1389 if (EQ (obj
, being_printed
[i
]))
1391 sprintf (buf
, "#%d", i
);
1392 strout (buf
, -1, -1, printcharfun
, 0);
1395 being_printed
[print_depth
] = obj
;
1399 /* With the print-circle feature. */
1401 for (i
= 0; i
< print_number_index
; i
++)
1402 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1404 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1406 /* Add a prefix #n= if OBJ has not yet been printed;
1407 that is, its status field is nil. */
1408 sprintf (buf
, "#%d=", i
+ 1);
1409 strout (buf
, -1, -1, printcharfun
, 0);
1410 /* OBJ is going to be printed. Set the status to t. */
1411 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1416 /* Just print #n# if OBJ has already been printed. */
1417 sprintf (buf
, "#%d#", i
+ 1);
1418 strout (buf
, -1, -1, printcharfun
, 0);
1427 if (print_depth
> PRINT_CIRCLE
)
1428 error ("Apparently circular structure being printed");
1429 #ifdef MAX_PRINT_CHARS
1430 if (max_print
&& print_chars
> max_print
)
1435 #endif /* MAX_PRINT_CHARS */
1437 switch (XGCTYPE (obj
))
1440 if (sizeof (int) == sizeof (EMACS_INT
))
1441 sprintf (buf
, "%d", XINT (obj
));
1442 else if (sizeof (long) == sizeof (EMACS_INT
))
1443 sprintf (buf
, "%ld", (long) XINT (obj
));
1446 strout (buf
, -1, -1, printcharfun
, 0);
1451 char pigbuf
[350]; /* see comments in float_to_string */
1453 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1454 strout (pigbuf
, -1, -1, printcharfun
, 0);
1460 print_string (obj
, printcharfun
);
1463 register int i
, i_byte
;
1464 struct gcpro gcpro1
;
1467 /* 1 means we must ensure that the next character we output
1468 cannot be taken as part of a hex character escape. */
1469 int need_nonhex
= 0;
1470 int multibyte
= STRING_MULTIBYTE (obj
);
1474 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1482 size_byte
= SBYTES (obj
);
1484 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1486 /* Here, we must convert each multi-byte form to the
1487 corresponding character code before handing it to PRINTCHAR. */
1493 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
,
1494 size_byte
- i_byte
, len
);
1495 if (CHAR_VALID_P (c
, 0))
1505 if (c
== '\n' && print_escape_newlines
)
1510 else if (c
== '\f' && print_escape_newlines
)
1516 && ! ASCII_BYTE_P (c
)
1517 && (SINGLE_BYTE_CHAR_P (c
) || print_escape_multibyte
))
1519 /* When multibyte is disabled,
1520 print multibyte string chars using hex escapes.
1521 For a char code that could be in a unibyte string,
1522 when found in a multibyte string, always use a hex escape
1523 so it reads back as multibyte. */
1524 unsigned char outbuf
[50];
1525 sprintf (outbuf
, "\\x%x", c
);
1526 strout (outbuf
, -1, -1, printcharfun
, 0);
1529 else if (! multibyte
1530 && SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1531 && print_escape_nonascii
)
1533 /* When printing in a multibyte buffer
1534 or when explicitly requested,
1535 print single-byte non-ASCII string chars
1536 using octal escapes. */
1537 unsigned char outbuf
[5];
1538 sprintf (outbuf
, "\\%03o", c
);
1539 strout (outbuf
, -1, -1, printcharfun
, 0);
1543 /* If we just had a hex escape, and this character
1544 could be taken as part of it,
1545 output `\ ' to prevent that. */
1549 if ((c
>= 'a' && c
<= 'f')
1550 || (c
>= 'A' && c
<= 'F')
1551 || (c
>= '0' && c
<= '9'))
1552 strout ("\\ ", -1, -1, printcharfun
, 0);
1555 if (c
== '\"' || c
== '\\')
1562 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1564 traverse_intervals (STRING_INTERVALS (obj
),
1565 0, print_interval
, printcharfun
);
1575 register int confusing
;
1576 register unsigned char *p
= SDATA (SYMBOL_NAME (obj
));
1577 register unsigned char *end
= p
+ SBYTES (SYMBOL_NAME (obj
));
1579 int i
, i_byte
, size_byte
;
1582 name
= SYMBOL_NAME (obj
);
1584 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1587 /* If symbol name begins with a digit, and ends with a digit,
1588 and contains nothing but digits and `e', it could be treated
1589 as a number. So set CONFUSING.
1591 Symbols that contain periods could also be taken as numbers,
1592 but periods are always escaped, so we don't have to worry
1594 else if (*p
>= '0' && *p
<= '9'
1595 && end
[-1] >= '0' && end
[-1] <= '9')
1597 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1598 /* Needed for \2e10. */
1601 confusing
= (end
== p
);
1606 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1612 size_byte
= SBYTES (name
);
1614 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1616 /* Here, we must convert each multi-byte form to the
1617 corresponding character code before handing it to PRINTCHAR. */
1618 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1623 if (c
== '\"' || c
== '\\' || c
== '\''
1624 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1625 || c
== ',' || c
=='.' || c
== '`'
1626 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1628 PRINTCHAR ('\\'), confusing
= 0;
1636 /* If deeper than spec'd depth, print placeholder. */
1637 if (INTEGERP (Vprint_level
)
1638 && print_depth
> XINT (Vprint_level
))
1639 strout ("...", -1, -1, printcharfun
, 0);
1640 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1641 && (EQ (XCAR (obj
), Qquote
)))
1644 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1646 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1647 && (EQ (XCAR (obj
), Qfunction
)))
1651 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1653 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1654 && ! old_backquote_output
1655 && ((EQ (XCAR (obj
), Qbackquote
)
1656 || EQ (XCAR (obj
), Qcomma
)
1657 || EQ (XCAR (obj
), Qcomma_at
)
1658 || EQ (XCAR (obj
), Qcomma_dot
))))
1660 print_object (XCAR (obj
), printcharfun
, 0);
1661 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1667 /* If the first element is a backquote form,
1668 print it old-style so it won't be misunderstood. */
1669 if (print_quoted
&& CONSP (XCAR (obj
))
1670 && CONSP (XCDR (XCAR (obj
)))
1671 && NILP (XCDR (XCDR (XCAR (obj
))))
1672 && EQ (XCAR (XCAR (obj
)), Qbackquote
))
1678 print_object (Qbackquote
, printcharfun
, 0);
1681 ++old_backquote_output
;
1682 print_object (XCAR (XCDR (tem
)), printcharfun
, 0);
1683 --old_backquote_output
;
1690 int print_length
, i
;
1691 Lisp_Object halftail
= obj
;
1693 /* Negative values of print-length are invalid in CL.
1694 Treat them like nil, as CMUCL does. */
1695 if (NATNUMP (Vprint_length
))
1696 print_length
= XFASTINT (Vprint_length
);
1703 /* Detect circular list. */
1704 if (NILP (Vprint_circle
))
1706 /* Simple but imcomplete way. */
1707 if (i
!= 0 && EQ (obj
, halftail
))
1709 sprintf (buf
, " . #%d", i
/ 2);
1710 strout (buf
, -1, -1, printcharfun
, 0);
1716 /* With the print-circle feature. */
1720 for (i
= 0; i
< print_number_index
; i
++)
1721 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
),
1724 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1726 strout (" . ", 3, 3, printcharfun
, 0);
1727 print_object (obj
, printcharfun
, escapeflag
);
1731 sprintf (buf
, " . #%d#", i
+ 1);
1732 strout (buf
, -1, -1, printcharfun
, 0);
1742 if (print_length
&& i
> print_length
)
1744 strout ("...", 3, 3, printcharfun
, 0);
1748 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1752 halftail
= XCDR (halftail
);
1756 /* OBJ non-nil here means it's the end of a dotted list. */
1759 strout (" . ", 3, 3, printcharfun
, 0);
1760 print_object (obj
, printcharfun
, escapeflag
);
1768 case Lisp_Vectorlike
:
1773 strout ("#<process ", -1, -1, printcharfun
, 0);
1774 print_string (XPROCESS (obj
)->name
, printcharfun
);
1778 print_string (XPROCESS (obj
)->name
, printcharfun
);
1780 else if (BOOL_VECTOR_P (obj
))
1783 register unsigned char c
;
1784 struct gcpro gcpro1
;
1786 = ((XBOOL_VECTOR (obj
)->size
+ BOOL_VECTOR_BITS_PER_CHAR
- 1)
1787 / BOOL_VECTOR_BITS_PER_CHAR
);
1793 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1794 strout (buf
, -1, -1, printcharfun
, 0);
1797 /* Don't print more characters than the specified maximum.
1798 Negative values of print-length are invalid. Treat them
1799 like a print-length of nil. */
1800 if (NATNUMP (Vprint_length
)
1801 && XFASTINT (Vprint_length
) < size_in_chars
)
1802 size_in_chars
= XFASTINT (Vprint_length
);
1804 for (i
= 0; i
< size_in_chars
; i
++)
1807 c
= XBOOL_VECTOR (obj
)->data
[i
];
1808 if (c
== '\n' && print_escape_newlines
)
1813 else if (c
== '\f' && print_escape_newlines
)
1818 else if (c
> '\177')
1820 /* Use octal escapes to avoid encoding issues. */
1822 PRINTCHAR ('0' + ((c
>> 6) & 3));
1823 PRINTCHAR ('0' + ((c
>> 3) & 7));
1824 PRINTCHAR ('0' + (c
& 7));
1828 if (c
== '\"' || c
== '\\')
1837 else if (SUBRP (obj
))
1839 strout ("#<subr ", -1, -1, printcharfun
, 0);
1840 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1843 else if (WINDOWP (obj
))
1845 strout ("#<window ", -1, -1, printcharfun
, 0);
1846 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1847 strout (buf
, -1, -1, printcharfun
, 0);
1848 if (!NILP (XWINDOW (obj
)->buffer
))
1850 strout (" on ", -1, -1, printcharfun
, 0);
1851 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1855 else if (HASH_TABLE_P (obj
))
1857 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1858 strout ("#<hash-table", -1, -1, printcharfun
, 0);
1859 if (SYMBOLP (h
->test
))
1863 strout (SDATA (SYMBOL_NAME (h
->test
)), -1, -1, printcharfun
, 0);
1865 strout (SDATA (SYMBOL_NAME (h
->weak
)), -1, -1, printcharfun
, 0);
1867 sprintf (buf
, "%d/%d", XFASTINT (h
->count
),
1868 XVECTOR (h
->next
)->size
);
1869 strout (buf
, -1, -1, printcharfun
, 0);
1871 sprintf (buf
, " 0x%lx", (unsigned long) h
);
1872 strout (buf
, -1, -1, printcharfun
, 0);
1875 else if (BUFFERP (obj
))
1877 if (NILP (XBUFFER (obj
)->name
))
1878 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1879 else if (escapeflag
)
1881 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1882 print_string (XBUFFER (obj
)->name
, printcharfun
);
1886 print_string (XBUFFER (obj
)->name
, printcharfun
);
1888 else if (WINDOW_CONFIGURATIONP (obj
))
1890 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1892 else if (FRAMEP (obj
))
1894 strout ((FRAME_LIVE_P (XFRAME (obj
))
1895 ? "#<frame " : "#<dead frame "),
1896 -1, -1, printcharfun
, 0);
1897 print_string (XFRAME (obj
)->name
, printcharfun
);
1898 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
1899 strout (buf
, -1, -1, printcharfun
, 0);
1904 EMACS_INT size
= XVECTOR (obj
)->size
;
1905 if (COMPILEDP (obj
))
1908 size
&= PSEUDOVECTOR_SIZE_MASK
;
1910 if (CHAR_TABLE_P (obj
))
1912 /* We print a char-table as if it were a vector,
1913 lumping the parent and default slots in with the
1914 character slots. But we add #^ as a prefix. */
1917 if (SUB_CHAR_TABLE_P (obj
))
1919 size
&= PSEUDOVECTOR_SIZE_MASK
;
1921 if (size
& PSEUDOVECTOR_FLAG
)
1927 register Lisp_Object tem
;
1928 int real_size
= size
;
1930 /* Don't print more elements than the specified maximum. */
1931 if (NATNUMP (Vprint_length
)
1932 && XFASTINT (Vprint_length
) < size
)
1933 size
= XFASTINT (Vprint_length
);
1935 for (i
= 0; i
< size
; i
++)
1937 if (i
) PRINTCHAR (' ');
1938 tem
= XVECTOR (obj
)->contents
[i
];
1939 print_object (tem
, printcharfun
, escapeflag
);
1941 if (size
< real_size
)
1942 strout (" ...", 4, 4, printcharfun
, 0);
1949 switch (XMISCTYPE (obj
))
1951 case Lisp_Misc_Marker
:
1952 strout ("#<marker ", -1, -1, printcharfun
, 0);
1953 /* Do you think this is necessary? */
1954 if (XMARKER (obj
)->insertion_type
!= 0)
1955 strout ("(moves after insertion) ", -1, -1, printcharfun
, 0);
1956 if (!(XMARKER (obj
)->buffer
))
1957 strout ("in no buffer", -1, -1, printcharfun
, 0);
1960 sprintf (buf
, "at %d", marker_position (obj
));
1961 strout (buf
, -1, -1, printcharfun
, 0);
1962 strout (" in ", -1, -1, printcharfun
, 0);
1963 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1968 case Lisp_Misc_Overlay
:
1969 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1970 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1971 strout ("in no buffer", -1, -1, printcharfun
, 0);
1974 sprintf (buf
, "from %d to %d in ",
1975 marker_position (OVERLAY_START (obj
)),
1976 marker_position (OVERLAY_END (obj
)));
1977 strout (buf
, -1, -1, printcharfun
, 0);
1978 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1984 /* Remaining cases shouldn't happen in normal usage, but let's print
1985 them anyway for the benefit of the debugger. */
1986 case Lisp_Misc_Free
:
1987 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1990 case Lisp_Misc_Intfwd
:
1991 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1992 strout (buf
, -1, -1, printcharfun
, 0);
1995 case Lisp_Misc_Boolfwd
:
1996 sprintf (buf
, "#<boolfwd to %s>",
1997 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1998 strout (buf
, -1, -1, printcharfun
, 0);
2001 case Lisp_Misc_Objfwd
:
2002 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
2003 print_object (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
2007 case Lisp_Misc_Buffer_Objfwd
:
2008 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
2009 print_object (PER_BUFFER_VALUE (current_buffer
,
2010 XBUFFER_OBJFWD (obj
)->offset
),
2011 printcharfun
, escapeflag
);
2015 case Lisp_Misc_Kboard_Objfwd
:
2016 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
2017 print_object (*(Lisp_Object
*)((char *) current_kboard
2018 + XKBOARD_OBJFWD (obj
)->offset
),
2019 printcharfun
, escapeflag
);
2023 case Lisp_Misc_Buffer_Local_Value
:
2024 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
2025 goto do_buffer_local
;
2026 case Lisp_Misc_Some_Buffer_Local_Value
:
2027 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
2029 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
2030 print_object (XBUFFER_LOCAL_VALUE (obj
)->realvalue
,
2031 printcharfun
, escapeflag
);
2032 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
2033 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
2035 strout ("[buffer] ", -1, -1, printcharfun
, 0);
2036 print_object (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
2037 printcharfun
, escapeflag
);
2038 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
2040 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
2041 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
2043 strout ("[frame] ", -1, -1, printcharfun
, 0);
2044 print_object (XBUFFER_LOCAL_VALUE (obj
)->frame
,
2045 printcharfun
, escapeflag
);
2047 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
2048 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2049 printcharfun
, escapeflag
);
2050 strout ("[default-value] ", -1, -1, printcharfun
, 0);
2051 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2052 printcharfun
, escapeflag
);
2064 /* We're in trouble if this happens!
2065 Probably should just abort () */
2066 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
2068 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
2069 else if (VECTORLIKEP (obj
))
2070 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
2072 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
2073 strout (buf
, -1, -1, printcharfun
, 0);
2074 strout (" Save your buffers immediately and please report this bug>",
2075 -1, -1, printcharfun
, 0);
2083 /* Print a description of INTERVAL using PRINTCHARFUN.
2084 This is part of printing a string that has text properties. */
2087 print_interval (interval
, printcharfun
)
2089 Lisp_Object printcharfun
;
2092 print_object (make_number (interval
->position
), printcharfun
, 1);
2094 print_object (make_number (interval
->position
+ LENGTH (interval
)),
2097 print_object (interval
->plist
, printcharfun
, 1);
2104 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
2105 staticpro (&Qtemp_buffer_setup_hook
);
2107 DEFVAR_LISP ("standard-output", &Vstandard_output
,
2108 doc
: /* Output stream `print' uses by default for outputting a character.
2109 This may be any function of one argument.
2110 It may also be a buffer (output is inserted before point)
2111 or a marker (output is inserted and the marker is advanced)
2112 or the symbol t (output appears in the echo area). */);
2113 Vstandard_output
= Qt
;
2114 Qstandard_output
= intern ("standard-output");
2115 staticpro (&Qstandard_output
);
2117 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
2118 doc
: /* The format descriptor string used to print floats.
2119 This is a %-spec like those accepted by `printf' in C,
2120 but with some restrictions. It must start with the two characters `%.'.
2121 After that comes an integer precision specification,
2122 and then a letter which controls the format.
2123 The letters allowed are `e', `f' and `g'.
2124 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2125 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2126 Use `g' to choose the shorter of those two formats for the number at hand.
2127 The precision in any of these cases is the number of digits following
2128 the decimal point. With `f', a precision of 0 means to omit the
2129 decimal point. 0 is not allowed with `e' or `g'.
2131 A value of nil means to use the shortest notation
2132 that represents the number without losing information. */);
2133 Vfloat_output_format
= Qnil
;
2134 Qfloat_output_format
= intern ("float-output-format");
2135 staticpro (&Qfloat_output_format
);
2137 DEFVAR_LISP ("print-length", &Vprint_length
,
2138 doc
: /* Maximum length of list to print before abbreviating.
2139 A value of nil means no limit. See also `eval-expression-print-length'. */);
2140 Vprint_length
= Qnil
;
2142 DEFVAR_LISP ("print-level", &Vprint_level
,
2143 doc
: /* Maximum depth of list nesting to print before abbreviating.
2144 A value of nil means no limit. See also `eval-expression-print-level'. */);
2145 Vprint_level
= Qnil
;
2147 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
2148 doc
: /* Non-nil means print newlines in strings as `\\n'.
2149 Also print formfeeds as `\\f'. */);
2150 print_escape_newlines
= 0;
2152 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
2153 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2154 \(OOO is the octal representation of the character code.)
2155 Only single-byte characters are affected, and only in `prin1'.
2156 When the output goes in a multibyte buffer, this feature is
2157 enabled regardless of the value of the variable. */);
2158 print_escape_nonascii
= 0;
2160 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
2161 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2162 \(XXXX is the hex representation of the character code.)
2163 This affects only `prin1'. */);
2164 print_escape_multibyte
= 0;
2166 DEFVAR_BOOL ("print-quoted", &print_quoted
,
2167 doc
: /* Non-nil means print quoted forms with reader syntax.
2168 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2169 forms print as in the new syntax. */);
2172 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
2173 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2174 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2175 When the uninterned symbol appears within a recursive data structure,
2176 and the symbol appears more than once, in addition use the #N# and #N=
2177 constructs as needed, so that multiple references to the same symbol are
2178 shared once again when the text is read back. */);
2179 Vprint_gensym
= Qnil
;
2181 DEFVAR_LISP ("print-circle", &Vprint_circle
,
2182 doc
: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2183 If nil, printing proceeds recursively and may lead to
2184 `max-lisp-eval-depth' being exceeded or an error may occur:
2185 \"Apparently circular structure being printed.\" Also see
2186 `print-length' and `print-level'.
2187 If non-nil, shared substructures anywhere in the structure are printed
2188 with `#N=' before the first occurrence (in the order of the print
2189 representation) and `#N#' in place of each subsequent occurrence,
2190 where N is a positive decimal integer. */);
2191 Vprint_circle
= Qnil
;
2193 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
2194 doc
: /* *Non-nil means number continuously across print calls.
2195 This affects the numbers printed for #N= labels and #M# references.
2196 See also `print-circle', `print-gensym', and `print-number-table'.
2197 This variable should not be set with `setq'; bind it with a `let' instead. */);
2198 Vprint_continuous_numbering
= Qnil
;
2200 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
2201 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2202 The Lisp printer uses this vector to detect Lisp objects referenced more
2205 When you bind `print-continuous-numbering' to t, you should probably
2206 also bind `print-number-table' to nil. This ensures that the value of
2207 `print-number-table' can be garbage-collected once the printing is
2208 done. If all elements of `print-number-table' are nil, it means that
2209 the printing done so far has not found any shared structure or objects
2210 that need to be recorded in the table. */);
2211 Vprint_number_table
= Qnil
;
2213 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2214 staticpro (&Vprin1_to_string_buffer
);
2217 defsubr (&Sprin1_to_string
);
2218 defsubr (&Serror_message_string
);
2222 defsubr (&Swrite_char
);
2223 defsubr (&Sexternal_debugging_output
);
2224 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2225 defsubr (&Sredirect_debugging_output
);
2228 Qexternal_debugging_output
= intern ("external-debugging-output");
2229 staticpro (&Qexternal_debugging_output
);
2231 Qprint_escape_newlines
= intern ("print-escape-newlines");
2232 staticpro (&Qprint_escape_newlines
);
2234 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
2235 staticpro (&Qprint_escape_multibyte
);
2237 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
2238 staticpro (&Qprint_escape_nonascii
);
2240 defsubr (&Swith_output_to_temp_buffer
);
2243 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2244 (do not change this comment) */