1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001
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 /* Detect most circularities to print finite output. */
95 #define PRINT_CIRCLE 200
96 Lisp_Object being_printed
[PRINT_CIRCLE
];
98 /* When printing into a buffer, first we put the text in this
99 block, then insert it all at once. */
102 /* Size allocated in print_buffer. */
103 int print_buffer_size
;
104 /* Chars stored in print_buffer. */
105 int print_buffer_pos
;
106 /* Bytes stored in print_buffer. */
107 int print_buffer_pos_byte
;
109 /* Maximum length of list to print in full; noninteger means
110 effectively infinity */
112 Lisp_Object Vprint_length
;
114 /* Maximum depth of list to print in full; noninteger means
115 effectively infinity. */
117 Lisp_Object Vprint_level
;
119 /* Nonzero means print newlines in strings as \n. */
121 int print_escape_newlines
;
123 /* Nonzero means to print single-byte non-ascii characters in strings as
126 int print_escape_nonascii
;
128 /* Nonzero means to print multibyte characters in strings as hex escapes. */
130 int print_escape_multibyte
;
132 Lisp_Object Qprint_escape_newlines
;
133 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
135 /* Nonzero means print (quote foo) forms as 'foo, etc. */
139 /* Non-nil means print #: before uninterned symbols. */
141 Lisp_Object Vprint_gensym
;
143 /* Non-nil means print recursive structures using #n= and #n# syntax. */
145 Lisp_Object Vprint_circle
;
147 /* Non-nil means keep continuous number for #n= and #n# syntax
148 between several print functions. */
150 Lisp_Object Vprint_continuous_numbering
;
152 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
153 where OBJn are objects going to be printed, and STATn are their status,
154 which may be different meanings during process. See the comments of
155 the functions print and print_preprocess for details.
156 print_number_index keeps the last position the next object should be added,
157 twice of which is the actual vector position in Vprint_number_table. */
158 int print_number_index
;
159 Lisp_Object Vprint_number_table
;
161 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
162 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
163 See the comment of the variable Vprint_number_table. */
164 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
165 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
167 /* Nonzero means print newline to stdout before next minibuffer message.
168 Defined in xdisp.c */
170 extern int noninteractive_need_newline
;
172 extern int minibuffer_auto_raise
;
174 #ifdef MAX_PRINT_CHARS
175 static int print_chars
;
176 static int max_print
;
177 #endif /* MAX_PRINT_CHARS */
179 void print_interval ();
182 /* Low level output routines for characters and strings */
184 /* Lisp functions to do output using a stream
185 must have the stream in a variable called printcharfun
186 and must start with PRINTPREPARE, end with PRINTFINISH,
187 and use PRINTDECLARE to declare common variables.
188 Use PRINTCHAR to output one character,
189 or call strout to output a block of characters. */
191 #define PRINTDECLARE \
192 struct buffer *old = current_buffer; \
193 int old_point = -1, start_point = -1; \
194 int old_point_byte = -1, start_point_byte = -1; \
195 int specpdl_count = specpdl_ptr - specpdl; \
196 int free_print_buffer = 0; \
197 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
200 #define PRINTPREPARE \
201 original = printcharfun; \
202 if (NILP (printcharfun)) printcharfun = Qt; \
203 if (BUFFERP (printcharfun)) \
205 if (XBUFFER (printcharfun) != current_buffer) \
206 Fset_buffer (printcharfun); \
207 printcharfun = Qnil; \
209 if (MARKERP (printcharfun)) \
211 if (!(XMARKER (original)->buffer)) \
212 error ("Marker does not point anywhere"); \
213 if (XMARKER (original)->buffer != current_buffer) \
214 set_buffer_internal (XMARKER (original)->buffer); \
216 old_point_byte = PT_BYTE; \
217 SET_PT_BOTH (marker_position (printcharfun), \
218 marker_byte_position (printcharfun)); \
220 start_point_byte = PT_BYTE; \
221 printcharfun = Qnil; \
223 if (NILP (printcharfun)) \
225 Lisp_Object string; \
226 if (NILP (current_buffer->enable_multibyte_characters) \
227 && ! print_escape_multibyte) \
228 specbind (Qprint_escape_multibyte, Qt); \
229 if (! NILP (current_buffer->enable_multibyte_characters) \
230 && ! print_escape_nonascii) \
231 specbind (Qprint_escape_nonascii, Qt); \
232 if (print_buffer != 0) \
234 string = make_string_from_bytes (print_buffer, \
236 print_buffer_pos_byte); \
237 record_unwind_protect (print_unwind, string); \
241 print_buffer_size = 1000; \
242 print_buffer = (char *) xmalloc (print_buffer_size); \
243 free_print_buffer = 1; \
245 print_buffer_pos = 0; \
246 print_buffer_pos_byte = 0; \
248 if (EQ (printcharfun, Qt) && ! noninteractive) \
249 setup_echo_area_for_printing (multibyte);
251 #define PRINTFINISH \
252 if (NILP (printcharfun)) \
254 if (print_buffer_pos != print_buffer_pos_byte \
255 && NILP (current_buffer->enable_multibyte_characters)) \
257 unsigned char *temp \
258 = (unsigned char *) alloca (print_buffer_pos + 1); \
259 copy_text (print_buffer, temp, print_buffer_pos_byte, \
261 insert_1_both (temp, print_buffer_pos, \
262 print_buffer_pos, 0, 1, 0); \
265 insert_1_both (print_buffer, print_buffer_pos, \
266 print_buffer_pos_byte, 0, 1, 0); \
268 if (free_print_buffer) \
270 xfree (print_buffer); \
273 unbind_to (specpdl_count, Qnil); \
274 if (MARKERP (original)) \
275 set_marker_both (original, Qnil, PT, PT_BYTE); \
276 if (old_point >= 0) \
277 SET_PT_BOTH (old_point + (old_point >= start_point \
278 ? PT - start_point : 0), \
279 old_point_byte + (old_point_byte >= start_point_byte \
280 ? PT_BYTE - start_point_byte : 0)); \
281 if (old != current_buffer) \
282 set_buffer_internal (old);
284 #define PRINTCHAR(ch) printchar (ch, printcharfun)
286 /* This is used to restore the saved contents of print_buffer
287 when there is a recursive call to print. */
290 print_unwind (saved_text
)
291 Lisp_Object saved_text
;
293 bcopy (XSTRING (saved_text
)->data
, print_buffer
, XSTRING (saved_text
)->size
);
298 /* Print character CH using method FUN. FUN nil means print to
299 print_buffer. FUN t means print to echo area or stdout if
300 non-interactive. If FUN is neither nil nor t, call FUN with CH as
308 #ifdef MAX_PRINT_CHARS
311 #endif /* MAX_PRINT_CHARS */
313 if (!NILP (fun
) && !EQ (fun
, Qt
))
314 call1 (fun
, make_number (ch
));
317 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
318 int len
= CHAR_STRING (ch
, str
);
324 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
325 print_buffer
= (char *) xrealloc (print_buffer
,
326 print_buffer_size
*= 2);
327 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
328 print_buffer_pos
+= 1;
329 print_buffer_pos_byte
+= len
;
331 else if (noninteractive
)
333 fwrite (str
, 1, len
, stdout
);
334 noninteractive_need_newline
= 1;
339 = !NILP (current_buffer
->enable_multibyte_characters
);
341 setup_echo_area_for_printing (multibyte_p
);
343 message_dolog (str
, len
, 0, multibyte_p
);
349 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
350 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
351 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
352 print_buffer. PRINTCHARFUN t means output to the echo area or to
353 stdout if non-interactive. If neither nil nor t, call Lisp
354 function PRINTCHARFUN for each character printed. MULTIBYTE
355 non-zero means PTR contains multibyte characters. */
358 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
361 Lisp_Object printcharfun
;
365 size_byte
= size
= strlen (ptr
);
367 if (NILP (printcharfun
))
369 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
371 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
372 print_buffer
= (char *) xrealloc (print_buffer
,
375 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
376 print_buffer_pos
+= size
;
377 print_buffer_pos_byte
+= size_byte
;
379 #ifdef MAX_PRINT_CHARS
382 #endif /* MAX_PRINT_CHARS */
384 else if (noninteractive
&& EQ (printcharfun
, Qt
))
386 fwrite (ptr
, 1, size_byte
, stdout
);
387 noninteractive_need_newline
= 1;
389 else if (EQ (printcharfun
, Qt
))
391 /* Output to echo area. We're trying to avoid a little overhead
392 here, that's the reason we don't call printchar to do the
396 = !NILP (current_buffer
->enable_multibyte_characters
);
398 setup_echo_area_for_printing (multibyte_p
);
399 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
401 if (size
== size_byte
)
403 for (i
= 0; i
< size
; ++i
)
404 insert_char ((unsigned char )*ptr
++);
409 for (i
= 0; i
< size_byte
; i
+= len
)
411 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
416 #ifdef MAX_PRINT_CHARS
419 #endif /* MAX_PRINT_CHARS */
423 /* PRINTCHARFUN is a Lisp function. */
426 if (size
== size_byte
)
428 while (i
< size_byte
)
436 while (i
< size_byte
)
438 /* Here, we must convert each multi-byte form to the
439 corresponding character code before handing it to
442 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
450 /* Print the contents of a string STRING using PRINTCHARFUN.
451 It isn't safe to use strout in many cases,
452 because printing one char can relocate. */
455 print_string (string
, printcharfun
)
457 Lisp_Object printcharfun
;
459 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
463 if (STRING_MULTIBYTE (string
))
464 chars
= XSTRING (string
)->size
;
465 else if (EQ (printcharfun
, Qt
)
466 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
467 : ! NILP (current_buffer
->enable_multibyte_characters
))
469 /* If unibyte string STRING contains 8-bit codes, we must
470 convert STRING to a multibyte string containing the same
475 chars
= STRING_BYTES (XSTRING (string
));
476 bytes
= parse_str_to_multibyte (XSTRING (string
)->data
, chars
);
479 newstr
= make_uninit_multibyte_string (chars
, bytes
);
480 bcopy (XSTRING (string
)->data
, XSTRING (newstr
)->data
, chars
);
481 str_to_multibyte (XSTRING (newstr
)->data
, bytes
, chars
);
486 chars
= STRING_BYTES (XSTRING (string
));
488 /* strout is safe for output to a frame (echo area) or to print_buffer. */
489 strout (XSTRING (string
)->data
,
490 chars
, STRING_BYTES (XSTRING (string
)),
491 printcharfun
, STRING_MULTIBYTE (string
));
495 /* Otherwise, string may be relocated by printing one char.
496 So re-fetch the string address for each character. */
498 int size
= XSTRING (string
)->size
;
499 int size_byte
= STRING_BYTES (XSTRING (string
));
502 if (size
== size_byte
)
503 for (i
= 0; i
< size
; i
++)
504 PRINTCHAR (XSTRING (string
)->data
[i
]);
506 for (i
= 0; i
< size_byte
; i
++)
508 /* Here, we must convert each multi-byte form to the
509 corresponding character code before handing it to PRINTCHAR. */
511 int ch
= STRING_CHAR_AND_LENGTH (XSTRING (string
)->data
+ i
,
513 if (!CHAR_VALID_P (ch
, 0))
515 ch
= XSTRING (string
)->data
[i
];
525 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
526 "Output character CHARACTER to stream PRINTCHARFUN.\n\
527 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
528 (character
, printcharfun
)
529 Lisp_Object character
, printcharfun
;
533 if (NILP (printcharfun
))
534 printcharfun
= Vstandard_output
;
535 CHECK_NUMBER (character
, 0);
537 PRINTCHAR (XINT (character
));
542 /* Used from outside of print.c to print a block of SIZE
543 single-byte chars at DATA on the default output stream.
544 Do not use this on the contents of a Lisp string. */
547 write_string (data
, size
)
552 Lisp_Object printcharfun
;
554 printcharfun
= Vstandard_output
;
557 strout (data
, size
, size
, printcharfun
, 0);
561 /* Used from outside of print.c to print a block of SIZE
562 single-byte chars at DATA on a specified stream PRINTCHARFUN.
563 Do not use this on the contents of a Lisp string. */
566 write_string_1 (data
, size
, printcharfun
)
569 Lisp_Object printcharfun
;
574 strout (data
, size
, size
, printcharfun
, 0);
580 temp_output_buffer_setup (bufname
)
583 int count
= specpdl_ptr
- specpdl
;
584 register struct buffer
*old
= current_buffer
;
585 register Lisp_Object buf
;
587 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
589 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
591 current_buffer
->directory
= old
->directory
;
592 current_buffer
->read_only
= Qnil
;
593 current_buffer
->filename
= Qnil
;
594 current_buffer
->undo_list
= Qt
;
595 current_buffer
->overlays_before
= Qnil
;
596 current_buffer
->overlays_after
= Qnil
;
597 current_buffer
->enable_multibyte_characters
598 = buffer_defaults
.enable_multibyte_characters
;
600 XSETBUFFER (buf
, current_buffer
);
602 if (!NILP (Vrun_hooks
))
603 call1 (Vrun_hooks
, Qtemp_buffer_setup_hook
);
605 unbind_to (count
, Qnil
);
607 specbind (Qstandard_output
, buf
);
611 internal_with_output_to_temp_buffer (bufname
, function
, args
)
613 Lisp_Object (*function
) P_ ((Lisp_Object
));
616 int count
= specpdl_ptr
- specpdl
;
617 Lisp_Object buf
, val
;
621 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
622 temp_output_buffer_setup (bufname
);
623 buf
= Vstandard_output
;
626 val
= (*function
) (args
);
629 temp_output_buffer_show (buf
);
632 return unbind_to (count
, val
);
635 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
637 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
638 The buffer is cleared out initially, and marked as unmodified when done.\n\
639 All output done by BODY is inserted in that buffer by default.\n\
640 The buffer is displayed in another window, but not selected.\n\
641 The value of the last form in BODY is returned.\n\
642 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\
644 The hook `temp-buffer-setup-hook' is run before BODY,\n\
645 with the buffer BUFNAME temporarily current.\n\
646 The hook `temp-buffer-show-hook' is run after the buffer is displayed,\n\
647 with the buffer temporarily current, and the window that was used\n\
648 to display it temporarily selected.\n\
650 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
651 to get the buffer displayed instead of just displaying the non-selected\n\
652 buffer and calling the hook. It gets one argument, the buffer to display.")
658 int count
= specpdl_ptr
- specpdl
;
659 Lisp_Object buf
, val
;
662 name
= Feval (Fcar (args
));
663 CHECK_STRING (name
, 0);
664 temp_output_buffer_setup (XSTRING (name
)->data
);
665 buf
= Vstandard_output
;
668 val
= Fprogn (XCDR (args
));
671 temp_output_buffer_show (buf
);
674 return unbind_to (count
, val
);
678 static void print ();
679 static void print_preprocess ();
680 static void print_preprocess_string ();
681 static void print_object ();
683 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
684 "Output a newline to stream PRINTCHARFUN.\n\
685 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
687 Lisp_Object printcharfun
;
691 if (NILP (printcharfun
))
692 printcharfun
= Vstandard_output
;
699 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
700 "Output the printed representation of OBJECT, any Lisp object.\n\
701 Quoting characters are printed when needed to make output that `read'\n\
702 can handle, whenever this is possible.\n\
704 OBJECT is any of the Lisp data types: a number, a string, a symbol,\n\
705 a list, a buffer, a window, a frame, etc.\n\
707 A printed representation of an object is text which describes that object.\n\
709 Optional argument PRINTCHARFUN is the output stream, which can be one\n\
712 - a buffer, in which case output is inserted into that buffer at point;\n\
713 - a marker, in which case output is inserted at marker's position;\n\
714 - a function, in which case that function is called once for each\n\
715 character of OBJECT's printed representation;\n\
716 - a symbol, in which case that symbol's function definition is called; or\n\
717 - t, in which case the output is displayed in the echo area.\n\
719 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)\n\
721 (object
, printcharfun
)
722 Lisp_Object object
, printcharfun
;
726 #ifdef MAX_PRINT_CHARS
728 #endif /* MAX_PRINT_CHARS */
729 if (NILP (printcharfun
))
730 printcharfun
= Vstandard_output
;
732 print (object
, printcharfun
, 1);
737 /* a buffer which is used to hold output being built by prin1-to-string */
738 Lisp_Object Vprin1_to_string_buffer
;
740 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
741 "Return a string containing the printed representation of OBJECT,\n\
742 any Lisp object. Quoting characters are used when needed to make output\n\
743 that `read' can handle, whenever this is possible, unless the optional\n\
744 second argument NOESCAPE is non-nil.\n\
746 OBJECT is any of the Lisp data types: a number, a string, a symbol,\n\
747 a list, a buffer, a window, a frame, etc.\n\
749 A printed representation of an object is text which describes that object.")
751 Lisp_Object object
, noescape
;
754 Lisp_Object printcharfun
;
755 struct gcpro gcpro1
, gcpro2
;
758 /* Save and restore this--we are altering a buffer
759 but we don't want to deactivate the mark just for that.
760 No need for specbind, since errors deactivate the mark. */
761 tem
= Vdeactivate_mark
;
762 GCPRO2 (object
, tem
);
764 printcharfun
= Vprin1_to_string_buffer
;
766 print (object
, printcharfun
, NILP (noescape
));
767 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
769 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
770 object
= Fbuffer_string ();
773 set_buffer_internal (old
);
775 Vdeactivate_mark
= tem
;
781 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
782 "Output the printed representation of OBJECT, any Lisp object.\n\
783 No quoting characters are used; no delimiters are printed around\n\
784 the contents of strings.\n\
786 OBJECT is any of the Lisp data types: a number, a string, a symbol,\n\
787 a list, a buffer, a window, a frame, etc.\n\
789 A printed representation of an object is text which describes that object.\n\
791 Optional argument PRINTCHARFUN is the output stream, which can be one\n\
794 - a buffer, in which case output is inserted into that buffer at point;\n\
795 - a marker, in which case output is inserted at marker's position;\n\
796 - a function, in which case that function is called once for each\n\
797 character of OBJECT's printed representation;\n\
798 - a symbol, in which case that symbol's function definition is called; or\n\
799 - t, in which case the output is displayed in the echo area.\n\
801 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)\n\
803 (object
, printcharfun
)
804 Lisp_Object object
, printcharfun
;
808 if (NILP (printcharfun
))
809 printcharfun
= Vstandard_output
;
811 print (object
, printcharfun
, 0);
816 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
817 "Output the printed representation of OBJECT, with newlines around it.\n\
818 Quoting characters are printed when needed to make output that `read'\n\
819 can handle, whenever this is possible.\n\
821 OBJECT is any of the Lisp data types: a number, a string, a symbol,\n\
822 a list, a buffer, a window, a frame, etc.\n\
824 A printed representation of an object is text which describes that object.\n\
826 Optional argument PRINTCHARFUN is the output stream, which can be one\n\
829 - a buffer, in which case output is inserted into that buffer at point;\n\
830 - a marker, in which case output is inserted at marker's position;\n\
831 - a function, in which case that function is called once for each\n\
832 character of OBJECT's printed representation;\n\
833 - a symbol, in which case that symbol's function definition is called; or\n\
834 - t, in which case the output is displayed in the echo area.\n\
836 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)\n\
838 (object
, printcharfun
)
839 Lisp_Object object
, printcharfun
;
844 #ifdef MAX_PRINT_CHARS
846 max_print
= MAX_PRINT_CHARS
;
847 #endif /* MAX_PRINT_CHARS */
848 if (NILP (printcharfun
))
849 printcharfun
= Vstandard_output
;
853 print (object
, printcharfun
, 1);
856 #ifdef MAX_PRINT_CHARS
859 #endif /* MAX_PRINT_CHARS */
864 /* The subroutine object for external-debugging-output is kept here
865 for the convenience of the debugger. */
866 Lisp_Object Qexternal_debugging_output
;
868 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
869 "Write CHARACTER to stderr.\n\
870 You can call print while debugging emacs, and pass it this function\n\
871 to make it write to the debugging output.\n")
873 Lisp_Object character
;
875 CHECK_NUMBER (character
, 0);
876 putc (XINT (character
), stderr
);
879 /* Send the output to a debugger (nothing happens if there isn't one). */
881 char buf
[2] = {(char) XINT (character
), '\0'};
882 OutputDebugString (buf
);
889 /* This is the interface for debugging printing. */
895 Fprin1 (arg
, Qexternal_debugging_output
);
896 fprintf (stderr
, "\r\n");
899 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
901 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
905 struct buffer
*old
= current_buffer
;
909 /* If OBJ is (error STRING), just return STRING.
910 That is not only faster, it also avoids the need to allocate
911 space here when the error is due to memory full. */
912 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
913 && CONSP (XCDR (obj
))
914 && STRINGP (XCAR (XCDR (obj
)))
915 && NILP (XCDR (XCDR (obj
))))
916 return XCAR (XCDR (obj
));
918 print_error_message (obj
, Vprin1_to_string_buffer
);
920 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
921 value
= Fbuffer_string ();
925 set_buffer_internal (old
);
931 /* Print an error message for the error DATA onto Lisp output stream
932 STREAM (suitable for the print functions). */
935 print_error_message (data
, stream
)
936 Lisp_Object data
, stream
;
938 Lisp_Object errname
, errmsg
, file_error
, tail
;
942 errname
= Fcar (data
);
944 if (EQ (errname
, Qerror
))
949 errmsg
= Fcar (data
);
954 Lisp_Object error_conditions
;
955 errmsg
= Fget (errname
, Qerror_message
);
956 error_conditions
= Fget (errname
, Qerror_conditions
);
957 file_error
= Fmemq (Qfile_error
, error_conditions
);
960 /* Print an error message including the data items. */
962 tail
= Fcdr_safe (data
);
965 /* If we know from where the error was signaled, show it in
967 if (!NILP (Vsignaling_function
) && SYMBOLP (Vsignaling_function
))
969 char *name
= XSYMBOL (Vsignaling_function
)->name
->data
;
970 message_dolog (name
, strlen (name
), 0, 0);
971 message_dolog (": ", 2, 0, 0);
972 Vsignaling_function
= Qnil
;
975 /* For file-error, make error message by concatenating
976 all the data items. They are all strings. */
977 if (!NILP (file_error
) && CONSP (tail
))
978 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
980 if (STRINGP (errmsg
))
981 Fprinc (errmsg
, stream
);
983 write_string_1 ("peculiar error", -1, stream
);
985 for (i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
989 write_string_1 (i
? ", " : ": ", 2, stream
);
991 if (!NILP (file_error
) || EQ (errname
, Qend_of_file
))
992 Fprinc (obj
, stream
);
994 Fprin1 (obj
, stream
);
1003 * The buffer should be at least as large as the max string size of the
1004 * largest float, printed in the biggest notation. This is undoubtedly
1005 * 20d float_output_format, with the negative of the C-constant "HUGE"
1008 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1010 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1011 * case of -1e307 in 20d float_output_format. What is one to do (short of
1012 * re-writing _doprnt to be more sane)?
1017 float_to_string (buf
, data
)
1024 /* Check for plus infinity in a way that won't lose
1025 if there is no plus infinity. */
1026 if (data
== data
/ 2 && data
> 1.0)
1028 strcpy (buf
, "1.0e+INF");
1031 /* Likewise for minus infinity. */
1032 if (data
== data
/ 2 && data
< -1.0)
1034 strcpy (buf
, "-1.0e+INF");
1037 /* Check for NaN in a way that won't fail if there are no NaNs. */
1038 if (! (data
* 0.0 >= 0.0))
1040 /* Prepend "-" if the NaN's sign bit is negative.
1041 The sign bit of a double is the bit that is 1 in -0.0. */
1043 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
1045 u_minus_zero
.d
= - 0.0;
1046 for (i
= 0; i
< sizeof (double); i
++)
1047 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1053 strcpy (buf
, "0.0e+NaN");
1057 if (NILP (Vfloat_output_format
)
1058 || !STRINGP (Vfloat_output_format
))
1061 /* Generate the fewest number of digits that represent the
1062 floating point value without losing information.
1063 The following method is simple but a bit slow.
1064 For ideas about speeding things up, please see:
1066 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1067 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1069 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1070 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1072 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1074 sprintf (buf
, "%.*g", width
, data
);
1075 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1077 else /* oink oink */
1079 /* Check that the spec we have is fully valid.
1080 This means not only valid for printf,
1081 but meant for floats, and reasonable. */
1082 cp
= XSTRING (Vfloat_output_format
)->data
;
1091 /* Check the width specification. */
1093 if ('0' <= *cp
&& *cp
<= '9')
1097 width
= (width
* 10) + (*cp
++ - '0');
1098 while (*cp
>= '0' && *cp
<= '9');
1100 /* A precision of zero is valid only for %f. */
1102 || (width
== 0 && *cp
!= 'f'))
1106 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1112 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
1115 /* Make sure there is a decimal point with digit after, or an
1116 exponent, so that the value is readable as a float. But don't do
1117 this with "%.0f"; it's valid for that not to produce a decimal
1118 point. Note that width can be 0 only for %.0f. */
1121 for (cp
= buf
; *cp
; cp
++)
1122 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1125 if (*cp
== '.' && cp
[1] == 0)
1142 print (obj
, printcharfun
, escapeflag
)
1144 register Lisp_Object printcharfun
;
1149 /* Reset print_number_index and Vprint_number_table only when
1150 the variable Vprint_continuous_numbering is nil. Otherwise,
1151 the values of these variables will be kept between several
1153 if (NILP (Vprint_continuous_numbering
))
1155 print_number_index
= 0;
1156 Vprint_number_table
= Qnil
;
1159 /* Construct Vprint_number_table for print-gensym and print-circle. */
1160 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1162 int i
, start
, index
;
1163 /* Construct Vprint_number_table. */
1164 start
= index
= print_number_index
;
1165 print_preprocess (obj
);
1166 /* Remove unnecessary objects, which appear only once in OBJ;
1167 that is, whose status is Qnil. */
1168 for (i
= start
; i
< print_number_index
; i
++)
1169 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1171 PRINT_NUMBER_OBJECT (Vprint_number_table
, index
)
1172 = PRINT_NUMBER_OBJECT (Vprint_number_table
, i
);
1173 /* Reset the status field for the next print step. Now this
1174 field means whether the object has already been printed. */
1175 PRINT_NUMBER_STATUS (Vprint_number_table
, index
) = Qnil
;
1178 print_number_index
= index
;
1181 print_object (obj
, printcharfun
, escapeflag
);
1184 /* Construct Vprint_number_table according to the structure of OBJ.
1185 OBJ itself and all its elements will be added to Vprint_number_table
1186 recursively if it is a list, vector, compiled function, char-table,
1187 string (its text properties will be traced), or a symbol that has
1188 no obarray (this is for the print-gensym feature).
1189 The status fields of Vprint_number_table mean whether each object appears
1190 more than once in OBJ: Qnil at the first time, and Qt after that . */
1192 print_preprocess (obj
)
1198 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1199 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1200 || (! NILP (Vprint_gensym
)
1202 && !SYMBOL_INTERNED_P (obj
)))
1204 /* In case print-circle is nil and print-gensym is t,
1205 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1206 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1208 for (i
= 0; i
< print_number_index
; i
++)
1209 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1211 /* OBJ appears more than once. Let's remember that. */
1212 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1216 /* OBJ is not yet recorded. Let's add to the table. */
1217 if (print_number_index
== 0)
1219 /* Initialize the table. */
1220 Vprint_number_table
= Fmake_vector (make_number (40), Qnil
);
1222 else if (XVECTOR (Vprint_number_table
)->size
== print_number_index
* 2)
1224 /* Reallocate the table. */
1225 int i
= print_number_index
* 4;
1226 Lisp_Object old_table
= Vprint_number_table
;
1227 Vprint_number_table
= Fmake_vector (make_number (i
), Qnil
);
1228 for (i
= 0; i
< print_number_index
; i
++)
1230 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
)
1231 = PRINT_NUMBER_OBJECT (old_table
, i
);
1232 PRINT_NUMBER_STATUS (Vprint_number_table
, i
)
1233 = PRINT_NUMBER_STATUS (old_table
, i
);
1236 PRINT_NUMBER_OBJECT (Vprint_number_table
, print_number_index
) = obj
;
1237 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1238 always print the gensym with a number. This is a special for
1239 the lisp function byte-compile-output-docform. */
1240 if (!NILP (Vprint_continuous_numbering
)
1242 && !SYMBOL_INTERNED_P (obj
))
1243 PRINT_NUMBER_STATUS (Vprint_number_table
, print_number_index
) = Qt
;
1244 print_number_index
++;
1247 switch (XGCTYPE (obj
))
1250 /* A string may have text properties, which can be circular. */
1251 traverse_intervals_noorder (XSTRING (obj
)->intervals
,
1252 print_preprocess_string
, Qnil
);
1256 print_preprocess (XCAR (obj
));
1260 case Lisp_Vectorlike
:
1261 size
= XVECTOR (obj
)->size
& PSEUDOVECTOR_SIZE_MASK
;
1262 for (i
= 0; i
< size
; i
++)
1263 print_preprocess (XVECTOR (obj
)->contents
[i
]);
1273 print_preprocess_string (interval
, arg
)
1277 print_preprocess (interval
->plist
);
1281 print_object (obj
, printcharfun
, escapeflag
)
1283 register Lisp_Object printcharfun
;
1290 /* Detect circularities and truncate them. */
1291 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1292 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1293 || (! NILP (Vprint_gensym
)
1295 && !SYMBOL_INTERNED_P (obj
)))
1297 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1299 /* Simple but incomplete way. */
1301 for (i
= 0; i
< print_depth
; i
++)
1302 if (EQ (obj
, being_printed
[i
]))
1304 sprintf (buf
, "#%d", i
);
1305 strout (buf
, -1, -1, printcharfun
, 0);
1308 being_printed
[print_depth
] = obj
;
1312 /* With the print-circle feature. */
1314 for (i
= 0; i
< print_number_index
; i
++)
1315 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1317 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1319 /* Add a prefix #n= if OBJ has not yet been printed;
1320 that is, its status field is nil. */
1321 sprintf (buf
, "#%d=", i
+ 1);
1322 strout (buf
, -1, -1, printcharfun
, 0);
1323 /* OBJ is going to be printed. Set the status to t. */
1324 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1329 /* Just print #n# if OBJ has already been printed. */
1330 sprintf (buf
, "#%d#", i
+ 1);
1331 strout (buf
, -1, -1, printcharfun
, 0);
1340 if (print_depth
> PRINT_CIRCLE
)
1341 error ("Apparently circular structure being printed");
1342 #ifdef MAX_PRINT_CHARS
1343 if (max_print
&& print_chars
> max_print
)
1348 #endif /* MAX_PRINT_CHARS */
1350 switch (XGCTYPE (obj
))
1353 if (sizeof (int) == sizeof (EMACS_INT
))
1354 sprintf (buf
, "%d", XINT (obj
));
1355 else if (sizeof (long) == sizeof (EMACS_INT
))
1356 sprintf (buf
, "%ld", (long) XINT (obj
));
1359 strout (buf
, -1, -1, printcharfun
, 0);
1364 char pigbuf
[350]; /* see comments in float_to_string */
1366 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1367 strout (pigbuf
, -1, -1, printcharfun
, 0);
1373 print_string (obj
, printcharfun
);
1376 register int i
, i_byte
;
1377 struct gcpro gcpro1
;
1380 /* 1 means we must ensure that the next character we output
1381 cannot be taken as part of a hex character escape. */
1382 int need_nonhex
= 0;
1386 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1393 str
= XSTRING (obj
)->data
;
1394 size_byte
= STRING_BYTES (XSTRING (obj
));
1396 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1398 /* Here, we must convert each multi-byte form to the
1399 corresponding character code before handing it to PRINTCHAR. */
1403 if (STRING_MULTIBYTE (obj
))
1405 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
,
1406 size_byte
- i_byte
, len
);
1407 if (CHAR_VALID_P (c
, 0))
1417 if (c
== '\n' && print_escape_newlines
)
1422 else if (c
== '\f' && print_escape_newlines
)
1427 else if (! SINGLE_BYTE_CHAR_P (c
) && print_escape_multibyte
)
1429 /* When multibyte is disabled,
1430 print multibyte string chars using hex escapes. */
1431 unsigned char outbuf
[50];
1432 sprintf (outbuf
, "\\x%x", c
);
1433 strout (outbuf
, -1, -1, printcharfun
, 0);
1436 else if (SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1437 && print_escape_nonascii
)
1439 /* When printing in a multibyte buffer
1440 or when explicitly requested,
1441 print single-byte non-ASCII string chars
1442 using octal escapes. */
1443 unsigned char outbuf
[5];
1444 sprintf (outbuf
, "\\%03o", c
);
1445 strout (outbuf
, -1, -1, printcharfun
, 0);
1449 /* If we just had a hex escape, and this character
1450 could be taken as part of it,
1451 output `\ ' to prevent that. */
1455 if ((c
>= 'a' && c
<= 'f')
1456 || (c
>= 'A' && c
<= 'F')
1457 || (c
>= '0' && c
<= '9'))
1458 strout ("\\ ", -1, -1, printcharfun
, 0);
1461 if (c
== '\"' || c
== '\\')
1468 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1470 traverse_intervals (XSTRING (obj
)->intervals
,
1471 0, print_interval
, printcharfun
);
1481 register int confusing
;
1482 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
1483 register unsigned char *end
= p
+ STRING_BYTES (XSYMBOL (obj
)->name
);
1485 int i
, i_byte
, size_byte
;
1488 XSETSTRING (name
, XSYMBOL (obj
)->name
);
1490 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1493 /* If symbol name begins with a digit, and ends with a digit,
1494 and contains nothing but digits and `e', it could be treated
1495 as a number. So set CONFUSING.
1497 Symbols that contain periods could also be taken as numbers,
1498 but periods are always escaped, so we don't have to worry
1500 else if (*p
>= '0' && *p
<= '9'
1501 && end
[-1] >= '0' && end
[-1] <= '9')
1503 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1504 /* Needed for \2e10. */
1507 confusing
= (end
== p
);
1512 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1518 size_byte
= STRING_BYTES (XSTRING (name
));
1520 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1522 /* Here, we must convert each multi-byte form to the
1523 corresponding character code before handing it to PRINTCHAR. */
1524 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1529 if (c
== '\"' || c
== '\\' || c
== '\''
1530 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1531 || c
== ',' || c
=='.' || c
== '`'
1532 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1534 PRINTCHAR ('\\'), confusing
= 0;
1542 /* If deeper than spec'd depth, print placeholder. */
1543 if (INTEGERP (Vprint_level
)
1544 && print_depth
> XINT (Vprint_level
))
1545 strout ("...", -1, -1, printcharfun
, 0);
1546 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1547 && (EQ (XCAR (obj
), Qquote
)))
1550 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1552 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1553 && (EQ (XCAR (obj
), Qfunction
)))
1557 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1559 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1560 && ((EQ (XCAR (obj
), Qbackquote
)
1561 || EQ (XCAR (obj
), Qcomma
)
1562 || EQ (XCAR (obj
), Qcomma_at
)
1563 || EQ (XCAR (obj
), Qcomma_dot
))))
1565 print_object (XCAR (obj
), printcharfun
, 0);
1566 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1572 int print_length
, i
;
1573 Lisp_Object halftail
= obj
;
1575 /* Negative values of print-length are invalid in CL.
1576 Treat them like nil, as CMUCL does. */
1577 if (NATNUMP (Vprint_length
))
1578 print_length
= XFASTINT (Vprint_length
);
1585 /* Detect circular list. */
1586 if (NILP (Vprint_circle
))
1588 /* Simple but imcomplete way. */
1589 if (i
!= 0 && EQ (obj
, halftail
))
1591 sprintf (buf
, " . #%d", i
/ 2);
1592 strout (buf
, -1, -1, printcharfun
, 0);
1598 /* With the print-circle feature. */
1602 for (i
= 0; i
< print_number_index
; i
++)
1603 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
),
1606 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1608 strout (" . ", 3, 3, printcharfun
, 0);
1609 print_object (obj
, printcharfun
, escapeflag
);
1613 sprintf (buf
, " . #%d#", i
+ 1);
1614 strout (buf
, -1, -1, printcharfun
, 0);
1624 if (print_length
&& i
> print_length
)
1626 strout ("...", 3, 3, printcharfun
, 0);
1630 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1634 halftail
= XCDR (halftail
);
1638 /* OBJ non-nil here means it's the end of a dotted list. */
1641 strout (" . ", 3, 3, printcharfun
, 0);
1642 print_object (obj
, printcharfun
, escapeflag
);
1650 case Lisp_Vectorlike
:
1655 strout ("#<process ", -1, -1, printcharfun
, 0);
1656 print_string (XPROCESS (obj
)->name
, printcharfun
);
1660 print_string (XPROCESS (obj
)->name
, printcharfun
);
1662 else if (BOOL_VECTOR_P (obj
))
1665 register unsigned char c
;
1666 struct gcpro gcpro1
;
1668 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1674 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1675 strout (buf
, -1, -1, printcharfun
, 0);
1678 /* Don't print more characters than the specified maximum.
1679 Negative values of print-length are invalid. Treat them
1680 like a print-length of nil. */
1681 if (NATNUMP (Vprint_length
)
1682 && XFASTINT (Vprint_length
) < size_in_chars
)
1683 size_in_chars
= XFASTINT (Vprint_length
);
1685 for (i
= 0; i
< size_in_chars
; i
++)
1688 c
= XBOOL_VECTOR (obj
)->data
[i
];
1689 if (c
== '\n' && print_escape_newlines
)
1694 else if (c
== '\f' && print_escape_newlines
)
1701 if (c
== '\"' || c
== '\\')
1710 else if (SUBRP (obj
))
1712 strout ("#<subr ", -1, -1, printcharfun
, 0);
1713 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1716 else if (WINDOWP (obj
))
1718 strout ("#<window ", -1, -1, printcharfun
, 0);
1719 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1720 strout (buf
, -1, -1, printcharfun
, 0);
1721 if (!NILP (XWINDOW (obj
)->buffer
))
1723 strout (" on ", -1, -1, printcharfun
, 0);
1724 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1728 else if (HASH_TABLE_P (obj
))
1730 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1731 strout ("#<hash-table", -1, -1, printcharfun
, 0);
1732 if (SYMBOLP (h
->test
))
1736 strout (XSYMBOL (h
->test
)->name
->data
, -1, -1, printcharfun
, 0);
1738 strout (XSYMBOL (h
->weak
)->name
->data
, -1, -1, printcharfun
, 0);
1740 sprintf (buf
, "%d/%d", XFASTINT (h
->count
),
1741 XVECTOR (h
->next
)->size
);
1742 strout (buf
, -1, -1, printcharfun
, 0);
1744 sprintf (buf
, " 0x%lx", (unsigned long) h
);
1745 strout (buf
, -1, -1, printcharfun
, 0);
1748 else if (BUFFERP (obj
))
1750 if (NILP (XBUFFER (obj
)->name
))
1751 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1752 else if (escapeflag
)
1754 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1755 print_string (XBUFFER (obj
)->name
, printcharfun
);
1759 print_string (XBUFFER (obj
)->name
, printcharfun
);
1761 else if (WINDOW_CONFIGURATIONP (obj
))
1763 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1765 else if (FRAMEP (obj
))
1767 strout ((FRAME_LIVE_P (XFRAME (obj
))
1768 ? "#<frame " : "#<dead frame "),
1769 -1, -1, printcharfun
, 0);
1770 print_string (XFRAME (obj
)->name
, printcharfun
);
1771 sprintf (buf
, " 0x%lx\\ ", (unsigned long) (XFRAME (obj
)));
1772 strout (buf
, -1, -1, printcharfun
, 0);
1777 int size
= XVECTOR (obj
)->size
;
1778 if (COMPILEDP (obj
))
1781 size
&= PSEUDOVECTOR_SIZE_MASK
;
1783 if (CHAR_TABLE_P (obj
))
1785 /* We print a char-table as if it were a vector,
1786 lumping the parent and default slots in with the
1787 character slots. But we add #^ as a prefix. */
1790 if (SUB_CHAR_TABLE_P (obj
))
1792 size
&= PSEUDOVECTOR_SIZE_MASK
;
1794 if (size
& PSEUDOVECTOR_FLAG
)
1800 register Lisp_Object tem
;
1801 int real_size
= size
;
1803 /* Don't print more elements than the specified maximum. */
1804 if (NATNUMP (Vprint_length
)
1805 && XFASTINT (Vprint_length
) < size
)
1806 size
= XFASTINT (Vprint_length
);
1808 for (i
= 0; i
< size
; i
++)
1810 if (i
) PRINTCHAR (' ');
1811 tem
= XVECTOR (obj
)->contents
[i
];
1812 print_object (tem
, printcharfun
, escapeflag
);
1814 if (size
< real_size
)
1815 strout (" ...", 4, 4, printcharfun
, 0);
1822 switch (XMISCTYPE (obj
))
1824 case Lisp_Misc_Marker
:
1825 strout ("#<marker ", -1, -1, printcharfun
, 0);
1826 /* Do you think this is necessary? */
1827 if (XMARKER (obj
)->insertion_type
!= 0)
1828 strout ("(before-insertion) ", -1, -1, printcharfun
, 0);
1829 if (!(XMARKER (obj
)->buffer
))
1830 strout ("in no buffer", -1, -1, printcharfun
, 0);
1833 sprintf (buf
, "at %d", marker_position (obj
));
1834 strout (buf
, -1, -1, printcharfun
, 0);
1835 strout (" in ", -1, -1, printcharfun
, 0);
1836 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1841 case Lisp_Misc_Overlay
:
1842 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1843 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1844 strout ("in no buffer", -1, -1, printcharfun
, 0);
1847 sprintf (buf
, "from %d to %d in ",
1848 marker_position (OVERLAY_START (obj
)),
1849 marker_position (OVERLAY_END (obj
)));
1850 strout (buf
, -1, -1, printcharfun
, 0);
1851 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1857 /* Remaining cases shouldn't happen in normal usage, but let's print
1858 them anyway for the benefit of the debugger. */
1859 case Lisp_Misc_Free
:
1860 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1863 case Lisp_Misc_Intfwd
:
1864 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1865 strout (buf
, -1, -1, printcharfun
, 0);
1868 case Lisp_Misc_Boolfwd
:
1869 sprintf (buf
, "#<boolfwd to %s>",
1870 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1871 strout (buf
, -1, -1, printcharfun
, 0);
1874 case Lisp_Misc_Objfwd
:
1875 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
1876 print_object (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1880 case Lisp_Misc_Buffer_Objfwd
:
1881 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
1882 print_object (PER_BUFFER_VALUE (current_buffer
,
1883 XBUFFER_OBJFWD (obj
)->offset
),
1884 printcharfun
, escapeflag
);
1888 case Lisp_Misc_Kboard_Objfwd
:
1889 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
1890 print_object (*(Lisp_Object
*)((char *) current_kboard
1891 + XKBOARD_OBJFWD (obj
)->offset
),
1892 printcharfun
, escapeflag
);
1896 case Lisp_Misc_Buffer_Local_Value
:
1897 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
1898 goto do_buffer_local
;
1899 case Lisp_Misc_Some_Buffer_Local_Value
:
1900 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
1902 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
1903 print_object (XBUFFER_LOCAL_VALUE (obj
)->realvalue
,
1904 printcharfun
, escapeflag
);
1905 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
1906 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
1908 strout ("[buffer] ", -1, -1, printcharfun
, 0);
1909 print_object (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
1910 printcharfun
, escapeflag
);
1911 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
1913 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
1914 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
1916 strout ("[frame] ", -1, -1, printcharfun
, 0);
1917 print_object (XBUFFER_LOCAL_VALUE (obj
)->frame
,
1918 printcharfun
, escapeflag
);
1920 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
1921 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
1922 printcharfun
, escapeflag
);
1923 strout ("[default-value] ", -1, -1, printcharfun
, 0);
1924 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
1925 printcharfun
, escapeflag
);
1937 /* We're in trouble if this happens!
1938 Probably should just abort () */
1939 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
1941 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1942 else if (VECTORLIKEP (obj
))
1943 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1945 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1946 strout (buf
, -1, -1, printcharfun
, 0);
1947 strout (" Save your buffers immediately and please report this bug>",
1948 -1, -1, printcharfun
, 0);
1956 /* Print a description of INTERVAL using PRINTCHARFUN.
1957 This is part of printing a string that has text properties. */
1960 print_interval (interval
, printcharfun
)
1962 Lisp_Object printcharfun
;
1965 print_object (make_number (interval
->position
), printcharfun
, 1);
1967 print_object (make_number (interval
->position
+ LENGTH (interval
)),
1970 print_object (interval
->plist
, printcharfun
, 1);
1977 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
1978 staticpro (&Qtemp_buffer_setup_hook
);
1980 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1981 "Output stream `print' uses by default for outputting a character.\n\
1982 This may be any function of one argument.\n\
1983 It may also be a buffer (output is inserted before point)\n\
1984 or a marker (output is inserted and the marker is advanced)\n\
1985 or the symbol t (output appears in the echo area).");
1986 Vstandard_output
= Qt
;
1987 Qstandard_output
= intern ("standard-output");
1988 staticpro (&Qstandard_output
);
1990 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1991 "The format descriptor string used to print floats.\n\
1992 This is a %-spec like those accepted by `printf' in C,\n\
1993 but with some restrictions. It must start with the two characters `%.'.\n\
1994 After that comes an integer precision specification,\n\
1995 and then a letter which controls the format.\n\
1996 The letters allowed are `e', `f' and `g'.\n\
1997 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1998 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1999 Use `g' to choose the shorter of those two formats for the number at hand.\n\
2000 The precision in any of these cases is the number of digits following\n\
2001 the decimal point. With `f', a precision of 0 means to omit the\n\
2002 decimal point. 0 is not allowed with `e' or `g'.\n\n\
2003 A value of nil means to use the shortest notation\n\
2004 that represents the number without losing information.");
2005 Vfloat_output_format
= Qnil
;
2006 Qfloat_output_format
= intern ("float-output-format");
2007 staticpro (&Qfloat_output_format
);
2009 DEFVAR_LISP ("print-length", &Vprint_length
,
2010 "Maximum length of list to print before abbreviating.\n\
2011 A value of nil means no limit. See also `eval-expression-print-length'.");
2012 Vprint_length
= Qnil
;
2014 DEFVAR_LISP ("print-level", &Vprint_level
,
2015 "Maximum depth of list nesting to print before abbreviating.\n\
2016 A value of nil means no limit. See also `eval-expression-print-level'.");
2017 Vprint_level
= Qnil
;
2019 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
2020 "Non-nil means print newlines in strings as `\\n'.\n\
2021 Also print formfeeds as `\\f'.");
2022 print_escape_newlines
= 0;
2024 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
2025 "Non-nil means print unibyte non-ASCII chars in strings as \\OOO.\n\
2026 \(OOO is the octal representation of the character code.)\n\
2027 Only single-byte characters are affected, and only in `prin1'.");
2028 print_escape_nonascii
= 0;
2030 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
2031 "Non-nil means print multibyte characters in strings as \\xXXXX.\n\
2032 \(XXXX is the hex representation of the character code.)\n\
2033 This affects only `prin1'.");
2034 print_escape_multibyte
= 0;
2036 DEFVAR_BOOL ("print-quoted", &print_quoted
,
2037 "Non-nil means print quoted forms with reader syntax.\n\
2038 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted\n\
2039 forms print as in the new syntax.");
2042 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
2043 "Non-nil means print uninterned symbols so they will read as uninterned.\n\
2044 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\
2045 When the uninterned symbol appears within a recursive data structure,\n\
2046 and the symbol appears more than once, in addition use the #N# and #N=\n\
2047 constructs as needed, so that multiple references to the same symbol are\n\
2048 shared once again when the text is read back.");
2049 Vprint_gensym
= Qnil
;
2051 DEFVAR_LISP ("print-circle", &Vprint_circle
,
2052 "*Non-nil means print recursive structures using #N= and #N# syntax.\n\
2053 If nil, printing proceeds recursively and may lead to\n\
2054 `max-lisp-eval-depth' being exceeded or an error may occur:\n\
2055 \"Apparently circular structure being printed.\" Also see\n\
2056 `print-length' and `print-level'.\n\
2057 If non-nil, shared substructures anywhere in the structure are printed\n\
2058 with `#N=' before the first occurrence (in the order of the print\n\
2059 representation) and `#N#' in place of each subsequent occurrence,\n\
2060 where N is a positive decimal integer.");
2061 Vprint_circle
= Qnil
;
2063 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
2064 "*Non-nil means number continuously across print calls.\n\
2065 This affects the numbers printed for #N= labels and #M# references.\n\
2066 See also `print-circle', `print-gensym', and `print-number-table'.\n\
2067 This variable should not be set with `setq'; bind it with a `let' instead.");
2068 Vprint_continuous_numbering
= Qnil
;
2070 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
2071 "A vector used internally to produce `#N=' labels and `#N#' references.\n\
2072 The Lisp printer uses this vector to detect Lisp objects referenced more\n\
2073 than once. When `print-continuous-numbering' is bound to t, you should\n\
2074 probably also bind `print-number-table' to nil. This ensures that the\n\
2075 value of `print-number-table' can be garbage-collected once the printing\n\
2077 Vprint_number_table
= Qnil
;
2079 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2080 staticpro (&Vprin1_to_string_buffer
);
2083 defsubr (&Sprin1_to_string
);
2084 defsubr (&Serror_message_string
);
2088 defsubr (&Swrite_char
);
2089 defsubr (&Sexternal_debugging_output
);
2091 Qexternal_debugging_output
= intern ("external-debugging-output");
2092 staticpro (&Qexternal_debugging_output
);
2094 Qprint_escape_newlines
= intern ("print-escape-newlines");
2095 staticpro (&Qprint_escape_newlines
);
2097 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
2098 staticpro (&Qprint_escape_multibyte
);
2100 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
2101 staticpro (&Qprint_escape_nonascii
);
2103 defsubr (&Swith_output_to_temp_buffer
);