1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 1998
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. */
31 #include "dispextern.h"
35 #ifdef USE_TEXT_PROPERTIES
36 #include "intervals.h"
39 Lisp_Object Vstandard_output
, Qstandard_output
;
41 Lisp_Object Qtemp_buffer_setup_hook
;
43 /* These are used to print like we read. */
44 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
46 #ifdef LISP_FLOAT_TYPE
47 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
49 /* Work around a problem that happens because math.h on hpux 7
50 defines two static variables--which, in Emacs, are not really static,
51 because `static' is defined as nothing. The problem is that they are
52 defined both here and in lread.c.
53 These macros prevent the name conflict. */
54 #if defined (HPUX) && !defined (HPUX8)
55 #define _MAXLDBL print_maxldbl
56 #define _NMAXLDBL print_nmaxldbl
66 /* Default to values appropriate for IEEE floating point. */
71 #define DBL_MANT_DIG 53
77 #define DBL_MIN 2.2250738585072014e-308
80 #ifdef DBL_MIN_REPLACEMENT
82 #define DBL_MIN DBL_MIN_REPLACEMENT
85 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
86 needed to express a float without losing information.
87 The general-case formula is valid for the usual case, IEEE floating point,
88 but many compilers can't optimize the formula to an integer constant,
89 so make a special case for it. */
90 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
91 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
93 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
96 #endif /* LISP_FLOAT_TYPE */
98 /* Avoid actual stack overflow in print. */
101 /* Detect most circularities to print finite output. */
102 #define PRINT_CIRCLE 200
103 Lisp_Object being_printed
[PRINT_CIRCLE
];
105 /* When printing into a buffer, first we put the text in this
106 block, then insert it all at once. */
109 /* Size allocated in print_buffer. */
110 int print_buffer_size
;
111 /* Chars stored in print_buffer. */
112 int print_buffer_pos
;
113 /* Bytes stored in print_buffer. */
114 int print_buffer_pos_byte
;
116 /* Maximum length of list to print in full; noninteger means
117 effectively infinity */
119 Lisp_Object Vprint_length
;
121 /* Maximum depth of list to print in full; noninteger means
122 effectively infinity. */
124 Lisp_Object Vprint_level
;
126 /* Nonzero means print newlines in strings as \n. */
128 int print_escape_newlines
;
130 /* Nonzero means to print single-byte non-ascii characters in strings as
133 int print_escape_nonascii
;
135 /* Nonzero means to print multibyte characters in strings as hex escapes. */
137 int print_escape_multibyte
;
139 Lisp_Object Qprint_escape_newlines
;
140 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
142 /* Nonzero means print (quote foo) forms as 'foo, etc. */
146 /* Non-nil means print #: before uninterned symbols.
147 Neither t nor nil means so that and don't clear Vprint_gensym_alist
148 on entry to and exit from print functions. */
150 Lisp_Object Vprint_gensym
;
152 /* Association list of certain objects that are `eq' in the form being
153 printed and which should be `eq' when read back in, using the #n=object
154 and #n# reader forms. Each element has the form (object . n). */
156 Lisp_Object Vprint_gensym_alist
;
158 /* Nonzero means print newline to stdout before next minibuffer message.
159 Defined in xdisp.c */
161 extern int noninteractive_need_newline
;
163 extern int minibuffer_auto_raise
;
165 #ifdef MAX_PRINT_CHARS
166 static int print_chars
;
167 static int max_print
;
168 #endif /* MAX_PRINT_CHARS */
170 void print_interval ();
173 /* Low level output routines for characters and strings */
175 /* Lisp functions to do output using a stream
176 must have the stream in a variable called printcharfun
177 and must start with PRINTPREPARE, end with PRINTFINISH,
178 and use PRINTDECLARE to declare common variables.
179 Use PRINTCHAR to output one character,
180 or call strout to output a block of characters. */
182 #define PRINTDECLARE \
183 struct buffer *old = current_buffer; \
184 int old_point = -1, start_point; \
185 int old_point_byte, start_point_byte; \
186 int specpdl_count = specpdl_ptr - specpdl; \
187 int free_print_buffer = 0; \
188 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
191 #define PRINTPREPARE \
192 original = printcharfun; \
193 if (NILP (printcharfun)) printcharfun = Qt; \
194 if (BUFFERP (printcharfun)) \
196 if (XBUFFER (printcharfun) != current_buffer) \
197 Fset_buffer (printcharfun); \
198 printcharfun = Qnil; \
200 if (MARKERP (printcharfun)) \
202 if (!(XMARKER (original)->buffer)) \
203 error ("Marker does not point anywhere"); \
204 if (XMARKER (original)->buffer != current_buffer) \
205 set_buffer_internal (XMARKER (original)->buffer); \
207 old_point_byte = PT_BYTE; \
208 SET_PT_BOTH (marker_position (printcharfun), \
209 marker_byte_position (printcharfun)); \
211 start_point_byte = PT_BYTE; \
212 printcharfun = Qnil; \
214 if (NILP (printcharfun)) \
216 Lisp_Object string; \
217 if (NILP (current_buffer->enable_multibyte_characters) \
218 && ! print_escape_multibyte) \
219 specbind (Qprint_escape_multibyte, Qt); \
220 if (! NILP (current_buffer->enable_multibyte_characters) \
221 && ! print_escape_nonascii) \
222 specbind (Qprint_escape_nonascii, Qt); \
223 if (print_buffer != 0) \
225 string = make_string_from_bytes (print_buffer, \
227 print_buffer_pos_byte); \
228 record_unwind_protect (print_unwind, string); \
232 print_buffer_size = 1000; \
233 print_buffer = (char *) xmalloc (print_buffer_size); \
234 free_print_buffer = 1; \
236 print_buffer_pos = 0; \
237 print_buffer_pos_byte = 0; \
239 if (EQ (printcharfun, Qt)) \
240 setup_echo_area_for_printing (multibyte); \
241 if (!CONSP (Vprint_gensym)) \
242 Vprint_gensym_alist = Qnil
244 #define PRINTFINISH \
245 if (NILP (printcharfun)) \
247 if (print_buffer_pos != print_buffer_pos_byte \
248 && NILP (current_buffer->enable_multibyte_characters)) \
250 unsigned char *temp \
251 = (unsigned char *) alloca (print_buffer_pos + 1); \
252 copy_text (print_buffer, temp, print_buffer_pos_byte, \
254 insert_1_both (temp, print_buffer_pos, \
255 print_buffer_pos, 0, 1, 0); \
258 insert_1_both (print_buffer, print_buffer_pos, \
259 print_buffer_pos_byte, 0, 1, 0); \
261 if (free_print_buffer) \
263 xfree (print_buffer); \
266 unbind_to (specpdl_count, Qnil); \
267 if (MARKERP (original)) \
268 set_marker_both (original, Qnil, PT, PT_BYTE); \
269 if (old_point >= 0) \
270 SET_PT_BOTH (old_point + (old_point >= start_point \
271 ? PT - start_point : 0), \
272 old_point_byte + (old_point_byte >= start_point_byte \
273 ? PT_BYTE - start_point_byte : 0)); \
274 if (old != current_buffer) \
275 set_buffer_internal (old); \
276 if (!CONSP (Vprint_gensym)) \
277 Vprint_gensym_alist = Qnil
279 #define PRINTCHAR(ch) printchar (ch, printcharfun)
281 /* Nonzero if there is no room to print any more characters
282 so print might as well return right away. */
284 #define PRINTFULLP() \
285 (EQ (printcharfun, Qt) && !noninteractive \
286 && printbufidx >= FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)))))
288 /* This is used to restore the saved contents of print_buffer
289 when there is a recursive call to print. */
292 print_unwind (saved_text
)
293 Lisp_Object saved_text
;
295 bcopy (XSTRING (saved_text
)->data
, print_buffer
, XSTRING (saved_text
)->size
);
299 /* Print character CH using method FUN. FUN nil means print to
300 print_buffer. FUN t means print to echo area or stdout if
301 non-interactive. If FUN is neither nil nor t, call FUN with CH as
309 #ifdef MAX_PRINT_CHARS
312 #endif /* MAX_PRINT_CHARS */
314 if (!NILP (fun
) && !EQ (fun
, Qt
))
315 call1 (fun
, make_number (ch
));
318 unsigned char work
[4], *str
;
319 int len
= CHAR_STRING (ch
, work
, str
);
325 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
326 print_buffer
= (char *) xrealloc (print_buffer
,
327 print_buffer_size
*= 2);
328 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
329 print_buffer_pos
+= 1;
330 print_buffer_pos_byte
+= len
;
332 else if (noninteractive
)
334 fwrite (str
, 1, len
, stdout
);
335 noninteractive_need_newline
= 1;
340 = !NILP (current_buffer
->enable_multibyte_characters
);
342 if (!message_buf_print
)
343 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
)
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 if (!message_buf_print
)
402 setup_echo_area_for_printing (multibyte_p
);
404 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
406 if (size
== size_byte
)
408 for (i
= 0; i
< size
; ++i
)
409 insert_char (*ptr
++);
414 for (i
= 0; i
< size_byte
; i
+= len
)
416 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
421 #ifdef MAX_PRINT_CHARS
424 #endif /* MAX_PRINT_CHARS */
428 /* PRINTCHARFUN is a Lisp function. */
431 if (size
== size_byte
)
433 while (i
< size_byte
)
441 while (i
< size_byte
)
443 /* Here, we must convert each multi-byte form to the
444 corresponding character code before handing it to
447 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
455 /* Print the contents of a string STRING using PRINTCHARFUN.
456 It isn't safe to use strout in many cases,
457 because printing one char can relocate. */
460 print_string (string
, printcharfun
)
462 Lisp_Object printcharfun
;
464 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
468 if (STRING_MULTIBYTE (string
))
469 chars
= XSTRING (string
)->size
;
470 else if (EQ (printcharfun
, Qt
)
471 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
472 : ! NILP (current_buffer
->enable_multibyte_characters
))
473 chars
= multibyte_chars_in_text (XSTRING (string
)->data
,
474 STRING_BYTES (XSTRING (string
)));
476 chars
= STRING_BYTES (XSTRING (string
));
478 /* strout is safe for output to a frame (echo area) or to print_buffer. */
479 strout (XSTRING (string
)->data
,
480 chars
, STRING_BYTES (XSTRING (string
)),
481 printcharfun
, STRING_MULTIBYTE (string
));
485 /* Otherwise, string may be relocated by printing one char.
486 So re-fetch the string address for each character. */
488 int size
= XSTRING (string
)->size
;
489 int size_byte
= STRING_BYTES (XSTRING (string
));
492 if (size
== size_byte
)
493 for (i
= 0; i
< size
; i
++)
494 PRINTCHAR (XSTRING (string
)->data
[i
]);
496 for (i
= 0; i
< size_byte
; i
++)
498 /* Here, we must convert each multi-byte form to the
499 corresponding character code before handing it to PRINTCHAR. */
501 int ch
= STRING_CHAR_AND_LENGTH (XSTRING (string
)->data
+ i
,
503 if (!CHAR_VALID_P (ch
, 0))
505 ch
= XSTRING (string
)->data
[i
];
515 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
516 "Output character CHARACTER to stream PRINTCHARFUN.\n\
517 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
518 (character
, printcharfun
)
519 Lisp_Object character
, printcharfun
;
523 if (NILP (printcharfun
))
524 printcharfun
= Vstandard_output
;
525 CHECK_NUMBER (character
, 0);
527 PRINTCHAR (XINT (character
));
532 /* Used from outside of print.c to print a block of SIZE
533 single-byte chars at DATA on the default output stream.
534 Do not use this on the contents of a Lisp string. */
537 write_string (data
, size
)
542 Lisp_Object printcharfun
;
544 printcharfun
= Vstandard_output
;
547 strout (data
, size
, size
, printcharfun
, 0);
551 /* Used from outside of print.c to print a block of SIZE
552 single-byte chars at DATA on a specified stream PRINTCHARFUN.
553 Do not use this on the contents of a Lisp string. */
556 write_string_1 (data
, size
, printcharfun
)
559 Lisp_Object printcharfun
;
564 strout (data
, size
, size
, printcharfun
, 0);
570 temp_output_buffer_setup (bufname
)
573 int count
= specpdl_ptr
- specpdl
;
574 register struct buffer
*old
= current_buffer
;
575 register Lisp_Object buf
;
577 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
579 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
581 current_buffer
->directory
= old
->directory
;
582 current_buffer
->read_only
= Qnil
;
583 current_buffer
->filename
= Qnil
;
584 current_buffer
->undo_list
= Qt
;
585 current_buffer
->overlays_before
= Qnil
;
586 current_buffer
->overlays_after
= Qnil
;
587 current_buffer
->enable_multibyte_characters
588 = buffer_defaults
.enable_multibyte_characters
;
590 XSETBUFFER (buf
, current_buffer
);
592 call1 (Vrun_hooks
, Qtemp_buffer_setup_hook
);
594 unbind_to (count
, Qnil
);
596 specbind (Qstandard_output
, buf
);
600 internal_with_output_to_temp_buffer (bufname
, function
, args
)
602 Lisp_Object (*function
) P_ ((Lisp_Object
));
605 int count
= specpdl_ptr
- specpdl
;
606 Lisp_Object buf
, val
;
610 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
611 temp_output_buffer_setup (bufname
);
612 buf
= Vstandard_output
;
615 val
= (*function
) (args
);
618 temp_output_buffer_show (buf
);
621 return unbind_to (count
, val
);
624 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
626 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
627 The buffer is cleared out initially, and marked as unmodified when done.\n\
628 All output done by BODY is inserted in that buffer by default.\n\
629 The buffer is displayed in another window, but not selected.\n\
630 The value of the last form in BODY is returned.\n\
631 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\
633 The hook `temp-buffer-setup-hook' is run before BODY,\n\
634 with the buffer BUFNAME temporarily current.\n\
635 The hook `temp-buffer-show-hook' is run after the buffer is displayed,\n\
636 with the buffer temporarily current, and the window that was used\n\
637 to display it temporarily selected.\n\
639 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
640 to get the buffer displayed instead of just displaying the non-selected\n\
641 buffer and calling the hook. It gets one argument, the buffer to display.")
647 int count
= specpdl_ptr
- specpdl
;
648 Lisp_Object buf
, val
;
651 name
= Feval (Fcar (args
));
654 CHECK_STRING (name
, 0);
655 temp_output_buffer_setup (XSTRING (name
)->data
);
656 buf
= Vstandard_output
;
658 val
= Fprogn (Fcdr (args
));
660 temp_output_buffer_show (buf
);
662 return unbind_to (count
, val
);
666 static void print ();
668 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
669 "Output a newline to stream PRINTCHARFUN.\n\
670 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
672 Lisp_Object printcharfun
;
676 if (NILP (printcharfun
))
677 printcharfun
= Vstandard_output
;
684 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
685 "Output the printed representation of OBJECT, any Lisp object.\n\
686 Quoting characters are printed when needed to make output that `read'\n\
687 can handle, whenever this is possible.\n\
688 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
689 (object
, printcharfun
)
690 Lisp_Object object
, printcharfun
;
694 #ifdef MAX_PRINT_CHARS
696 #endif /* MAX_PRINT_CHARS */
697 if (NILP (printcharfun
))
698 printcharfun
= Vstandard_output
;
701 print (object
, printcharfun
, 1);
706 /* a buffer which is used to hold output being built by prin1-to-string */
707 Lisp_Object Vprin1_to_string_buffer
;
709 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
710 "Return a string containing the printed representation of OBJECT,\n\
711 any Lisp object. Quoting characters are used when needed to make output\n\
712 that `read' can handle, whenever this is possible, unless the optional\n\
713 second argument NOESCAPE is non-nil.")
715 Lisp_Object object
, noescape
;
718 Lisp_Object printcharfun
;
719 struct gcpro gcpro1
, gcpro2
;
722 /* Save and restore this--we are altering a buffer
723 but we don't want to deactivate the mark just for that.
724 No need for specbind, since errors deactivate the mark. */
725 tem
= Vdeactivate_mark
;
726 GCPRO2 (object
, tem
);
728 printcharfun
= Vprin1_to_string_buffer
;
731 print (object
, printcharfun
, NILP (noescape
));
732 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
734 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
735 object
= Fbuffer_string ();
738 set_buffer_internal (old
);
740 Vdeactivate_mark
= tem
;
746 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
747 "Output the printed representation of OBJECT, any Lisp object.\n\
748 No quoting characters are used; no delimiters are printed around\n\
749 the contents of strings.\n\
750 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
751 (object
, printcharfun
)
752 Lisp_Object object
, printcharfun
;
756 if (NILP (printcharfun
))
757 printcharfun
= Vstandard_output
;
760 print (object
, printcharfun
, 0);
765 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
766 "Output the printed representation of OBJECT, with newlines around it.\n\
767 Quoting characters are printed when needed to make output that `read'\n\
768 can handle, whenever this is possible.\n\
769 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
770 (object
, printcharfun
)
771 Lisp_Object object
, printcharfun
;
776 #ifdef MAX_PRINT_CHARS
778 max_print
= MAX_PRINT_CHARS
;
779 #endif /* MAX_PRINT_CHARS */
780 if (NILP (printcharfun
))
781 printcharfun
= Vstandard_output
;
786 print (object
, printcharfun
, 1);
789 #ifdef MAX_PRINT_CHARS
792 #endif /* MAX_PRINT_CHARS */
797 /* The subroutine object for external-debugging-output is kept here
798 for the convenience of the debugger. */
799 Lisp_Object Qexternal_debugging_output
;
801 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
802 "Write CHARACTER to stderr.\n\
803 You can call print while debugging emacs, and pass it this function\n\
804 to make it write to the debugging output.\n")
806 Lisp_Object character
;
808 CHECK_NUMBER (character
, 0);
809 putc (XINT (character
), stderr
);
812 /* Send the output to a debugger (nothing happens if there isn't one). */
814 char buf
[2] = {(char) XINT (character
), '\0'};
815 OutputDebugString (buf
);
822 /* This is the interface for debugging printing. */
828 Fprin1 (arg
, Qexternal_debugging_output
);
829 fprintf (stderr
, "\r\n");
832 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
834 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
838 struct buffer
*old
= current_buffer
;
839 Lisp_Object original
, printcharfun
, value
;
842 /* If OBJ is (error STRING), just return STRING.
843 That is not only faster, it also avoids the need to allocate
844 space here when the error is due to memory full. */
845 if (CONSP (obj
) && EQ (XCONS (obj
)->car
, Qerror
)
846 && CONSP (XCONS (obj
)->cdr
)
847 && STRINGP (XCONS (XCONS (obj
)->cdr
)->car
)
848 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
849 return XCONS (XCONS (obj
)->cdr
)->car
;
851 print_error_message (obj
, Vprin1_to_string_buffer
);
853 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
854 value
= Fbuffer_string ();
858 set_buffer_internal (old
);
864 /* Print an error message for the error DATA
865 onto Lisp output stream STREAM (suitable for the print functions). */
868 print_error_message (data
, stream
)
869 Lisp_Object data
, stream
;
871 Lisp_Object errname
, errmsg
, file_error
, tail
;
875 errname
= Fcar (data
);
877 if (EQ (errname
, Qerror
))
880 if (!CONSP (data
)) data
= Qnil
;
881 errmsg
= Fcar (data
);
886 errmsg
= Fget (errname
, Qerror_message
);
887 file_error
= Fmemq (Qfile_error
,
888 Fget (errname
, Qerror_conditions
));
891 /* Print an error message including the data items. */
893 tail
= Fcdr_safe (data
);
896 /* For file-error, make error message by concatenating
897 all the data items. They are all strings. */
898 if (!NILP (file_error
) && CONSP (tail
))
899 errmsg
= XCONS (tail
)->car
, tail
= XCONS (tail
)->cdr
;
901 if (STRINGP (errmsg
))
902 Fprinc (errmsg
, stream
);
904 write_string_1 ("peculiar error", -1, stream
);
906 for (i
= 0; CONSP (tail
); tail
= Fcdr (tail
), i
++)
908 write_string_1 (i
? ", " : ": ", 2, stream
);
909 if (!NILP (file_error
))
910 Fprinc (Fcar (tail
), stream
);
912 Fprin1 (Fcar (tail
), stream
);
917 #ifdef LISP_FLOAT_TYPE
920 * The buffer should be at least as large as the max string size of the
921 * largest float, printed in the biggest notation. This is undoubtedly
922 * 20d float_output_format, with the negative of the C-constant "HUGE"
925 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
927 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
928 * case of -1e307 in 20d float_output_format. What is one to do (short of
929 * re-writing _doprnt to be more sane)?
934 float_to_string (buf
, data
)
941 /* Check for plus infinity in a way that won't lose
942 if there is no plus infinity. */
943 if (data
== data
/ 2 && data
> 1.0)
945 strcpy (buf
, "1.0e+INF");
948 /* Likewise for minus infinity. */
949 if (data
== data
/ 2 && data
< -1.0)
951 strcpy (buf
, "-1.0e+INF");
954 /* Check for NaN in a way that won't fail if there are no NaNs. */
955 if (! (data
* 0.0 >= 0.0))
957 strcpy (buf
, "0.0e+NaN");
961 if (NILP (Vfloat_output_format
)
962 || !STRINGP (Vfloat_output_format
))
965 /* Generate the fewest number of digits that represent the
966 floating point value without losing information.
967 The following method is simple but a bit slow.
968 For ideas about speeding things up, please see:
970 Guy L Steele Jr & Jon L White, How to print floating-point numbers
971 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
973 Robert G Burger & R Kent Dybvig, Printing floating point numbers
974 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
976 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
978 sprintf (buf
, "%.*g", width
, data
);
979 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
983 /* Check that the spec we have is fully valid.
984 This means not only valid for printf,
985 but meant for floats, and reasonable. */
986 cp
= XSTRING (Vfloat_output_format
)->data
;
995 /* Check the width specification. */
997 if ('0' <= *cp
&& *cp
<= '9')
1001 width
= (width
* 10) + (*cp
++ - '0');
1002 while (*cp
>= '0' && *cp
<= '9');
1004 /* A precision of zero is valid only for %f. */
1006 || (width
== 0 && *cp
!= 'f'))
1010 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1016 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
1019 /* Make sure there is a decimal point with digit after, or an
1020 exponent, so that the value is readable as a float. But don't do
1021 this with "%.0f"; it's valid for that not to produce a decimal
1022 point. Note that width can be 0 only for %.0f. */
1025 for (cp
= buf
; *cp
; cp
++)
1026 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1029 if (*cp
== '.' && cp
[1] == 0)
1043 #endif /* LISP_FLOAT_TYPE */
1046 print (obj
, printcharfun
, escapeflag
)
1048 register Lisp_Object printcharfun
;
1055 #if 1 /* I'm not sure this is really worth doing. */
1056 /* Detect circularities and truncate them.
1057 No need to offer any alternative--this is better than an error. */
1058 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
1061 for (i
= 0; i
< print_depth
; i
++)
1062 if (EQ (obj
, being_printed
[i
]))
1064 sprintf (buf
, "#%d", i
);
1065 strout (buf
, -1, -1, printcharfun
, 0);
1071 being_printed
[print_depth
] = obj
;
1074 if (print_depth
> PRINT_CIRCLE
)
1075 error ("Apparently circular structure being printed");
1076 #ifdef MAX_PRINT_CHARS
1077 if (max_print
&& print_chars
> max_print
)
1082 #endif /* MAX_PRINT_CHARS */
1084 switch (XGCTYPE (obj
))
1087 if (sizeof (int) == sizeof (EMACS_INT
))
1088 sprintf (buf
, "%d", XINT (obj
));
1089 else if (sizeof (long) == sizeof (EMACS_INT
))
1090 sprintf (buf
, "%ld", XINT (obj
));
1093 strout (buf
, -1, -1, printcharfun
, 0);
1096 #ifdef LISP_FLOAT_TYPE
1099 char pigbuf
[350]; /* see comments in float_to_string */
1101 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
1102 strout (pigbuf
, -1, -1, printcharfun
, 0);
1109 print_string (obj
, printcharfun
);
1112 register int i
, i_byte
;
1113 register unsigned char c
;
1114 struct gcpro gcpro1
;
1117 /* 1 means we must ensure that the next character we output
1118 cannot be taken as part of a hex character escape. */
1119 int need_nonhex
= 0;
1123 #ifdef USE_TEXT_PROPERTIES
1124 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1132 str
= XSTRING (obj
)->data
;
1133 size_byte
= STRING_BYTES (XSTRING (obj
));
1135 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1137 /* Here, we must convert each multi-byte form to the
1138 corresponding character code before handing it to PRINTCHAR. */
1142 if (STRING_MULTIBYTE (obj
))
1144 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
,
1145 size_byte
- i_byte
, len
);
1146 if (CHAR_VALID_P (c
, 0))
1156 if (c
== '\n' && print_escape_newlines
)
1161 else if (c
== '\f' && print_escape_newlines
)
1166 else if (! SINGLE_BYTE_CHAR_P (c
) && print_escape_multibyte
)
1168 /* When multibyte is disabled,
1169 print multibyte string chars using hex escapes. */
1170 unsigned char outbuf
[50];
1171 sprintf (outbuf
, "\\x%x", c
);
1172 strout (outbuf
, -1, -1, printcharfun
, 0);
1175 else if (SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1176 && print_escape_nonascii
)
1178 /* When printing in a multibyte buffer
1179 or when explicitly requested,
1180 print single-byte non-ASCII string chars
1181 using octal escapes. */
1182 unsigned char outbuf
[5];
1183 sprintf (outbuf
, "\\%03o", c
);
1184 strout (outbuf
, -1, -1, printcharfun
, 0);
1188 /* If we just had a hex escape, and this character
1189 could be taken as part of it,
1190 output `\ ' to prevent that. */
1194 if ((c
>= 'a' && c
<= 'f')
1195 || (c
>= 'A' && c
<= 'F')
1196 || (c
>= '0' && c
<= '9'))
1197 strout ("\\ ", -1, -1, printcharfun
, 0);
1200 if (c
== '\"' || c
== '\\')
1207 #ifdef USE_TEXT_PROPERTIES
1208 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1210 traverse_intervals (XSTRING (obj
)->intervals
,
1211 0, 0, print_interval
, printcharfun
);
1222 register int confusing
;
1223 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
1224 register unsigned char *end
= p
+ STRING_BYTES (XSYMBOL (obj
)->name
);
1226 int i
, i_byte
, size_byte
;
1229 XSETSTRING (name
, XSYMBOL (obj
)->name
);
1231 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1234 /* If symbol name begins with a digit, and ends with a digit,
1235 and contains nothing but digits and `e', it could be treated
1236 as a number. So set CONFUSING.
1238 Symbols that contain periods could also be taken as numbers,
1239 but periods are always escaped, so we don't have to worry
1241 else if (*p
>= '0' && *p
<= '9'
1242 && end
[-1] >= '0' && end
[-1] <= '9')
1244 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1245 /* Needed for \2e10. */
1248 confusing
= (end
== p
);
1253 /* If we print an uninterned symbol as part of a complex object and
1254 the flag print-gensym is non-nil, prefix it with #n= to read the
1255 object back with the #n# reader syntax later if needed. */
1256 if (! NILP (Vprint_gensym
) && NILP (XSYMBOL (obj
)->obarray
))
1258 if (print_depth
> 1)
1261 tem
= Fassq (obj
, Vprint_gensym_alist
);
1265 print (XCDR (tem
), printcharfun
, escapeflag
);
1271 if (CONSP (Vprint_gensym_alist
))
1272 XSETFASTINT (tem
, XFASTINT (XCDR (XCAR (Vprint_gensym_alist
))) + 1);
1274 XSETFASTINT (tem
, 1);
1275 Vprint_gensym_alist
= Fcons (Fcons (obj
, tem
), Vprint_gensym_alist
);
1278 print (tem
, printcharfun
, escapeflag
);
1286 size_byte
= STRING_BYTES (XSTRING (name
));
1288 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1290 /* Here, we must convert each multi-byte form to the
1291 corresponding character code before handing it to PRINTCHAR. */
1293 if (STRING_MULTIBYTE (name
))
1294 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1296 c
= XSTRING (name
)->data
[i_byte
++];
1302 if (c
== '\"' || c
== '\\' || c
== '\''
1303 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1304 || c
== ',' || c
=='.' || c
== '`'
1305 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1307 PRINTCHAR ('\\'), confusing
= 0;
1315 /* If deeper than spec'd depth, print placeholder. */
1316 if (INTEGERP (Vprint_level
)
1317 && print_depth
> XINT (Vprint_level
))
1318 strout ("...", -1, -1, printcharfun
, 0);
1319 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1320 && (EQ (XCAR (obj
), Qquote
)))
1323 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1325 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1326 && (EQ (XCAR (obj
), Qfunction
)))
1330 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1332 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1333 && ((EQ (XCAR (obj
), Qbackquote
)
1334 || EQ (XCAR (obj
), Qcomma
)
1335 || EQ (XCAR (obj
), Qcomma_at
)
1336 || EQ (XCAR (obj
), Qcomma_dot
))))
1338 print (XCAR (obj
), printcharfun
, 0);
1339 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1346 register int print_length
= 0;
1347 Lisp_Object halftail
= obj
;
1349 if (INTEGERP (Vprint_length
))
1350 print_length
= XINT (Vprint_length
);
1353 /* Detect circular list. */
1354 if (i
!= 0 && EQ (obj
, halftail
))
1356 sprintf (buf
, " . #%d", i
/ 2);
1357 strout (buf
, -1, -1, printcharfun
, 0);
1363 if (print_length
&& i
> print_length
)
1365 strout ("...", 3, 3, printcharfun
, 0);
1368 print (XCAR (obj
), printcharfun
, escapeflag
);
1371 halftail
= XCDR (halftail
);
1376 strout (" . ", 3, 3, printcharfun
, 0);
1377 print (obj
, printcharfun
, escapeflag
);
1383 case Lisp_Vectorlike
:
1388 strout ("#<process ", -1, -1, printcharfun
, 0);
1389 print_string (XPROCESS (obj
)->name
, printcharfun
);
1393 print_string (XPROCESS (obj
)->name
, printcharfun
);
1395 else if (BOOL_VECTOR_P (obj
))
1398 register unsigned char c
;
1399 struct gcpro gcpro1
;
1401 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1407 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1408 strout (buf
, -1, -1, printcharfun
, 0);
1411 /* Don't print more characters than the specified maximum. */
1412 if (INTEGERP (Vprint_length
)
1413 && XINT (Vprint_length
) < size_in_chars
)
1414 size_in_chars
= XINT (Vprint_length
);
1416 for (i
= 0; i
< size_in_chars
; i
++)
1419 c
= XBOOL_VECTOR (obj
)->data
[i
];
1420 if (c
== '\n' && print_escape_newlines
)
1425 else if (c
== '\f' && print_escape_newlines
)
1432 if (c
== '\"' || c
== '\\')
1441 else if (SUBRP (obj
))
1443 strout ("#<subr ", -1, -1, printcharfun
, 0);
1444 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1447 else if (WINDOWP (obj
))
1449 strout ("#<window ", -1, -1, printcharfun
, 0);
1450 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1451 strout (buf
, -1, -1, printcharfun
, 0);
1452 if (!NILP (XWINDOW (obj
)->buffer
))
1454 strout (" on ", -1, -1, printcharfun
, 0);
1455 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1459 else if (HASH_TABLE_P (obj
))
1461 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1462 strout ("#<hash-table", -1, -1, printcharfun
, 0);
1463 if (SYMBOLP (h
->test
))
1467 strout (XSYMBOL (h
->test
)->name
->data
, -1, -1, printcharfun
, 0);
1469 strout (XSYMBOL (h
->weak
)->name
->data
, -1, -1, printcharfun
, 0);
1471 sprintf (buf
, "%d/%d", XFASTINT (h
->count
),
1472 XVECTOR (h
->next
)->size
);
1473 strout (buf
, -1, -1, printcharfun
, 0);
1475 sprintf (buf
, " 0x%lx", (unsigned long) h
);
1476 strout (buf
, -1, -1, printcharfun
, 0);
1479 else if (BUFFERP (obj
))
1481 if (NILP (XBUFFER (obj
)->name
))
1482 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1483 else if (escapeflag
)
1485 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1486 print_string (XBUFFER (obj
)->name
, printcharfun
);
1490 print_string (XBUFFER (obj
)->name
, printcharfun
);
1492 else if (WINDOW_CONFIGURATIONP (obj
))
1494 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1496 else if (FRAMEP (obj
))
1498 strout ((FRAME_LIVE_P (XFRAME (obj
))
1499 ? "#<frame " : "#<dead frame "),
1500 -1, -1, printcharfun
, 0);
1501 print_string (XFRAME (obj
)->name
, printcharfun
);
1502 sprintf (buf
, " 0x%lx\\ ", (unsigned long) (XFRAME (obj
)));
1503 strout (buf
, -1, -1, printcharfun
, 0);
1508 int size
= XVECTOR (obj
)->size
;
1509 if (COMPILEDP (obj
))
1512 size
&= PSEUDOVECTOR_SIZE_MASK
;
1514 if (CHAR_TABLE_P (obj
))
1516 /* We print a char-table as if it were a vector,
1517 lumping the parent and default slots in with the
1518 character slots. But we add #^ as a prefix. */
1521 if (SUB_CHAR_TABLE_P (obj
))
1523 size
&= PSEUDOVECTOR_SIZE_MASK
;
1525 if (size
& PSEUDOVECTOR_FLAG
)
1531 register Lisp_Object tem
;
1533 /* Don't print more elements than the specified maximum. */
1534 if (INTEGERP (Vprint_length
)
1535 && XINT (Vprint_length
) < size
)
1536 size
= XINT (Vprint_length
);
1538 for (i
= 0; i
< size
; i
++)
1540 if (i
) PRINTCHAR (' ');
1541 tem
= XVECTOR (obj
)->contents
[i
];
1542 print (tem
, printcharfun
, escapeflag
);
1550 switch (XMISCTYPE (obj
))
1552 case Lisp_Misc_Marker
:
1553 strout ("#<marker ", -1, -1, printcharfun
, 0);
1554 /* Do you think this is necessary? */
1555 if (XMARKER (obj
)->insertion_type
!= 0)
1556 strout ("(before-insertion) ", -1, -1, printcharfun
, 0);
1557 if (!(XMARKER (obj
)->buffer
))
1558 strout ("in no buffer", -1, -1, printcharfun
, 0);
1561 sprintf (buf
, "at %d", marker_position (obj
));
1562 strout (buf
, -1, -1, printcharfun
, 0);
1563 strout (" in ", -1, -1, printcharfun
, 0);
1564 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1569 case Lisp_Misc_Overlay
:
1570 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1571 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1572 strout ("in no buffer", -1, -1, printcharfun
, 0);
1575 sprintf (buf
, "from %d to %d in ",
1576 marker_position (OVERLAY_START (obj
)),
1577 marker_position (OVERLAY_END (obj
)));
1578 strout (buf
, -1, -1, printcharfun
, 0);
1579 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1585 /* Remaining cases shouldn't happen in normal usage, but let's print
1586 them anyway for the benefit of the debugger. */
1587 case Lisp_Misc_Free
:
1588 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1591 case Lisp_Misc_Intfwd
:
1592 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1593 strout (buf
, -1, -1, printcharfun
, 0);
1596 case Lisp_Misc_Boolfwd
:
1597 sprintf (buf
, "#<boolfwd to %s>",
1598 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1599 strout (buf
, -1, -1, printcharfun
, 0);
1602 case Lisp_Misc_Objfwd
:
1603 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
1604 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1608 case Lisp_Misc_Buffer_Objfwd
:
1609 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
1610 print (*(Lisp_Object
*)((char *)current_buffer
1611 + XBUFFER_OBJFWD (obj
)->offset
),
1612 printcharfun
, escapeflag
);
1616 case Lisp_Misc_Kboard_Objfwd
:
1617 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
1618 print (*(Lisp_Object
*)((char *) current_kboard
1619 + XKBOARD_OBJFWD (obj
)->offset
),
1620 printcharfun
, escapeflag
);
1624 case Lisp_Misc_Buffer_Local_Value
:
1625 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
1626 goto do_buffer_local
;
1627 case Lisp_Misc_Some_Buffer_Local_Value
:
1628 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
1630 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
1631 print (XBUFFER_LOCAL_VALUE (obj
)->realvalue
, printcharfun
, escapeflag
);
1632 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
1633 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
1635 strout ("[buffer] ", -1, -1, printcharfun
, 0);
1636 print (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
1637 printcharfun
, escapeflag
);
1638 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
1640 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
1641 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
1643 strout ("[frame] ", -1, -1, printcharfun
, 0);
1644 print (XBUFFER_LOCAL_VALUE (obj
)->frame
,
1645 printcharfun
, escapeflag
);
1647 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
1648 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1649 printcharfun
, escapeflag
);
1650 strout ("[default-value] ", -1, -1, printcharfun
, 0);
1651 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
,
1652 printcharfun
, escapeflag
);
1664 /* We're in trouble if this happens!
1665 Probably should just abort () */
1666 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
1668 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1669 else if (VECTORLIKEP (obj
))
1670 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1672 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1673 strout (buf
, -1, -1, printcharfun
, 0);
1674 strout (" Save your buffers immediately and please report this bug>",
1675 -1, -1, printcharfun
, 0);
1682 #ifdef USE_TEXT_PROPERTIES
1684 /* Print a description of INTERVAL using PRINTCHARFUN.
1685 This is part of printing a string that has text properties. */
1688 print_interval (interval
, printcharfun
)
1690 Lisp_Object printcharfun
;
1693 print (make_number (interval
->position
), printcharfun
, 1);
1695 print (make_number (interval
->position
+ LENGTH (interval
)),
1698 print (interval
->plist
, printcharfun
, 1);
1701 #endif /* USE_TEXT_PROPERTIES */
1706 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
1707 staticpro (&Qtemp_buffer_setup_hook
);
1709 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1710 "Output stream `print' uses by default for outputting a character.\n\
1711 This may be any function of one argument.\n\
1712 It may also be a buffer (output is inserted before point)\n\
1713 or a marker (output is inserted and the marker is advanced)\n\
1714 or the symbol t (output appears in the echo area).");
1715 Vstandard_output
= Qt
;
1716 Qstandard_output
= intern ("standard-output");
1717 staticpro (&Qstandard_output
);
1719 #ifdef LISP_FLOAT_TYPE
1720 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1721 "The format descriptor string used to print floats.\n\
1722 This is a %-spec like those accepted by `printf' in C,\n\
1723 but with some restrictions. It must start with the two characters `%.'.\n\
1724 After that comes an integer precision specification,\n\
1725 and then a letter which controls the format.\n\
1726 The letters allowed are `e', `f' and `g'.\n\
1727 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1728 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1729 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1730 The precision in any of these cases is the number of digits following\n\
1731 the decimal point. With `f', a precision of 0 means to omit the\n\
1732 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1733 A value of nil means to use the shortest notation\n\
1734 that represents the number without losing information.");
1735 Vfloat_output_format
= Qnil
;
1736 Qfloat_output_format
= intern ("float-output-format");
1737 staticpro (&Qfloat_output_format
);
1738 #endif /* LISP_FLOAT_TYPE */
1740 DEFVAR_LISP ("print-length", &Vprint_length
,
1741 "Maximum length of list to print before abbreviating.\n\
1742 A value of nil means no limit.");
1743 Vprint_length
= Qnil
;
1745 DEFVAR_LISP ("print-level", &Vprint_level
,
1746 "Maximum depth of list nesting to print before abbreviating.\n\
1747 A value of nil means no limit.");
1748 Vprint_level
= Qnil
;
1750 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1751 "Non-nil means print newlines in strings as backslash-n.\n\
1752 Also print formfeeds as backslash-f.");
1753 print_escape_newlines
= 0;
1755 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
1756 "Non-nil means print unibyte non-ASCII chars in strings as \\OOO.\n\
1757 \(OOO is the octal representation of the character code.)\n\
1758 Only single-byte characters are affected, and only in `prin1'.");
1759 print_escape_nonascii
= 0;
1761 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
1762 "Non-nil means print multibyte characters in strings as \\xXXXX.\n\
1763 \(XXX is the hex representation of the character code.)\n\
1764 This affects only `prin1'.");
1765 print_escape_multibyte
= 0;
1767 DEFVAR_BOOL ("print-quoted", &print_quoted
,
1768 "Non-nil means print quoted forms with reader syntax.\n\
1769 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\
1770 forms print in the new syntax.");
1773 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
1774 "Non-nil means print uninterned symbols so they will read as uninterned.\n\
1775 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\
1776 When the uninterned symbol appears within a larger data structure,\n\
1777 in addition use the #...# and #...= constructs as needed,\n\
1778 so that multiple references to the same symbol are shared once again\n\
1779 when the text is read back.\n\
1781 If the value of `print-gensym' is a cons cell, then in addition refrain from\n\
1782 clearing `print-gensym-alist' on entry to and exit from printing functions,\n\
1783 so that the use of #...# and #...= can carry over for several separately\n\
1785 Vprint_gensym
= Qnil
;
1787 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist
,
1788 "Association list of elements (GENSYM . N) to guide use of #N# and #N=.\n\
1789 In each element, GENSYM is an uninterned symbol that has been associated\n\
1790 with #N= for the specified value of N.");
1791 Vprint_gensym_alist
= Qnil
;
1793 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1794 staticpro (&Vprin1_to_string_buffer
);
1797 defsubr (&Sprin1_to_string
);
1798 defsubr (&Serror_message_string
);
1802 defsubr (&Swrite_char
);
1803 defsubr (&Sexternal_debugging_output
);
1805 Qexternal_debugging_output
= intern ("external-debugging-output");
1806 staticpro (&Qexternal_debugging_output
);
1808 Qprint_escape_newlines
= intern ("print-escape-newlines");
1809 staticpro (&Qprint_escape_newlines
);
1811 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
1812 staticpro (&Qprint_escape_multibyte
);
1814 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
1815 staticpro (&Qprint_escape_nonascii
);
1817 defsubr (&Swith_output_to_temp_buffer
);