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. */
33 #include "dispextern.h"
36 #endif /* not standalone */
38 #ifdef USE_TEXT_PROPERTIES
39 #include "intervals.h"
42 Lisp_Object Vstandard_output
, Qstandard_output
;
44 /* These are used to print like we read. */
45 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
47 #ifdef LISP_FLOAT_TYPE
48 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
50 /* Work around a problem that happens because math.h on hpux 7
51 defines two static variables--which, in Emacs, are not really static,
52 because `static' is defined as nothing. The problem is that they are
53 defined both here and in lread.c.
54 These macros prevent the name conflict. */
55 #if defined (HPUX) && !defined (HPUX8)
56 #define _MAXLDBL print_maxldbl
57 #define _NMAXLDBL print_nmaxldbl
67 /* Default to values appropriate for IEEE floating point. */
72 #define DBL_MANT_DIG 53
78 #define DBL_MIN 2.2250738585072014e-308
81 #ifdef DBL_MIN_REPLACEMENT
83 #define DBL_MIN DBL_MIN_REPLACEMENT
86 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
87 needed to express a float without losing information.
88 The general-case formula is valid for the usual case, IEEE floating point,
89 but many compilers can't optimize the formula to an integer constant,
90 so make a special case for it. */
91 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
92 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
94 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
97 #endif /* LISP_FLOAT_TYPE */
99 /* Avoid actual stack overflow in print. */
102 /* Detect most circularities to print finite output. */
103 #define PRINT_CIRCLE 200
104 Lisp_Object being_printed
[PRINT_CIRCLE
];
106 /* When printing into a buffer, first we put the text in this
107 block, then insert it all at once. */
110 /* Size allocated in print_buffer. */
111 int print_buffer_size
;
112 /* Chars stored in print_buffer. */
113 int print_buffer_pos
;
114 /* Bytes stored in print_buffer. */
115 int print_buffer_pos_byte
;
117 /* Maximum length of list to print in full; noninteger means
118 effectively infinity */
120 Lisp_Object Vprint_length
;
122 /* Maximum depth of list to print in full; noninteger means
123 effectively infinity. */
125 Lisp_Object Vprint_level
;
127 /* Nonzero means print newlines in strings as \n. */
129 int print_escape_newlines
;
131 Lisp_Object Qprint_escape_newlines
;
133 /* Nonzero means print (quote foo) forms as 'foo, etc. */
137 /* Non-nil means print #: before uninterned symbols.
138 Neither t nor nil means so that and don't clear Vprint_gensym_alist
139 on entry to and exit from print functions. */
141 Lisp_Object Vprint_gensym
;
143 /* Association list of certain objects that are `eq' in the form being
144 printed and which should be `eq' when read back in, using the #n=object
145 and #n# reader forms. Each element has the form (object . n). */
147 Lisp_Object Vprint_gensym_alist
;
149 /* Nonzero means print newline to stdout before next minibuffer message.
150 Defined in xdisp.c */
152 extern int noninteractive_need_newline
;
154 extern int minibuffer_auto_raise
;
156 #ifdef MAX_PRINT_CHARS
157 static int print_chars
;
158 static int max_print
;
159 #endif /* MAX_PRINT_CHARS */
161 void print_interval ();
164 /* Convert between chars and GLYPHs */
168 register GLYPH
*glyphs
;
178 str_to_glyph_cpy (str
, glyphs
)
182 register GLYPH
*gp
= glyphs
;
183 register char *cp
= str
;
190 str_to_glyph_ncpy (str
, glyphs
, n
)
195 register GLYPH
*gp
= glyphs
;
196 register char *cp
= str
;
203 glyph_to_str_cpy (glyphs
, str
)
207 register GLYPH
*gp
= glyphs
;
208 register char *cp
= str
;
211 *str
++ = *gp
++ & 0377;
215 /* Low level output routines for characters and strings */
217 /* Lisp functions to do output using a stream
218 must have the stream in a variable called printcharfun
219 and must start with PRINTPREPARE, end with PRINTFINISH,
220 and use PRINTDECLARE to declare common variables.
221 Use PRINTCHAR to output one character,
222 or call strout to output a block of characters.
225 #define PRINTDECLARE \
226 struct buffer *old = current_buffer; \
227 int old_point = -1, start_point; \
228 int old_point_byte, start_point_byte; \
229 int specpdl_count = specpdl_ptr - specpdl; \
230 int free_print_buffer = 0; \
233 #define PRINTPREPARE \
234 original = printcharfun; \
235 if (NILP (printcharfun)) printcharfun = Qt; \
236 if (BUFFERP (printcharfun)) \
238 if (XBUFFER (printcharfun) != current_buffer) \
239 Fset_buffer (printcharfun); \
240 printcharfun = Qnil; \
242 if (MARKERP (printcharfun)) \
244 if (!(XMARKER (original)->buffer)) \
245 error ("Marker does not point anywhere"); \
246 if (XMARKER (original)->buffer != current_buffer) \
247 set_buffer_internal (XMARKER (original)->buffer); \
249 old_point_byte = PT_BYTE; \
250 SET_PT_BOTH (marker_position (printcharfun), \
251 marker_byte_position (printcharfun)); \
253 start_point_byte = PT_BYTE; \
254 printcharfun = Qnil; \
256 if (NILP (printcharfun)) \
258 Lisp_Object string; \
259 if (print_buffer != 0) \
261 string = make_string_from_bytes (print_buffer, \
263 print_buffer_pos_byte); \
264 record_unwind_protect (print_unwind, string); \
268 print_buffer_size = 1000; \
269 print_buffer = (char *) xmalloc (print_buffer_size); \
270 free_print_buffer = 1; \
272 print_buffer_pos = 0; \
273 print_buffer_pos_byte = 0; \
275 if (!CONSP (Vprint_gensym)) \
276 Vprint_gensym_alist = Qnil
278 #define PRINTFINISH \
279 if (NILP (printcharfun)) \
280 insert_1_both (print_buffer, print_buffer_pos, \
281 print_buffer_pos_byte, 0, 1, 0); \
282 if (free_print_buffer) \
284 xfree (print_buffer); \
287 unbind_to (specpdl_count, Qnil); \
288 if (MARKERP (original)) \
289 set_marker_both (original, Qnil, PT, PT_BYTE); \
290 if (old_point >= 0) \
291 SET_PT_BOTH (old_point + (old_point >= start_point \
292 ? PT - start_point : 0), \
293 old_point_byte + (old_point_byte >= start_point_byte \
294 ? PT_BYTE - start_point_byte : 0)); \
295 if (old != current_buffer) \
296 set_buffer_internal (old); \
297 if (!CONSP (Vprint_gensym)) \
298 Vprint_gensym_alist = Qnil
300 #define PRINTCHAR(ch) printchar (ch, printcharfun)
302 /* Nonzero if there is no room to print any more characters
303 so print might as well return right away. */
305 #define PRINTFULLP() \
306 (EQ (printcharfun, Qt) && !noninteractive \
307 && printbufidx >= FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)))))
309 /* This is used to restore the saved contents of print_buffer
310 when there is a recursive call to print. */
312 print_unwind (saved_text
)
313 Lisp_Object saved_text
;
315 bcopy (XSTRING (saved_text
)->data
, print_buffer
, XSTRING (saved_text
)->size
);
318 /* Index of first unused element of FRAME_MESSAGE_BUF (mini_frame). */
319 static int printbufidx
;
328 #ifdef MAX_PRINT_CHARS
331 #endif /* MAX_PRINT_CHARS */
336 unsigned char work
[4], *str
;
339 len
= CHAR_STRING (ch
, work
, str
);
340 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
341 print_buffer
= (char *) xrealloc (print_buffer
,
342 print_buffer_size
*= 2);
343 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
344 print_buffer_pos
+= 1;
345 print_buffer_pos_byte
+= len
;
352 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
353 unsigned char work
[4], *str
;
354 int len
= CHAR_STRING (ch
, work
, str
);
361 putchar (*str
), str
++;
362 noninteractive_need_newline
= 1;
366 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
367 || !message_buf_print
)
369 message_log_maybe_newline ();
370 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
372 echo_area_glyphs_length
= 0;
373 message_buf_print
= 1;
375 if (minibuffer_auto_raise
)
377 Lisp_Object mini_window
;
379 /* Get the frame containing the minibuffer
380 that the selected frame is using. */
381 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
383 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
387 message_dolog (str
, len
, 0, len
> 1);
389 /* Convert message to multibyte if we are now adding multibyte text. */
390 if (! NILP (current_buffer
->enable_multibyte_characters
)
391 && ! message_enable_multibyte
394 int size
= count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame
),
396 unsigned char *tembuf
= (unsigned char *) alloca (size
+ 1);
397 copy_text (FRAME_MESSAGE_BUF (mini_frame
), tembuf
, printbufidx
,
400 if (printbufidx
> FRAME_MESSAGE_BUF_SIZE (mini_frame
))
402 printbufidx
= FRAME_MESSAGE_BUF_SIZE (mini_frame
);
403 /* Rewind incomplete multi-byte form. */
404 while (printbufidx
> 0 && tembuf
[printbufidx
] >= 0xA0)
407 bcopy (tembuf
, FRAME_MESSAGE_BUF (mini_frame
), printbufidx
);
408 message_enable_multibyte
= 1;
411 if (printbufidx
< FRAME_MESSAGE_BUF_SIZE (mini_frame
) - len
)
412 bcopy (str
, &FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
], len
),
414 FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
] = 0;
415 echo_area_glyphs_length
= printbufidx
;
419 #endif /* not standalone */
421 XSETFASTINT (ch1
, ch
);
426 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
429 Lisp_Object printcharfun
;
435 size_byte
= size
= strlen (ptr
);
437 if (EQ (printcharfun
, Qnil
))
439 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
441 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
442 print_buffer
= (char *) xrealloc (print_buffer
,
445 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
446 print_buffer_pos
+= size
;
447 print_buffer_pos_byte
+= size_byte
;
449 #ifdef MAX_PRINT_CHARS
452 #endif /* MAX_PRINT_CHARS */
455 if (EQ (printcharfun
, Qt
))
458 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
462 #ifdef MAX_PRINT_CHARS
465 #endif /* MAX_PRINT_CHARS */
469 fwrite (ptr
, 1, size_byte
, stdout
);
470 noninteractive_need_newline
= 1;
474 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
475 || !message_buf_print
)
477 message_log_maybe_newline ();
478 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
480 echo_area_glyphs_length
= 0;
481 message_buf_print
= 1;
483 if (minibuffer_auto_raise
)
485 Lisp_Object mini_window
;
487 /* Get the frame containing the minibuffer
488 that the selected frame is using. */
489 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
491 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
495 message_dolog (ptr
, size_byte
, 0, multibyte
);
497 /* Convert message to multibyte if we are now adding multibyte text. */
499 && ! message_enable_multibyte
502 int size
= count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame
),
504 unsigned char *tembuf
= (unsigned char *) alloca (size
+ 1);
505 copy_text (FRAME_MESSAGE_BUF (mini_frame
), tembuf
, printbufidx
,
508 if (printbufidx
> FRAME_MESSAGE_BUF_SIZE (mini_frame
))
510 printbufidx
= FRAME_MESSAGE_BUF_SIZE (mini_frame
);
511 /* Rewind incomplete multi-byte form. */
512 while (printbufidx
> 0 && tembuf
[printbufidx
] >= 0xA0)
516 bcopy (tembuf
, FRAME_MESSAGE_BUF (mini_frame
), printbufidx
);
517 message_enable_multibyte
= 1;
520 /* Compute how much of the new text will fit there. */
521 if (size_byte
> FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1)
523 size_byte
= FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1;
524 /* Rewind incomplete multi-byte form. */
525 while (size_byte
&& (unsigned char) ptr
[size_byte
] >= 0xA0)
529 /* Put that part of the new text in. */
530 bcopy (ptr
, &FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
], size_byte
);
531 printbufidx
+= size_byte
;
532 FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
] = 0;
533 echo_area_glyphs_length
= printbufidx
;
539 if (size
== size_byte
)
540 while (i
< size_byte
)
547 while (i
< size_byte
)
549 /* Here, we must convert each multi-byte form to the
550 corresponding character code before handing it to PRINTCHAR. */
552 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
559 /* Print the contents of a string STRING using PRINTCHARFUN.
560 It isn't safe to use strout in many cases,
561 because printing one char can relocate. */
564 print_string (string
, printcharfun
)
566 Lisp_Object printcharfun
;
568 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
569 /* strout is safe for output to a frame (echo area) or to print_buffer. */
570 strout (XSTRING (string
)->data
,
571 XSTRING (string
)->size
,
572 STRING_BYTES (XSTRING (string
)),
573 printcharfun
, STRING_MULTIBYTE (string
));
576 /* Otherwise, string may be relocated by printing one char.
577 So re-fetch the string address for each character. */
579 int size
= XSTRING (string
)->size
;
580 int size_byte
= STRING_BYTES (XSTRING (string
));
583 if (size
== size_byte
)
584 for (i
= 0; i
< size
; i
++)
585 PRINTCHAR (XSTRING (string
)->data
[i
]);
587 for (i
= 0; i
< size_byte
; i
++)
589 /* Here, we must convert each multi-byte form to the
590 corresponding character code before handing it to PRINTCHAR. */
592 int ch
= STRING_CHAR_AND_CHAR_LENGTH (XSTRING (string
)->data
+ i
,
602 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
603 "Output character CHARACTER to stream PRINTCHARFUN.\n\
604 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
605 (character
, printcharfun
)
606 Lisp_Object character
, printcharfun
;
610 if (NILP (printcharfun
))
611 printcharfun
= Vstandard_output
;
612 CHECK_NUMBER (character
, 0);
614 PRINTCHAR (XINT (character
));
619 /* Used from outside of print.c to print a block of SIZE
620 single-byte chars at DATA on the default output stream.
621 Do not use this on the contents of a Lisp string. */
624 write_string (data
, size
)
629 Lisp_Object printcharfun
;
631 printcharfun
= Vstandard_output
;
634 strout (data
, size
, size
, printcharfun
, 0);
638 /* Used from outside of print.c to print a block of SIZE
639 single-byte chars at DATA on a specified stream PRINTCHARFUN.
640 Do not use this on the contents of a Lisp string. */
643 write_string_1 (data
, size
, printcharfun
)
646 Lisp_Object printcharfun
;
651 strout (data
, size
, size
, printcharfun
, 0);
659 temp_output_buffer_setup (bufname
)
662 register struct buffer
*old
= current_buffer
;
663 register Lisp_Object buf
;
665 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
667 current_buffer
->directory
= old
->directory
;
668 current_buffer
->read_only
= Qnil
;
669 current_buffer
->filename
= Qnil
;
670 current_buffer
->undo_list
= Qt
;
671 current_buffer
->overlays_before
= Qnil
;
672 current_buffer
->overlays_after
= Qnil
;
673 current_buffer
->enable_multibyte_characters
674 = buffer_defaults
.enable_multibyte_characters
;
677 XSETBUFFER (buf
, current_buffer
);
678 specbind (Qstandard_output
, buf
);
680 set_buffer_internal (old
);
684 internal_with_output_to_temp_buffer (bufname
, function
, args
)
686 Lisp_Object (*function
) P_ ((Lisp_Object
));
689 int count
= specpdl_ptr
- specpdl
;
690 Lisp_Object buf
, val
;
694 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
695 temp_output_buffer_setup (bufname
);
696 buf
= Vstandard_output
;
699 val
= (*function
) (args
);
702 temp_output_buffer_show (buf
);
705 return unbind_to (count
, val
);
708 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
710 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
711 The buffer is cleared out initially, and marked as unmodified when done.\n\
712 All output done by BODY is inserted in that buffer by default.\n\
713 The buffer is displayed in another window, but not selected.\n\
714 The value of the last form in BODY is returned.\n\
715 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
716 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
717 to get the buffer displayed. It gets one argument, the buffer to display.")
723 int count
= specpdl_ptr
- specpdl
;
724 Lisp_Object buf
, val
;
727 name
= Feval (Fcar (args
));
730 CHECK_STRING (name
, 0);
731 temp_output_buffer_setup (XSTRING (name
)->data
);
732 buf
= Vstandard_output
;
734 val
= Fprogn (Fcdr (args
));
736 temp_output_buffer_show (buf
);
738 return unbind_to (count
, val
);
740 #endif /* not standalone */
742 static void print ();
744 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
745 "Output a newline to stream PRINTCHARFUN.\n\
746 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
748 Lisp_Object printcharfun
;
752 if (NILP (printcharfun
))
753 printcharfun
= Vstandard_output
;
760 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
761 "Output the printed representation of OBJECT, any Lisp object.\n\
762 Quoting characters are printed when needed to make output that `read'\n\
763 can handle, whenever this is possible.\n\
764 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
765 (object
, printcharfun
)
766 Lisp_Object object
, printcharfun
;
770 #ifdef MAX_PRINT_CHARS
772 #endif /* MAX_PRINT_CHARS */
773 if (NILP (printcharfun
))
774 printcharfun
= Vstandard_output
;
777 print (object
, printcharfun
, 1);
782 /* a buffer which is used to hold output being built by prin1-to-string */
783 Lisp_Object Vprin1_to_string_buffer
;
785 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
786 "Return a string containing the printed representation of OBJECT,\n\
787 any Lisp object. Quoting characters are used when needed to make output\n\
788 that `read' can handle, whenever this is possible, unless the optional\n\
789 second argument NOESCAPE is non-nil.")
791 Lisp_Object object
, noescape
;
794 Lisp_Object printcharfun
;
795 struct gcpro gcpro1
, gcpro2
;
798 /* Save and restore this--we are altering a buffer
799 but we don't want to deactivate the mark just for that.
800 No need for specbind, since errors deactivate the mark. */
801 tem
= Vdeactivate_mark
;
802 GCPRO2 (object
, tem
);
804 printcharfun
= Vprin1_to_string_buffer
;
807 print (object
, printcharfun
, NILP (noescape
));
808 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
810 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
811 object
= Fbuffer_string ();
814 set_buffer_internal (old
);
816 Vdeactivate_mark
= tem
;
822 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
823 "Output the printed representation of OBJECT, any Lisp object.\n\
824 No quoting characters are used; no delimiters are printed around\n\
825 the contents of strings.\n\
826 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
827 (object
, printcharfun
)
828 Lisp_Object object
, printcharfun
;
832 if (NILP (printcharfun
))
833 printcharfun
= Vstandard_output
;
836 print (object
, printcharfun
, 0);
841 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
842 "Output the printed representation of OBJECT, with newlines around it.\n\
843 Quoting characters are printed when needed to make output that `read'\n\
844 can handle, whenever this is possible.\n\
845 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
846 (object
, printcharfun
)
847 Lisp_Object object
, printcharfun
;
852 #ifdef MAX_PRINT_CHARS
854 max_print
= MAX_PRINT_CHARS
;
855 #endif /* MAX_PRINT_CHARS */
856 if (NILP (printcharfun
))
857 printcharfun
= Vstandard_output
;
862 print (object
, printcharfun
, 1);
865 #ifdef MAX_PRINT_CHARS
868 #endif /* MAX_PRINT_CHARS */
873 /* The subroutine object for external-debugging-output is kept here
874 for the convenience of the debugger. */
875 Lisp_Object Qexternal_debugging_output
;
877 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
878 "Write CHARACTER to stderr.\n\
879 You can call print while debugging emacs, and pass it this function\n\
880 to make it write to the debugging output.\n")
882 Lisp_Object character
;
884 CHECK_NUMBER (character
, 0);
885 putc (XINT (character
), stderr
);
888 /* Send the output to a debugger (nothing happens if there isn't one). */
890 char buf
[2] = {(char) XINT (character
), '\0'};
891 OutputDebugString (buf
);
898 /* This is the interface for debugging printing. */
904 Fprin1 (arg
, Qexternal_debugging_output
);
905 fprintf (stderr
, "\r\n");
908 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
910 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
914 struct buffer
*old
= current_buffer
;
915 Lisp_Object original
, printcharfun
, value
;
918 /* If OBJ is (error STRING), just return STRING.
919 That is not only faster, it also avoids the need to allocate
920 space here when the error is due to memory full. */
921 if (CONSP (obj
) && EQ (XCONS (obj
)->car
, Qerror
)
922 && CONSP (XCONS (obj
)->cdr
)
923 && STRINGP (XCONS (XCONS (obj
)->cdr
)->car
)
924 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
925 return XCONS (XCONS (obj
)->cdr
)->car
;
927 print_error_message (obj
, Vprin1_to_string_buffer
);
929 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
930 value
= Fbuffer_string ();
934 set_buffer_internal (old
);
940 /* Print an error message for the error DATA
941 onto Lisp output stream STREAM (suitable for the print functions). */
944 print_error_message (data
, stream
)
945 Lisp_Object data
, stream
;
947 Lisp_Object errname
, errmsg
, file_error
, tail
;
951 errname
= Fcar (data
);
953 if (EQ (errname
, Qerror
))
956 if (!CONSP (data
)) data
= Qnil
;
957 errmsg
= Fcar (data
);
962 errmsg
= Fget (errname
, Qerror_message
);
963 file_error
= Fmemq (Qfile_error
,
964 Fget (errname
, Qerror_conditions
));
967 /* Print an error message including the data items. */
969 tail
= Fcdr_safe (data
);
972 /* For file-error, make error message by concatenating
973 all the data items. They are all strings. */
974 if (!NILP (file_error
) && !NILP (tail
))
975 errmsg
= XCONS (tail
)->car
, tail
= XCONS (tail
)->cdr
;
977 if (STRINGP (errmsg
))
978 Fprinc (errmsg
, stream
);
980 write_string_1 ("peculiar error", -1, stream
);
982 for (i
= 0; CONSP (tail
); tail
= Fcdr (tail
), i
++)
984 write_string_1 (i
? ", " : ": ", 2, stream
);
985 if (!NILP (file_error
))
986 Fprinc (Fcar (tail
), stream
);
988 Fprin1 (Fcar (tail
), stream
);
993 #ifdef LISP_FLOAT_TYPE
996 * The buffer should be at least as large as the max string size of the
997 * largest float, printed in the biggest notation. This is undoubtedly
998 * 20d float_output_format, with the negative of the C-constant "HUGE"
1001 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1003 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1004 * case of -1e307 in 20d float_output_format. What is one to do (short of
1005 * re-writing _doprnt to be more sane)?
1010 float_to_string (buf
, data
)
1017 /* Check for plus infinity in a way that won't lose
1018 if there is no plus infinity. */
1019 if (data
== data
/ 2 && data
> 1.0)
1021 strcpy (buf
, "1.0e+INF");
1024 /* Likewise for minus infinity. */
1025 if (data
== data
/ 2 && data
< -1.0)
1027 strcpy (buf
, "-1.0e+INF");
1030 /* Check for NaN in a way that won't fail if there are no NaNs. */
1031 if (! (data
* 0.0 >= 0.0))
1033 strcpy (buf
, "0.0e+NaN");
1037 if (NILP (Vfloat_output_format
)
1038 || !STRINGP (Vfloat_output_format
))
1041 /* Generate the fewest number of digits that represent the
1042 floating point value without losing information.
1043 The following method is simple but a bit slow.
1044 For ideas about speeding things up, please see:
1046 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1047 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1049 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1050 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1052 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1054 sprintf (buf
, "%.*g", width
, data
);
1055 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1057 else /* oink oink */
1059 /* Check that the spec we have is fully valid.
1060 This means not only valid for printf,
1061 but meant for floats, and reasonable. */
1062 cp
= XSTRING (Vfloat_output_format
)->data
;
1071 /* Check the width specification. */
1073 if ('0' <= *cp
&& *cp
<= '9')
1077 width
= (width
* 10) + (*cp
++ - '0');
1078 while (*cp
>= '0' && *cp
<= '9');
1080 /* A precision of zero is valid only for %f. */
1082 || (width
== 0 && *cp
!= 'f'))
1086 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1092 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
1095 /* Make sure there is a decimal point with digit after, or an
1096 exponent, so that the value is readable as a float. But don't do
1097 this with "%.0f"; it's valid for that not to produce a decimal
1098 point. Note that width can be 0 only for %.0f. */
1101 for (cp
= buf
; *cp
; cp
++)
1102 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1105 if (*cp
== '.' && cp
[1] == 0)
1119 #endif /* LISP_FLOAT_TYPE */
1122 print (obj
, printcharfun
, escapeflag
)
1124 register Lisp_Object printcharfun
;
1131 #if 1 /* I'm not sure this is really worth doing. */
1132 /* Detect circularities and truncate them.
1133 No need to offer any alternative--this is better than an error. */
1134 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
1137 for (i
= 0; i
< print_depth
; i
++)
1138 if (EQ (obj
, being_printed
[i
]))
1140 sprintf (buf
, "#%d", i
);
1141 strout (buf
, -1, -1, printcharfun
, 0);
1147 being_printed
[print_depth
] = obj
;
1150 if (print_depth
> PRINT_CIRCLE
)
1151 error ("Apparently circular structure being printed");
1152 #ifdef MAX_PRINT_CHARS
1153 if (max_print
&& print_chars
> max_print
)
1158 #endif /* MAX_PRINT_CHARS */
1160 switch (XGCTYPE (obj
))
1163 if (sizeof (int) == sizeof (EMACS_INT
))
1164 sprintf (buf
, "%d", XINT (obj
));
1165 else if (sizeof (long) == sizeof (EMACS_INT
))
1166 sprintf (buf
, "%ld", XINT (obj
));
1169 strout (buf
, -1, -1, printcharfun
, 0);
1172 #ifdef LISP_FLOAT_TYPE
1175 char pigbuf
[350]; /* see comments in float_to_string */
1177 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
1178 strout (pigbuf
, -1, -1, printcharfun
, 0);
1185 print_string (obj
, printcharfun
);
1188 register int i
, i_byte
;
1189 register unsigned char c
;
1190 struct gcpro gcpro1
;
1193 /* 1 means we must ensure that the next character we output
1194 cannot be taken as part of a hex character escape. */
1195 int need_nonhex
= 0;
1199 #ifdef USE_TEXT_PROPERTIES
1200 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1208 str
= XSTRING (obj
)->data
;
1209 size_byte
= STRING_BYTES (XSTRING (obj
));
1211 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1213 /* Here, we must convert each multi-byte form to the
1214 corresponding character code before handing it to PRINTCHAR. */
1218 if (STRING_MULTIBYTE (obj
))
1220 c
= STRING_CHAR_AND_CHAR_LENGTH (str
+ i_byte
,
1221 size_byte
- i_byte
, len
);
1229 if (c
== '\n' && print_escape_newlines
)
1234 else if (c
== '\f' && print_escape_newlines
)
1239 else if ((! SINGLE_BYTE_CHAR_P (c
)
1240 && NILP (current_buffer
->enable_multibyte_characters
)))
1242 /* When multibyte is disabled,
1243 print multibyte string chars using hex escapes. */
1244 unsigned char outbuf
[50];
1245 sprintf (outbuf
, "\\x%x", c
);
1246 strout (outbuf
, -1, -1, printcharfun
, 0);
1249 else if (SINGLE_BYTE_CHAR_P (c
)
1250 && ! ASCII_BYTE_P (c
)
1251 && ! NILP (current_buffer
->enable_multibyte_characters
))
1253 /* When multibyte is enabled,
1254 print single-byte non-ASCII string chars
1255 using octal escapes. */
1256 unsigned char outbuf
[5];
1257 sprintf (outbuf
, "\\%03o", c
);
1258 strout (outbuf
, -1, -1, printcharfun
, 0);
1262 /* If we just had a hex escape, and this character
1263 could be taken as part of it,
1264 output `\ ' to prevent that. */
1268 if ((c
>= 'a' && c
<= 'f')
1269 || (c
>= 'A' && c
<= 'F')
1270 || (c
>= '0' && c
<= '9'))
1271 strout ("\\ ", -1, -1, printcharfun
, 0);
1274 if (c
== '\"' || c
== '\\')
1281 #ifdef USE_TEXT_PROPERTIES
1282 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1284 traverse_intervals (XSTRING (obj
)->intervals
,
1285 0, 0, print_interval
, printcharfun
);
1296 register int confusing
;
1297 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
1298 register unsigned char *end
= p
+ STRING_BYTES (XSYMBOL (obj
)->name
);
1300 int i
, i_byte
, size_byte
;
1303 XSETSTRING (name
, XSYMBOL (obj
)->name
);
1305 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1308 /* If symbol name begins with a digit, and ends with a digit,
1309 and contains nothing but digits and `e', it could be treated
1310 as a number. So set CONFUSING.
1312 Symbols that contain periods could also be taken as numbers,
1313 but periods are always escaped, so we don't have to worry
1315 else if (*p
>= '0' && *p
<= '9'
1316 && end
[-1] >= '0' && end
[-1] <= '9')
1318 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1319 /* Needed for \2e10. */
1322 confusing
= (end
== p
);
1327 /* If we print an uninterned symbol as part of a complex object and
1328 the flag print-gensym is non-nil, prefix it with #n= to read the
1329 object back with the #n# reader syntax later if needed. */
1330 if (! NILP (Vprint_gensym
) && NILP (XSYMBOL (obj
)->obarray
))
1332 if (print_depth
> 1)
1335 tem
= Fassq (obj
, Vprint_gensym_alist
);
1339 print (XCDR (tem
), printcharfun
, escapeflag
);
1345 if (CONSP (Vprint_gensym_alist
))
1346 XSETFASTINT (tem
, XFASTINT (XCDR (XCAR (Vprint_gensym_alist
))) + 1);
1348 XSETFASTINT (tem
, 1);
1349 Vprint_gensym_alist
= Fcons (Fcons (obj
, tem
), Vprint_gensym_alist
);
1352 print (tem
, printcharfun
, escapeflag
);
1360 size_byte
= STRING_BYTES (XSTRING (name
));
1362 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1364 /* Here, we must convert each multi-byte form to the
1365 corresponding character code before handing it to PRINTCHAR. */
1367 if (STRING_MULTIBYTE (name
))
1368 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1370 c
= XSTRING (name
)->data
[i_byte
++];
1376 if (c
== '\"' || c
== '\\' || c
== '\''
1377 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1378 || c
== ',' || c
=='.' || c
== '`'
1379 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1381 PRINTCHAR ('\\'), confusing
= 0;
1389 /* If deeper than spec'd depth, print placeholder. */
1390 if (INTEGERP (Vprint_level
)
1391 && print_depth
> XINT (Vprint_level
))
1392 strout ("...", -1, -1, printcharfun
, 0);
1393 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1394 && (EQ (XCAR (obj
), Qquote
)))
1397 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1399 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1400 && (EQ (XCAR (obj
), Qfunction
)))
1404 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1406 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1407 && ((EQ (XCAR (obj
), Qbackquote
)
1408 || EQ (XCAR (obj
), Qcomma
)
1409 || EQ (XCAR (obj
), Qcomma_at
)
1410 || EQ (XCAR (obj
), Qcomma_dot
))))
1412 print (XCAR (obj
), printcharfun
, 0);
1413 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1420 register int print_length
= 0;
1422 if (INTEGERP (Vprint_length
))
1423 print_length
= XINT (Vprint_length
);
1424 /* Could recognize circularities in cdrs here,
1425 but that would make printing of long lists quadratic.
1426 It's not worth doing. */
1431 if (print_length
&& i
> print_length
)
1433 strout ("...", 3, 3, printcharfun
, 0);
1436 print (XCAR (obj
), printcharfun
, escapeflag
);
1442 strout (" . ", 3, 3, printcharfun
, 0);
1443 print (obj
, printcharfun
, escapeflag
);
1449 case Lisp_Vectorlike
:
1454 strout ("#<process ", -1, -1, printcharfun
, 0);
1455 print_string (XPROCESS (obj
)->name
, printcharfun
);
1459 print_string (XPROCESS (obj
)->name
, printcharfun
);
1461 else if (BOOL_VECTOR_P (obj
))
1464 register unsigned char c
;
1465 struct gcpro gcpro1
;
1467 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1473 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1474 strout (buf
, -1, -1, printcharfun
, 0);
1477 /* Don't print more characters than the specified maximum. */
1478 if (INTEGERP (Vprint_length
)
1479 && XINT (Vprint_length
) < size_in_chars
)
1480 size_in_chars
= XINT (Vprint_length
);
1482 for (i
= 0; i
< size_in_chars
; i
++)
1485 c
= XBOOL_VECTOR (obj
)->data
[i
];
1486 if (c
== '\n' && print_escape_newlines
)
1491 else if (c
== '\f' && print_escape_newlines
)
1498 if (c
== '\"' || c
== '\\')
1507 else if (SUBRP (obj
))
1509 strout ("#<subr ", -1, -1, printcharfun
, 0);
1510 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1514 else if (WINDOWP (obj
))
1516 strout ("#<window ", -1, -1, printcharfun
, 0);
1517 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1518 strout (buf
, -1, -1, printcharfun
, 0);
1519 if (!NILP (XWINDOW (obj
)->buffer
))
1521 strout (" on ", -1, -1, printcharfun
, 0);
1522 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1526 else if (BUFFERP (obj
))
1528 if (NILP (XBUFFER (obj
)->name
))
1529 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1530 else if (escapeflag
)
1532 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1533 print_string (XBUFFER (obj
)->name
, printcharfun
);
1537 print_string (XBUFFER (obj
)->name
, printcharfun
);
1539 else if (WINDOW_CONFIGURATIONP (obj
))
1541 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1543 else if (FRAMEP (obj
))
1545 strout ((FRAME_LIVE_P (XFRAME (obj
))
1546 ? "#<frame " : "#<dead frame "),
1547 -1, -1, printcharfun
, 0);
1548 print_string (XFRAME (obj
)->name
, printcharfun
);
1549 sprintf (buf
, " 0x%lx\\ ", (unsigned long) (XFRAME (obj
)));
1550 strout (buf
, -1, -1, printcharfun
, 0);
1553 #endif /* not standalone */
1556 int size
= XVECTOR (obj
)->size
;
1557 if (COMPILEDP (obj
))
1560 size
&= PSEUDOVECTOR_SIZE_MASK
;
1562 if (CHAR_TABLE_P (obj
))
1564 /* We print a char-table as if it were a vector,
1565 lumping the parent and default slots in with the
1566 character slots. But we add #^ as a prefix. */
1569 if (SUB_CHAR_TABLE_P (obj
))
1571 size
&= PSEUDOVECTOR_SIZE_MASK
;
1573 if (size
& PSEUDOVECTOR_FLAG
)
1579 register Lisp_Object tem
;
1581 /* Don't print more elements than the specified maximum. */
1582 if (INTEGERP (Vprint_length
)
1583 && XINT (Vprint_length
) < size
)
1584 size
= XINT (Vprint_length
);
1586 for (i
= 0; i
< size
; i
++)
1588 if (i
) PRINTCHAR (' ');
1589 tem
= XVECTOR (obj
)->contents
[i
];
1590 print (tem
, printcharfun
, escapeflag
);
1599 switch (XMISCTYPE (obj
))
1601 case Lisp_Misc_Marker
:
1602 strout ("#<marker ", -1, -1, printcharfun
, 0);
1603 /* Do you think this is necessary? */
1604 if (XMARKER (obj
)->insertion_type
!= 0)
1605 strout ("(before-insertion) ", -1, -1, printcharfun
, 0);
1606 if (!(XMARKER (obj
)->buffer
))
1607 strout ("in no buffer", -1, -1, printcharfun
, 0);
1610 sprintf (buf
, "at %d", marker_position (obj
));
1611 strout (buf
, -1, -1, printcharfun
, 0);
1612 strout (" in ", -1, -1, printcharfun
, 0);
1613 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1618 case Lisp_Misc_Overlay
:
1619 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1620 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1621 strout ("in no buffer", -1, -1, printcharfun
, 0);
1624 sprintf (buf
, "from %d to %d in ",
1625 marker_position (OVERLAY_START (obj
)),
1626 marker_position (OVERLAY_END (obj
)));
1627 strout (buf
, -1, -1, printcharfun
, 0);
1628 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1634 /* Remaining cases shouldn't happen in normal usage, but let's print
1635 them anyway for the benefit of the debugger. */
1636 case Lisp_Misc_Free
:
1637 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1640 case Lisp_Misc_Intfwd
:
1641 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1642 strout (buf
, -1, -1, printcharfun
, 0);
1645 case Lisp_Misc_Boolfwd
:
1646 sprintf (buf
, "#<boolfwd to %s>",
1647 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1648 strout (buf
, -1, -1, printcharfun
, 0);
1651 case Lisp_Misc_Objfwd
:
1652 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
1653 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1657 case Lisp_Misc_Buffer_Objfwd
:
1658 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
1659 print (*(Lisp_Object
*)((char *)current_buffer
1660 + XBUFFER_OBJFWD (obj
)->offset
),
1661 printcharfun
, escapeflag
);
1665 case Lisp_Misc_Kboard_Objfwd
:
1666 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
1667 print (*(Lisp_Object
*)((char *) current_kboard
1668 + XKBOARD_OBJFWD (obj
)->offset
),
1669 printcharfun
, escapeflag
);
1673 case Lisp_Misc_Buffer_Local_Value
:
1674 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
1675 goto do_buffer_local
;
1676 case Lisp_Misc_Some_Buffer_Local_Value
:
1677 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
1679 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
1680 print (XBUFFER_LOCAL_VALUE (obj
)->realvalue
, printcharfun
, escapeflag
);
1681 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
1682 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
1684 strout ("[buffer] ", -1, -1, printcharfun
, 0);
1685 print (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
1686 printcharfun
, escapeflag
);
1687 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
1689 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
1690 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
1692 strout ("[frame] ", -1, -1, printcharfun
, 0);
1693 print (XBUFFER_LOCAL_VALUE (obj
)->frame
,
1694 printcharfun
, escapeflag
);
1696 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
1697 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1698 printcharfun
, escapeflag
);
1699 strout ("[default-value] ", -1, -1, printcharfun
, 0);
1700 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
,
1701 printcharfun
, escapeflag
);
1709 #endif /* standalone */
1714 /* We're in trouble if this happens!
1715 Probably should just abort () */
1716 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
1718 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1719 else if (VECTORLIKEP (obj
))
1720 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1722 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1723 strout (buf
, -1, -1, printcharfun
, 0);
1724 strout (" Save your buffers immediately and please report this bug>",
1725 -1, -1, printcharfun
, 0);
1732 #ifdef USE_TEXT_PROPERTIES
1734 /* Print a description of INTERVAL using PRINTCHARFUN.
1735 This is part of printing a string that has text properties. */
1738 print_interval (interval
, printcharfun
)
1740 Lisp_Object printcharfun
;
1743 print (make_number (interval
->position
), printcharfun
, 1);
1745 print (make_number (interval
->position
+ LENGTH (interval
)),
1748 print (interval
->plist
, printcharfun
, 1);
1751 #endif /* USE_TEXT_PROPERTIES */
1756 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1757 "Output stream `print' uses by default for outputting a character.\n\
1758 This may be any function of one argument.\n\
1759 It may also be a buffer (output is inserted before point)\n\
1760 or a marker (output is inserted and the marker is advanced)\n\
1761 or the symbol t (output appears in the echo area).");
1762 Vstandard_output
= Qt
;
1763 Qstandard_output
= intern ("standard-output");
1764 staticpro (&Qstandard_output
);
1766 #ifdef LISP_FLOAT_TYPE
1767 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1768 "The format descriptor string used to print floats.\n\
1769 This is a %-spec like those accepted by `printf' in C,\n\
1770 but with some restrictions. It must start with the two characters `%.'.\n\
1771 After that comes an integer precision specification,\n\
1772 and then a letter which controls the format.\n\
1773 The letters allowed are `e', `f' and `g'.\n\
1774 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1775 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1776 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1777 The precision in any of these cases is the number of digits following\n\
1778 the decimal point. With `f', a precision of 0 means to omit the\n\
1779 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1780 A value of nil means to use the shortest notation\n\
1781 that represents the number without losing information.");
1782 Vfloat_output_format
= Qnil
;
1783 Qfloat_output_format
= intern ("float-output-format");
1784 staticpro (&Qfloat_output_format
);
1785 #endif /* LISP_FLOAT_TYPE */
1787 DEFVAR_LISP ("print-length", &Vprint_length
,
1788 "Maximum length of list to print before abbreviating.\n\
1789 A value of nil means no limit.");
1790 Vprint_length
= Qnil
;
1792 DEFVAR_LISP ("print-level", &Vprint_level
,
1793 "Maximum depth of list nesting to print before abbreviating.\n\
1794 A value of nil means no limit.");
1795 Vprint_level
= Qnil
;
1797 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1798 "Non-nil means print newlines in strings as backslash-n.\n\
1799 Also print formfeeds as backslash-f.");
1800 print_escape_newlines
= 0;
1802 DEFVAR_BOOL ("print-quoted", &print_quoted
,
1803 "Non-nil means print quoted forms with reader syntax.\n\
1804 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\
1805 forms print in the new syntax.");
1808 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
1809 "Non-nil means print uninterned symbols so they will read as uninterned.\n\
1810 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\
1811 When the uninterned symbol appears within a larger data structure,\n\
1812 in addition use the #...# and #...= constructs as needed,\n\
1813 so that multiple references to the same symbol are shared once again\n\
1814 when the text is read back.\n\
1816 If the value of `print-gensym' is a cons cell, then in addition refrain from\n\
1817 clearing `print-gensym-alist' on entry to and exit from printing functions,\n\
1818 so that the use of #...# and #...= can carry over for several separately\n\
1820 Vprint_gensym
= Qnil
;
1822 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist
,
1823 "Association list of elements (GENSYM . N) to guide use of #N# and #N=.\n\
1824 In each element, GENSYM is an uninterned symbol that has been associated\n\
1825 with #N= for the specified value of N.");
1826 Vprint_gensym_alist
= Qnil
;
1828 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1829 staticpro (&Vprin1_to_string_buffer
);
1832 defsubr (&Sprin1_to_string
);
1833 defsubr (&Serror_message_string
);
1837 defsubr (&Swrite_char
);
1838 defsubr (&Sexternal_debugging_output
);
1840 Qexternal_debugging_output
= intern ("external-debugging-output");
1841 staticpro (&Qexternal_debugging_output
);
1843 Qprint_escape_newlines
= intern ("print-escape-newlines");
1844 staticpro (&Qprint_escape_newlines
);
1847 defsubr (&Swith_output_to_temp_buffer
);
1848 #endif /* not standalone */