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 to print single-byte non-ascii characters in strings as
136 int print_escape_nonascii
;
138 /* Nonzero means print (quote foo) forms as 'foo, etc. */
142 /* Non-nil means print #: before uninterned symbols.
143 Neither t nor nil means so that and don't clear Vprint_gensym_alist
144 on entry to and exit from print functions. */
146 Lisp_Object Vprint_gensym
;
148 /* Association list of certain objects that are `eq' in the form being
149 printed and which should be `eq' when read back in, using the #n=object
150 and #n# reader forms. Each element has the form (object . n). */
152 Lisp_Object Vprint_gensym_alist
;
154 /* Nonzero means print newline to stdout before next minibuffer message.
155 Defined in xdisp.c */
157 extern int noninteractive_need_newline
;
159 extern int minibuffer_auto_raise
;
161 #ifdef MAX_PRINT_CHARS
162 static int print_chars
;
163 static int max_print
;
164 #endif /* MAX_PRINT_CHARS */
166 void print_interval ();
169 /* Convert between chars and GLYPHs */
173 register GLYPH
*glyphs
;
183 str_to_glyph_cpy (str
, glyphs
)
187 register GLYPH
*gp
= glyphs
;
188 register char *cp
= str
;
195 str_to_glyph_ncpy (str
, glyphs
, n
)
200 register GLYPH
*gp
= glyphs
;
201 register char *cp
= str
;
208 glyph_to_str_cpy (glyphs
, str
)
212 register GLYPH
*gp
= glyphs
;
213 register char *cp
= str
;
216 *str
++ = *gp
++ & 0377;
220 /* Low level output routines for characters and strings */
222 /* Lisp functions to do output using a stream
223 must have the stream in a variable called printcharfun
224 and must start with PRINTPREPARE, end with PRINTFINISH,
225 and use PRINTDECLARE to declare common variables.
226 Use PRINTCHAR to output one character,
227 or call strout to output a block of characters.
230 #define PRINTDECLARE \
231 struct buffer *old = current_buffer; \
232 int old_point = -1, start_point; \
233 int old_point_byte, start_point_byte; \
234 int specpdl_count = specpdl_ptr - specpdl; \
235 int free_print_buffer = 0; \
238 #define PRINTPREPARE \
239 original = printcharfun; \
240 if (NILP (printcharfun)) printcharfun = Qt; \
241 if (BUFFERP (printcharfun)) \
243 if (XBUFFER (printcharfun) != current_buffer) \
244 Fset_buffer (printcharfun); \
245 printcharfun = Qnil; \
247 if (MARKERP (printcharfun)) \
249 if (!(XMARKER (original)->buffer)) \
250 error ("Marker does not point anywhere"); \
251 if (XMARKER (original)->buffer != current_buffer) \
252 set_buffer_internal (XMARKER (original)->buffer); \
254 old_point_byte = PT_BYTE; \
255 SET_PT_BOTH (marker_position (printcharfun), \
256 marker_byte_position (printcharfun)); \
258 start_point_byte = PT_BYTE; \
259 printcharfun = Qnil; \
261 if (NILP (printcharfun)) \
263 Lisp_Object string; \
264 if (print_buffer != 0) \
266 string = make_string_from_bytes (print_buffer, \
268 print_buffer_pos_byte); \
269 record_unwind_protect (print_unwind, string); \
273 print_buffer_size = 1000; \
274 print_buffer = (char *) xmalloc (print_buffer_size); \
275 free_print_buffer = 1; \
277 print_buffer_pos = 0; \
278 print_buffer_pos_byte = 0; \
280 if (!CONSP (Vprint_gensym)) \
281 Vprint_gensym_alist = Qnil
283 #define PRINTFINISH \
284 if (NILP (printcharfun)) \
285 insert_1_both (print_buffer, print_buffer_pos, \
286 print_buffer_pos_byte, 0, 1, 0); \
287 if (free_print_buffer) \
289 xfree (print_buffer); \
292 unbind_to (specpdl_count, Qnil); \
293 if (MARKERP (original)) \
294 set_marker_both (original, Qnil, PT, PT_BYTE); \
295 if (old_point >= 0) \
296 SET_PT_BOTH (old_point + (old_point >= start_point \
297 ? PT - start_point : 0), \
298 old_point_byte + (old_point_byte >= start_point_byte \
299 ? PT_BYTE - start_point_byte : 0)); \
300 if (old != current_buffer) \
301 set_buffer_internal (old); \
302 if (!CONSP (Vprint_gensym)) \
303 Vprint_gensym_alist = Qnil
305 #define PRINTCHAR(ch) printchar (ch, printcharfun)
307 /* Nonzero if there is no room to print any more characters
308 so print might as well return right away. */
310 #define PRINTFULLP() \
311 (EQ (printcharfun, Qt) && !noninteractive \
312 && printbufidx >= FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)))))
314 /* This is used to restore the saved contents of print_buffer
315 when there is a recursive call to print. */
317 print_unwind (saved_text
)
318 Lisp_Object saved_text
;
320 bcopy (XSTRING (saved_text
)->data
, print_buffer
, XSTRING (saved_text
)->size
);
323 /* Index of first unused element of FRAME_MESSAGE_BUF (mini_frame). */
324 static int printbufidx
;
333 #ifdef MAX_PRINT_CHARS
336 #endif /* MAX_PRINT_CHARS */
341 unsigned char work
[4], *str
;
344 len
= CHAR_STRING (ch
, work
, str
);
345 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
346 print_buffer
= (char *) xrealloc (print_buffer
,
347 print_buffer_size
*= 2);
348 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
349 print_buffer_pos
+= 1;
350 print_buffer_pos_byte
+= len
;
357 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
358 unsigned char work
[4], *str
;
359 int len
= CHAR_STRING (ch
, work
, str
);
366 putchar (*str
), str
++;
367 noninteractive_need_newline
= 1;
371 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
372 || !message_buf_print
)
374 message_log_maybe_newline ();
375 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
377 echo_area_glyphs_length
= 0;
378 message_buf_print
= 1;
380 if (minibuffer_auto_raise
)
382 Lisp_Object mini_window
;
384 /* Get the frame containing the minibuffer
385 that the selected frame is using. */
386 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
388 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
392 message_dolog (str
, len
, 0, len
> 1);
394 /* Convert message to multibyte if we are now adding multibyte text. */
395 if (! NILP (current_buffer
->enable_multibyte_characters
)
396 && ! message_enable_multibyte
399 int size
= count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame
),
401 unsigned char *tembuf
= (unsigned char *) alloca (size
+ 1);
402 copy_text (FRAME_MESSAGE_BUF (mini_frame
), tembuf
, printbufidx
,
405 if (printbufidx
> FRAME_MESSAGE_BUF_SIZE (mini_frame
))
407 printbufidx
= FRAME_MESSAGE_BUF_SIZE (mini_frame
);
408 /* Rewind incomplete multi-byte form. */
409 while (printbufidx
> 0 && tembuf
[printbufidx
] >= 0xA0)
412 bcopy (tembuf
, FRAME_MESSAGE_BUF (mini_frame
), printbufidx
);
413 message_enable_multibyte
= 1;
416 if (printbufidx
< FRAME_MESSAGE_BUF_SIZE (mini_frame
) - len
)
417 bcopy (str
, &FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
], len
),
419 FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
] = 0;
420 echo_area_glyphs_length
= printbufidx
;
424 #endif /* not standalone */
426 XSETFASTINT (ch1
, ch
);
431 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
434 Lisp_Object printcharfun
;
440 size_byte
= size
= strlen (ptr
);
442 if (EQ (printcharfun
, Qnil
))
444 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
446 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
447 print_buffer
= (char *) xrealloc (print_buffer
,
450 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
451 print_buffer_pos
+= size
;
452 print_buffer_pos_byte
+= size_byte
;
454 #ifdef MAX_PRINT_CHARS
457 #endif /* MAX_PRINT_CHARS */
460 if (EQ (printcharfun
, Qt
))
463 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
467 #ifdef MAX_PRINT_CHARS
470 #endif /* MAX_PRINT_CHARS */
474 fwrite (ptr
, 1, size_byte
, stdout
);
475 noninteractive_need_newline
= 1;
479 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
480 || !message_buf_print
)
482 message_log_maybe_newline ();
483 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
485 echo_area_glyphs_length
= 0;
486 message_buf_print
= 1;
488 if (minibuffer_auto_raise
)
490 Lisp_Object mini_window
;
492 /* Get the frame containing the minibuffer
493 that the selected frame is using. */
494 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
496 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
500 message_dolog (ptr
, size_byte
, 0, multibyte
);
502 /* Convert message to multibyte if we are now adding multibyte text. */
504 && ! message_enable_multibyte
507 int size
= count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame
),
509 unsigned char *tembuf
= (unsigned char *) alloca (size
+ 1);
510 copy_text (FRAME_MESSAGE_BUF (mini_frame
), tembuf
, printbufidx
,
513 if (printbufidx
> FRAME_MESSAGE_BUF_SIZE (mini_frame
))
515 printbufidx
= FRAME_MESSAGE_BUF_SIZE (mini_frame
);
516 /* Rewind incomplete multi-byte form. */
517 while (printbufidx
> 0 && tembuf
[printbufidx
] >= 0xA0)
521 bcopy (tembuf
, FRAME_MESSAGE_BUF (mini_frame
), printbufidx
);
522 message_enable_multibyte
= 1;
525 /* Compute how much of the new text will fit there. */
526 if (size_byte
> FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1)
528 size_byte
= FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1;
529 /* Rewind incomplete multi-byte form. */
530 while (size_byte
&& (unsigned char) ptr
[size_byte
] >= 0xA0)
534 /* Put that part of the new text in. */
535 bcopy (ptr
, &FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
], size_byte
);
536 printbufidx
+= size_byte
;
537 FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
] = 0;
538 echo_area_glyphs_length
= printbufidx
;
544 if (size
== size_byte
)
545 while (i
< size_byte
)
552 while (i
< size_byte
)
554 /* Here, we must convert each multi-byte form to the
555 corresponding character code before handing it to PRINTCHAR. */
557 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
564 /* Print the contents of a string STRING using PRINTCHARFUN.
565 It isn't safe to use strout in many cases,
566 because printing one char can relocate. */
569 print_string (string
, printcharfun
)
571 Lisp_Object printcharfun
;
573 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
574 /* strout is safe for output to a frame (echo area) or to print_buffer. */
575 strout (XSTRING (string
)->data
,
576 XSTRING (string
)->size
,
577 STRING_BYTES (XSTRING (string
)),
578 printcharfun
, STRING_MULTIBYTE (string
));
581 /* Otherwise, string may be relocated by printing one char.
582 So re-fetch the string address for each character. */
584 int size
= XSTRING (string
)->size
;
585 int size_byte
= STRING_BYTES (XSTRING (string
));
588 if (size
== size_byte
)
589 for (i
= 0; i
< size
; i
++)
590 PRINTCHAR (XSTRING (string
)->data
[i
]);
592 for (i
= 0; i
< size_byte
; i
++)
594 /* Here, we must convert each multi-byte form to the
595 corresponding character code before handing it to PRINTCHAR. */
597 int ch
= STRING_CHAR_AND_CHAR_LENGTH (XSTRING (string
)->data
+ i
,
607 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
608 "Output character CHARACTER to stream PRINTCHARFUN.\n\
609 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
610 (character
, printcharfun
)
611 Lisp_Object character
, printcharfun
;
615 if (NILP (printcharfun
))
616 printcharfun
= Vstandard_output
;
617 CHECK_NUMBER (character
, 0);
619 PRINTCHAR (XINT (character
));
624 /* Used from outside of print.c to print a block of SIZE
625 single-byte chars at DATA on the default output stream.
626 Do not use this on the contents of a Lisp string. */
629 write_string (data
, size
)
634 Lisp_Object printcharfun
;
636 printcharfun
= Vstandard_output
;
639 strout (data
, size
, size
, printcharfun
, 0);
643 /* Used from outside of print.c to print a block of SIZE
644 single-byte chars at DATA on a specified stream PRINTCHARFUN.
645 Do not use this on the contents of a Lisp string. */
648 write_string_1 (data
, size
, printcharfun
)
651 Lisp_Object printcharfun
;
656 strout (data
, size
, size
, printcharfun
, 0);
664 temp_output_buffer_setup (bufname
)
667 register struct buffer
*old
= current_buffer
;
668 register Lisp_Object buf
;
670 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
672 current_buffer
->directory
= old
->directory
;
673 current_buffer
->read_only
= Qnil
;
674 current_buffer
->filename
= Qnil
;
675 current_buffer
->undo_list
= Qt
;
676 current_buffer
->overlays_before
= Qnil
;
677 current_buffer
->overlays_after
= Qnil
;
678 current_buffer
->enable_multibyte_characters
679 = buffer_defaults
.enable_multibyte_characters
;
682 XSETBUFFER (buf
, current_buffer
);
683 specbind (Qstandard_output
, buf
);
685 set_buffer_internal (old
);
689 internal_with_output_to_temp_buffer (bufname
, function
, args
)
691 Lisp_Object (*function
) P_ ((Lisp_Object
));
694 int count
= specpdl_ptr
- specpdl
;
695 Lisp_Object buf
, val
;
699 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
700 temp_output_buffer_setup (bufname
);
701 buf
= Vstandard_output
;
704 val
= (*function
) (args
);
707 temp_output_buffer_show (buf
);
710 return unbind_to (count
, val
);
713 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
715 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
716 The buffer is cleared out initially, and marked as unmodified when done.\n\
717 All output done by BODY is inserted in that buffer by default.\n\
718 The buffer is displayed in another window, but not selected.\n\
719 The value of the last form in BODY is returned.\n\
720 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
721 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
722 to get the buffer displayed. It gets one argument, the buffer to display.")
728 int count
= specpdl_ptr
- specpdl
;
729 Lisp_Object buf
, val
;
732 name
= Feval (Fcar (args
));
735 CHECK_STRING (name
, 0);
736 temp_output_buffer_setup (XSTRING (name
)->data
);
737 buf
= Vstandard_output
;
739 val
= Fprogn (Fcdr (args
));
741 temp_output_buffer_show (buf
);
743 return unbind_to (count
, val
);
745 #endif /* not standalone */
747 static void print ();
749 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
750 "Output a newline to stream PRINTCHARFUN.\n\
751 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
753 Lisp_Object printcharfun
;
757 if (NILP (printcharfun
))
758 printcharfun
= Vstandard_output
;
765 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
766 "Output the printed representation of OBJECT, any Lisp object.\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
;
775 #ifdef MAX_PRINT_CHARS
777 #endif /* MAX_PRINT_CHARS */
778 if (NILP (printcharfun
))
779 printcharfun
= Vstandard_output
;
782 print (object
, printcharfun
, 1);
787 /* a buffer which is used to hold output being built by prin1-to-string */
788 Lisp_Object Vprin1_to_string_buffer
;
790 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
791 "Return a string containing the printed representation of OBJECT,\n\
792 any Lisp object. Quoting characters are used when needed to make output\n\
793 that `read' can handle, whenever this is possible, unless the optional\n\
794 second argument NOESCAPE is non-nil.")
796 Lisp_Object object
, noescape
;
799 Lisp_Object printcharfun
;
800 struct gcpro gcpro1
, gcpro2
;
803 /* Save and restore this--we are altering a buffer
804 but we don't want to deactivate the mark just for that.
805 No need for specbind, since errors deactivate the mark. */
806 tem
= Vdeactivate_mark
;
807 GCPRO2 (object
, tem
);
809 printcharfun
= Vprin1_to_string_buffer
;
812 print (object
, printcharfun
, NILP (noescape
));
813 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
815 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
816 object
= Fbuffer_string ();
819 set_buffer_internal (old
);
821 Vdeactivate_mark
= tem
;
827 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
828 "Output the printed representation of OBJECT, any Lisp object.\n\
829 No quoting characters are used; no delimiters are printed around\n\
830 the contents of strings.\n\
831 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
832 (object
, printcharfun
)
833 Lisp_Object object
, printcharfun
;
837 if (NILP (printcharfun
))
838 printcharfun
= Vstandard_output
;
841 print (object
, printcharfun
, 0);
846 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
847 "Output the printed representation of OBJECT, with newlines around it.\n\
848 Quoting characters are printed when needed to make output that `read'\n\
849 can handle, whenever this is possible.\n\
850 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
851 (object
, printcharfun
)
852 Lisp_Object object
, printcharfun
;
857 #ifdef MAX_PRINT_CHARS
859 max_print
= MAX_PRINT_CHARS
;
860 #endif /* MAX_PRINT_CHARS */
861 if (NILP (printcharfun
))
862 printcharfun
= Vstandard_output
;
867 print (object
, printcharfun
, 1);
870 #ifdef MAX_PRINT_CHARS
873 #endif /* MAX_PRINT_CHARS */
878 /* The subroutine object for external-debugging-output is kept here
879 for the convenience of the debugger. */
880 Lisp_Object Qexternal_debugging_output
;
882 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
883 "Write CHARACTER to stderr.\n\
884 You can call print while debugging emacs, and pass it this function\n\
885 to make it write to the debugging output.\n")
887 Lisp_Object character
;
889 CHECK_NUMBER (character
, 0);
890 putc (XINT (character
), stderr
);
893 /* Send the output to a debugger (nothing happens if there isn't one). */
895 char buf
[2] = {(char) XINT (character
), '\0'};
896 OutputDebugString (buf
);
903 /* This is the interface for debugging printing. */
909 Fprin1 (arg
, Qexternal_debugging_output
);
910 fprintf (stderr
, "\r\n");
913 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
915 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
919 struct buffer
*old
= current_buffer
;
920 Lisp_Object original
, printcharfun
, value
;
923 /* If OBJ is (error STRING), just return STRING.
924 That is not only faster, it also avoids the need to allocate
925 space here when the error is due to memory full. */
926 if (CONSP (obj
) && EQ (XCONS (obj
)->car
, Qerror
)
927 && CONSP (XCONS (obj
)->cdr
)
928 && STRINGP (XCONS (XCONS (obj
)->cdr
)->car
)
929 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
930 return XCONS (XCONS (obj
)->cdr
)->car
;
932 print_error_message (obj
, Vprin1_to_string_buffer
);
934 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
935 value
= Fbuffer_string ();
939 set_buffer_internal (old
);
945 /* Print an error message for the error DATA
946 onto Lisp output stream STREAM (suitable for the print functions). */
949 print_error_message (data
, stream
)
950 Lisp_Object data
, stream
;
952 Lisp_Object errname
, errmsg
, file_error
, tail
;
956 errname
= Fcar (data
);
958 if (EQ (errname
, Qerror
))
961 if (!CONSP (data
)) data
= Qnil
;
962 errmsg
= Fcar (data
);
967 errmsg
= Fget (errname
, Qerror_message
);
968 file_error
= Fmemq (Qfile_error
,
969 Fget (errname
, Qerror_conditions
));
972 /* Print an error message including the data items. */
974 tail
= Fcdr_safe (data
);
977 /* For file-error, make error message by concatenating
978 all the data items. They are all strings. */
979 if (!NILP (file_error
) && !NILP (tail
))
980 errmsg
= XCONS (tail
)->car
, tail
= XCONS (tail
)->cdr
;
982 if (STRINGP (errmsg
))
983 Fprinc (errmsg
, stream
);
985 write_string_1 ("peculiar error", -1, stream
);
987 for (i
= 0; CONSP (tail
); tail
= Fcdr (tail
), i
++)
989 write_string_1 (i
? ", " : ": ", 2, stream
);
990 if (!NILP (file_error
))
991 Fprinc (Fcar (tail
), stream
);
993 Fprin1 (Fcar (tail
), stream
);
998 #ifdef LISP_FLOAT_TYPE
1001 * The buffer should be at least as large as the max string size of the
1002 * largest float, printed in the biggest notation. This is undoubtedly
1003 * 20d float_output_format, with the negative of the C-constant "HUGE"
1006 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1008 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1009 * case of -1e307 in 20d float_output_format. What is one to do (short of
1010 * re-writing _doprnt to be more sane)?
1015 float_to_string (buf
, data
)
1022 /* Check for plus infinity in a way that won't lose
1023 if there is no plus infinity. */
1024 if (data
== data
/ 2 && data
> 1.0)
1026 strcpy (buf
, "1.0e+INF");
1029 /* Likewise for minus infinity. */
1030 if (data
== data
/ 2 && data
< -1.0)
1032 strcpy (buf
, "-1.0e+INF");
1035 /* Check for NaN in a way that won't fail if there are no NaNs. */
1036 if (! (data
* 0.0 >= 0.0))
1038 strcpy (buf
, "0.0e+NaN");
1042 if (NILP (Vfloat_output_format
)
1043 || !STRINGP (Vfloat_output_format
))
1046 /* Generate the fewest number of digits that represent the
1047 floating point value without losing information.
1048 The following method is simple but a bit slow.
1049 For ideas about speeding things up, please see:
1051 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1052 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1054 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1055 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1057 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1059 sprintf (buf
, "%.*g", width
, data
);
1060 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1062 else /* oink oink */
1064 /* Check that the spec we have is fully valid.
1065 This means not only valid for printf,
1066 but meant for floats, and reasonable. */
1067 cp
= XSTRING (Vfloat_output_format
)->data
;
1076 /* Check the width specification. */
1078 if ('0' <= *cp
&& *cp
<= '9')
1082 width
= (width
* 10) + (*cp
++ - '0');
1083 while (*cp
>= '0' && *cp
<= '9');
1085 /* A precision of zero is valid only for %f. */
1087 || (width
== 0 && *cp
!= 'f'))
1091 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1097 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
1100 /* Make sure there is a decimal point with digit after, or an
1101 exponent, so that the value is readable as a float. But don't do
1102 this with "%.0f"; it's valid for that not to produce a decimal
1103 point. Note that width can be 0 only for %.0f. */
1106 for (cp
= buf
; *cp
; cp
++)
1107 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1110 if (*cp
== '.' && cp
[1] == 0)
1124 #endif /* LISP_FLOAT_TYPE */
1127 print (obj
, printcharfun
, escapeflag
)
1129 register Lisp_Object printcharfun
;
1136 #if 1 /* I'm not sure this is really worth doing. */
1137 /* Detect circularities and truncate them.
1138 No need to offer any alternative--this is better than an error. */
1139 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
1142 for (i
= 0; i
< print_depth
; i
++)
1143 if (EQ (obj
, being_printed
[i
]))
1145 sprintf (buf
, "#%d", i
);
1146 strout (buf
, -1, -1, printcharfun
, 0);
1152 being_printed
[print_depth
] = obj
;
1155 if (print_depth
> PRINT_CIRCLE
)
1156 error ("Apparently circular structure being printed");
1157 #ifdef MAX_PRINT_CHARS
1158 if (max_print
&& print_chars
> max_print
)
1163 #endif /* MAX_PRINT_CHARS */
1165 switch (XGCTYPE (obj
))
1168 if (sizeof (int) == sizeof (EMACS_INT
))
1169 sprintf (buf
, "%d", XINT (obj
));
1170 else if (sizeof (long) == sizeof (EMACS_INT
))
1171 sprintf (buf
, "%ld", XINT (obj
));
1174 strout (buf
, -1, -1, printcharfun
, 0);
1177 #ifdef LISP_FLOAT_TYPE
1180 char pigbuf
[350]; /* see comments in float_to_string */
1182 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
1183 strout (pigbuf
, -1, -1, printcharfun
, 0);
1190 print_string (obj
, printcharfun
);
1193 register int i
, i_byte
;
1194 register unsigned char c
;
1195 struct gcpro gcpro1
;
1198 /* 1 means we must ensure that the next character we output
1199 cannot be taken as part of a hex character escape. */
1200 int need_nonhex
= 0;
1204 #ifdef USE_TEXT_PROPERTIES
1205 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1213 str
= XSTRING (obj
)->data
;
1214 size_byte
= STRING_BYTES (XSTRING (obj
));
1216 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1218 /* Here, we must convert each multi-byte form to the
1219 corresponding character code before handing it to PRINTCHAR. */
1223 if (STRING_MULTIBYTE (obj
))
1225 c
= STRING_CHAR_AND_CHAR_LENGTH (str
+ i_byte
,
1226 size_byte
- i_byte
, len
);
1234 if (c
== '\n' && print_escape_newlines
)
1239 else if (c
== '\f' && print_escape_newlines
)
1244 else if ((! SINGLE_BYTE_CHAR_P (c
)
1245 && NILP (current_buffer
->enable_multibyte_characters
)))
1247 /* When multibyte is disabled,
1248 print multibyte string chars using hex escapes. */
1249 unsigned char outbuf
[50];
1250 sprintf (outbuf
, "\\x%x", c
);
1251 strout (outbuf
, -1, -1, printcharfun
, 0);
1254 else if (SINGLE_BYTE_CHAR_P (c
)
1255 && ! ASCII_BYTE_P (c
)
1256 && (! NILP (current_buffer
->enable_multibyte_characters
)
1257 || print_escape_nonascii
))
1259 /* When multibyte is enabled or when explicitly requested,
1260 print single-byte non-ASCII string chars
1261 using octal escapes. */
1262 unsigned char outbuf
[5];
1263 sprintf (outbuf
, "\\%03o", c
);
1264 strout (outbuf
, -1, -1, printcharfun
, 0);
1268 /* If we just had a hex escape, and this character
1269 could be taken as part of it,
1270 output `\ ' to prevent that. */
1274 if ((c
>= 'a' && c
<= 'f')
1275 || (c
>= 'A' && c
<= 'F')
1276 || (c
>= '0' && c
<= '9'))
1277 strout ("\\ ", -1, -1, printcharfun
, 0);
1280 if (c
== '\"' || c
== '\\')
1287 #ifdef USE_TEXT_PROPERTIES
1288 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1290 traverse_intervals (XSTRING (obj
)->intervals
,
1291 0, 0, print_interval
, printcharfun
);
1302 register int confusing
;
1303 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
1304 register unsigned char *end
= p
+ STRING_BYTES (XSYMBOL (obj
)->name
);
1306 int i
, i_byte
, size_byte
;
1309 XSETSTRING (name
, XSYMBOL (obj
)->name
);
1311 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1314 /* If symbol name begins with a digit, and ends with a digit,
1315 and contains nothing but digits and `e', it could be treated
1316 as a number. So set CONFUSING.
1318 Symbols that contain periods could also be taken as numbers,
1319 but periods are always escaped, so we don't have to worry
1321 else if (*p
>= '0' && *p
<= '9'
1322 && end
[-1] >= '0' && end
[-1] <= '9')
1324 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1325 /* Needed for \2e10. */
1328 confusing
= (end
== p
);
1333 /* If we print an uninterned symbol as part of a complex object and
1334 the flag print-gensym is non-nil, prefix it with #n= to read the
1335 object back with the #n# reader syntax later if needed. */
1336 if (! NILP (Vprint_gensym
) && NILP (XSYMBOL (obj
)->obarray
))
1338 if (print_depth
> 1)
1341 tem
= Fassq (obj
, Vprint_gensym_alist
);
1345 print (XCDR (tem
), printcharfun
, escapeflag
);
1351 if (CONSP (Vprint_gensym_alist
))
1352 XSETFASTINT (tem
, XFASTINT (XCDR (XCAR (Vprint_gensym_alist
))) + 1);
1354 XSETFASTINT (tem
, 1);
1355 Vprint_gensym_alist
= Fcons (Fcons (obj
, tem
), Vprint_gensym_alist
);
1358 print (tem
, printcharfun
, escapeflag
);
1366 size_byte
= STRING_BYTES (XSTRING (name
));
1368 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1370 /* Here, we must convert each multi-byte form to the
1371 corresponding character code before handing it to PRINTCHAR. */
1373 if (STRING_MULTIBYTE (name
))
1374 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1376 c
= XSTRING (name
)->data
[i_byte
++];
1382 if (c
== '\"' || c
== '\\' || c
== '\''
1383 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1384 || c
== ',' || c
=='.' || c
== '`'
1385 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1387 PRINTCHAR ('\\'), confusing
= 0;
1395 /* If deeper than spec'd depth, print placeholder. */
1396 if (INTEGERP (Vprint_level
)
1397 && print_depth
> XINT (Vprint_level
))
1398 strout ("...", -1, -1, printcharfun
, 0);
1399 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1400 && (EQ (XCAR (obj
), Qquote
)))
1403 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1405 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1406 && (EQ (XCAR (obj
), Qfunction
)))
1410 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1412 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1413 && ((EQ (XCAR (obj
), Qbackquote
)
1414 || EQ (XCAR (obj
), Qcomma
)
1415 || EQ (XCAR (obj
), Qcomma_at
)
1416 || EQ (XCAR (obj
), Qcomma_dot
))))
1418 print (XCAR (obj
), printcharfun
, 0);
1419 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1426 register int print_length
= 0;
1427 Lisp_Object halftail
= obj
;
1429 if (INTEGERP (Vprint_length
))
1430 print_length
= XINT (Vprint_length
);
1433 /* Detect circular list. */
1434 if (i
!= 0 && EQ (obj
, halftail
))
1436 sprintf (buf
, " . #%d", i
/ 2);
1437 strout (buf
, -1, -1, printcharfun
, 0);
1443 if (print_length
&& i
> print_length
)
1445 strout ("...", 3, 3, printcharfun
, 0);
1448 print (XCAR (obj
), printcharfun
, escapeflag
);
1451 halftail
= XCDR (halftail
);
1456 strout (" . ", 3, 3, printcharfun
, 0);
1457 print (obj
, printcharfun
, escapeflag
);
1463 case Lisp_Vectorlike
:
1468 strout ("#<process ", -1, -1, printcharfun
, 0);
1469 print_string (XPROCESS (obj
)->name
, printcharfun
);
1473 print_string (XPROCESS (obj
)->name
, printcharfun
);
1475 else if (BOOL_VECTOR_P (obj
))
1478 register unsigned char c
;
1479 struct gcpro gcpro1
;
1481 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1487 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1488 strout (buf
, -1, -1, printcharfun
, 0);
1491 /* Don't print more characters than the specified maximum. */
1492 if (INTEGERP (Vprint_length
)
1493 && XINT (Vprint_length
) < size_in_chars
)
1494 size_in_chars
= XINT (Vprint_length
);
1496 for (i
= 0; i
< size_in_chars
; i
++)
1499 c
= XBOOL_VECTOR (obj
)->data
[i
];
1500 if (c
== '\n' && print_escape_newlines
)
1505 else if (c
== '\f' && print_escape_newlines
)
1512 if (c
== '\"' || c
== '\\')
1521 else if (SUBRP (obj
))
1523 strout ("#<subr ", -1, -1, printcharfun
, 0);
1524 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1528 else if (WINDOWP (obj
))
1530 strout ("#<window ", -1, -1, printcharfun
, 0);
1531 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1532 strout (buf
, -1, -1, printcharfun
, 0);
1533 if (!NILP (XWINDOW (obj
)->buffer
))
1535 strout (" on ", -1, -1, printcharfun
, 0);
1536 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1540 else if (BUFFERP (obj
))
1542 if (NILP (XBUFFER (obj
)->name
))
1543 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1544 else if (escapeflag
)
1546 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1547 print_string (XBUFFER (obj
)->name
, printcharfun
);
1551 print_string (XBUFFER (obj
)->name
, printcharfun
);
1553 else if (WINDOW_CONFIGURATIONP (obj
))
1555 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1557 else if (FRAMEP (obj
))
1559 strout ((FRAME_LIVE_P (XFRAME (obj
))
1560 ? "#<frame " : "#<dead frame "),
1561 -1, -1, printcharfun
, 0);
1562 print_string (XFRAME (obj
)->name
, printcharfun
);
1563 sprintf (buf
, " 0x%lx\\ ", (unsigned long) (XFRAME (obj
)));
1564 strout (buf
, -1, -1, printcharfun
, 0);
1567 #endif /* not standalone */
1570 int size
= XVECTOR (obj
)->size
;
1571 if (COMPILEDP (obj
))
1574 size
&= PSEUDOVECTOR_SIZE_MASK
;
1576 if (CHAR_TABLE_P (obj
))
1578 /* We print a char-table as if it were a vector,
1579 lumping the parent and default slots in with the
1580 character slots. But we add #^ as a prefix. */
1583 if (SUB_CHAR_TABLE_P (obj
))
1585 size
&= PSEUDOVECTOR_SIZE_MASK
;
1587 if (size
& PSEUDOVECTOR_FLAG
)
1593 register Lisp_Object tem
;
1595 /* Don't print more elements than the specified maximum. */
1596 if (INTEGERP (Vprint_length
)
1597 && XINT (Vprint_length
) < size
)
1598 size
= XINT (Vprint_length
);
1600 for (i
= 0; i
< size
; i
++)
1602 if (i
) PRINTCHAR (' ');
1603 tem
= XVECTOR (obj
)->contents
[i
];
1604 print (tem
, printcharfun
, escapeflag
);
1613 switch (XMISCTYPE (obj
))
1615 case Lisp_Misc_Marker
:
1616 strout ("#<marker ", -1, -1, printcharfun
, 0);
1617 /* Do you think this is necessary? */
1618 if (XMARKER (obj
)->insertion_type
!= 0)
1619 strout ("(before-insertion) ", -1, -1, printcharfun
, 0);
1620 if (!(XMARKER (obj
)->buffer
))
1621 strout ("in no buffer", -1, -1, printcharfun
, 0);
1624 sprintf (buf
, "at %d", marker_position (obj
));
1625 strout (buf
, -1, -1, printcharfun
, 0);
1626 strout (" in ", -1, -1, printcharfun
, 0);
1627 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1632 case Lisp_Misc_Overlay
:
1633 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1634 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1635 strout ("in no buffer", -1, -1, printcharfun
, 0);
1638 sprintf (buf
, "from %d to %d in ",
1639 marker_position (OVERLAY_START (obj
)),
1640 marker_position (OVERLAY_END (obj
)));
1641 strout (buf
, -1, -1, printcharfun
, 0);
1642 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1648 /* Remaining cases shouldn't happen in normal usage, but let's print
1649 them anyway for the benefit of the debugger. */
1650 case Lisp_Misc_Free
:
1651 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1654 case Lisp_Misc_Intfwd
:
1655 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1656 strout (buf
, -1, -1, printcharfun
, 0);
1659 case Lisp_Misc_Boolfwd
:
1660 sprintf (buf
, "#<boolfwd to %s>",
1661 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1662 strout (buf
, -1, -1, printcharfun
, 0);
1665 case Lisp_Misc_Objfwd
:
1666 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
1667 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1671 case Lisp_Misc_Buffer_Objfwd
:
1672 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
1673 print (*(Lisp_Object
*)((char *)current_buffer
1674 + XBUFFER_OBJFWD (obj
)->offset
),
1675 printcharfun
, escapeflag
);
1679 case Lisp_Misc_Kboard_Objfwd
:
1680 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
1681 print (*(Lisp_Object
*)((char *) current_kboard
1682 + XKBOARD_OBJFWD (obj
)->offset
),
1683 printcharfun
, escapeflag
);
1687 case Lisp_Misc_Buffer_Local_Value
:
1688 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
1689 goto do_buffer_local
;
1690 case Lisp_Misc_Some_Buffer_Local_Value
:
1691 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
1693 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
1694 print (XBUFFER_LOCAL_VALUE (obj
)->realvalue
, printcharfun
, escapeflag
);
1695 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
1696 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
1698 strout ("[buffer] ", -1, -1, printcharfun
, 0);
1699 print (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
1700 printcharfun
, escapeflag
);
1701 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
1703 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
1704 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
1706 strout ("[frame] ", -1, -1, printcharfun
, 0);
1707 print (XBUFFER_LOCAL_VALUE (obj
)->frame
,
1708 printcharfun
, escapeflag
);
1710 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
1711 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1712 printcharfun
, escapeflag
);
1713 strout ("[default-value] ", -1, -1, printcharfun
, 0);
1714 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
,
1715 printcharfun
, escapeflag
);
1723 #endif /* standalone */
1728 /* We're in trouble if this happens!
1729 Probably should just abort () */
1730 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
1732 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1733 else if (VECTORLIKEP (obj
))
1734 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1736 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1737 strout (buf
, -1, -1, printcharfun
, 0);
1738 strout (" Save your buffers immediately and please report this bug>",
1739 -1, -1, printcharfun
, 0);
1746 #ifdef USE_TEXT_PROPERTIES
1748 /* Print a description of INTERVAL using PRINTCHARFUN.
1749 This is part of printing a string that has text properties. */
1752 print_interval (interval
, printcharfun
)
1754 Lisp_Object printcharfun
;
1757 print (make_number (interval
->position
), printcharfun
, 1);
1759 print (make_number (interval
->position
+ LENGTH (interval
)),
1762 print (interval
->plist
, printcharfun
, 1);
1765 #endif /* USE_TEXT_PROPERTIES */
1770 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1771 "Output stream `print' uses by default for outputting a character.\n\
1772 This may be any function of one argument.\n\
1773 It may also be a buffer (output is inserted before point)\n\
1774 or a marker (output is inserted and the marker is advanced)\n\
1775 or the symbol t (output appears in the echo area).");
1776 Vstandard_output
= Qt
;
1777 Qstandard_output
= intern ("standard-output");
1778 staticpro (&Qstandard_output
);
1780 #ifdef LISP_FLOAT_TYPE
1781 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1782 "The format descriptor string used to print floats.\n\
1783 This is a %-spec like those accepted by `printf' in C,\n\
1784 but with some restrictions. It must start with the two characters `%.'.\n\
1785 After that comes an integer precision specification,\n\
1786 and then a letter which controls the format.\n\
1787 The letters allowed are `e', `f' and `g'.\n\
1788 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1789 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1790 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1791 The precision in any of these cases is the number of digits following\n\
1792 the decimal point. With `f', a precision of 0 means to omit the\n\
1793 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1794 A value of nil means to use the shortest notation\n\
1795 that represents the number without losing information.");
1796 Vfloat_output_format
= Qnil
;
1797 Qfloat_output_format
= intern ("float-output-format");
1798 staticpro (&Qfloat_output_format
);
1799 #endif /* LISP_FLOAT_TYPE */
1801 DEFVAR_LISP ("print-length", &Vprint_length
,
1802 "Maximum length of list to print before abbreviating.\n\
1803 A value of nil means no limit.");
1804 Vprint_length
= Qnil
;
1806 DEFVAR_LISP ("print-level", &Vprint_level
,
1807 "Maximum depth of list nesting to print before abbreviating.\n\
1808 A value of nil means no limit.");
1809 Vprint_level
= Qnil
;
1811 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1812 "Non-nil means print newlines in strings as backslash-n.\n\
1813 Also print formfeeds as backslash-f.");
1814 print_escape_newlines
= 0;
1816 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
1817 "Non-nil means print non-ASCII characters in strings as backslash-NNN.\n\
1818 NNN is the octal representation of the character's value.\n\
1819 Only single-byte characters are affected, and only in `prin1'.");
1820 print_escape_nonascii
= 0;
1822 DEFVAR_BOOL ("print-quoted", &print_quoted
,
1823 "Non-nil means print quoted forms with reader syntax.\n\
1824 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\
1825 forms print in the new syntax.");
1828 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
1829 "Non-nil means print uninterned symbols so they will read as uninterned.\n\
1830 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\
1831 When the uninterned symbol appears within a larger data structure,\n\
1832 in addition use the #...# and #...= constructs as needed,\n\
1833 so that multiple references to the same symbol are shared once again\n\
1834 when the text is read back.\n\
1836 If the value of `print-gensym' is a cons cell, then in addition refrain from\n\
1837 clearing `print-gensym-alist' on entry to and exit from printing functions,\n\
1838 so that the use of #...# and #...= can carry over for several separately\n\
1840 Vprint_gensym
= Qnil
;
1842 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist
,
1843 "Association list of elements (GENSYM . N) to guide use of #N# and #N=.\n\
1844 In each element, GENSYM is an uninterned symbol that has been associated\n\
1845 with #N= for the specified value of N.");
1846 Vprint_gensym_alist
= Qnil
;
1848 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1849 staticpro (&Vprin1_to_string_buffer
);
1852 defsubr (&Sprin1_to_string
);
1853 defsubr (&Serror_message_string
);
1857 defsubr (&Swrite_char
);
1858 defsubr (&Sexternal_debugging_output
);
1860 Qexternal_debugging_output
= intern ("external-debugging-output");
1861 staticpro (&Qexternal_debugging_output
);
1863 Qprint_escape_newlines
= intern ("print-escape-newlines");
1864 staticpro (&Qprint_escape_newlines
);
1867 defsubr (&Swith_output_to_temp_buffer
);
1868 #endif /* not standalone */