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 /* Nonzero means to print single-byte non-ascii characters in strings as
134 int print_escape_nonascii
;
136 /* Nonzero means to print multibyte characters in strings as hex escapes. */
138 int print_escape_multibyte
;
140 Lisp_Object Qprint_escape_newlines
;
141 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
143 /* Nonzero means print (quote foo) forms as 'foo, etc. */
147 /* Non-nil means print #: before uninterned symbols.
148 Neither t nor nil means so that and don't clear Vprint_gensym_alist
149 on entry to and exit from print functions. */
151 Lisp_Object Vprint_gensym
;
153 /* Association list of certain objects that are `eq' in the form being
154 printed and which should be `eq' when read back in, using the #n=object
155 and #n# reader forms. Each element has the form (object . n). */
157 Lisp_Object Vprint_gensym_alist
;
159 /* Nonzero means print newline to stdout before next minibuffer message.
160 Defined in xdisp.c */
162 extern int noninteractive_need_newline
;
164 extern int minibuffer_auto_raise
;
166 #ifdef MAX_PRINT_CHARS
167 static int print_chars
;
168 static int max_print
;
169 #endif /* MAX_PRINT_CHARS */
171 void print_interval ();
174 /* Convert between chars and GLYPHs */
178 register GLYPH
*glyphs
;
188 str_to_glyph_cpy (str
, glyphs
)
192 register GLYPH
*gp
= glyphs
;
193 register char *cp
= str
;
200 str_to_glyph_ncpy (str
, glyphs
, n
)
205 register GLYPH
*gp
= glyphs
;
206 register char *cp
= str
;
213 glyph_to_str_cpy (glyphs
, str
)
217 register GLYPH
*gp
= glyphs
;
218 register char *cp
= str
;
221 *str
++ = *gp
++ & 0377;
225 /* Low level output routines for characters and strings */
227 /* Lisp functions to do output using a stream
228 must have the stream in a variable called printcharfun
229 and must start with PRINTPREPARE, end with PRINTFINISH,
230 and use PRINTDECLARE to declare common variables.
231 Use PRINTCHAR to output one character,
232 or call strout to output a block of characters.
235 #define PRINTDECLARE \
236 struct buffer *old = current_buffer; \
237 int old_point = -1, start_point; \
238 int old_point_byte, start_point_byte; \
239 int specpdl_count = specpdl_ptr - specpdl; \
240 int free_print_buffer = 0; \
243 #define PRINTPREPARE \
244 original = printcharfun; \
245 if (NILP (printcharfun)) printcharfun = Qt; \
246 if (BUFFERP (printcharfun)) \
248 if (XBUFFER (printcharfun) != current_buffer) \
249 Fset_buffer (printcharfun); \
250 printcharfun = Qnil; \
252 if (MARKERP (printcharfun)) \
254 if (!(XMARKER (original)->buffer)) \
255 error ("Marker does not point anywhere"); \
256 if (XMARKER (original)->buffer != current_buffer) \
257 set_buffer_internal (XMARKER (original)->buffer); \
259 old_point_byte = PT_BYTE; \
260 SET_PT_BOTH (marker_position (printcharfun), \
261 marker_byte_position (printcharfun)); \
263 start_point_byte = PT_BYTE; \
264 printcharfun = Qnil; \
266 if (NILP (printcharfun)) \
268 Lisp_Object string; \
269 if (NILP (current_buffer->enable_multibyte_characters) \
270 && ! print_escape_multibyte) \
271 specbind (Qprint_escape_multibyte, Qt); \
272 if (! NILP (current_buffer->enable_multibyte_characters) \
273 && ! print_escape_nonascii) \
274 specbind (Qprint_escape_nonascii, Qt); \
275 if (print_buffer != 0) \
277 string = make_string_from_bytes (print_buffer, \
279 print_buffer_pos_byte); \
280 record_unwind_protect (print_unwind, string); \
284 print_buffer_size = 1000; \
285 print_buffer = (char *) xmalloc (print_buffer_size); \
286 free_print_buffer = 1; \
288 print_buffer_pos = 0; \
289 print_buffer_pos_byte = 0; \
291 if (!CONSP (Vprint_gensym)) \
292 Vprint_gensym_alist = Qnil
294 #define PRINTFINISH \
295 if (NILP (printcharfun)) \
297 if (print_buffer_pos != print_buffer_pos_byte \
298 && NILP (current_buffer->enable_multibyte_characters)) \
300 unsigned char *temp \
301 = (unsigned char *) alloca (print_buffer_pos + 1); \
302 copy_text (print_buffer, temp, print_buffer_pos_byte, \
304 insert_1_both (temp, print_buffer_pos, \
305 print_buffer_pos, 0, 1, 0); \
308 insert_1_both (print_buffer, print_buffer_pos, \
309 print_buffer_pos_byte, 0, 1, 0); \
311 if (free_print_buffer) \
313 xfree (print_buffer); \
316 unbind_to (specpdl_count, Qnil); \
317 if (MARKERP (original)) \
318 set_marker_both (original, Qnil, PT, PT_BYTE); \
319 if (old_point >= 0) \
320 SET_PT_BOTH (old_point + (old_point >= start_point \
321 ? PT - start_point : 0), \
322 old_point_byte + (old_point_byte >= start_point_byte \
323 ? PT_BYTE - start_point_byte : 0)); \
324 if (old != current_buffer) \
325 set_buffer_internal (old); \
326 if (!CONSP (Vprint_gensym)) \
327 Vprint_gensym_alist = Qnil
329 #define PRINTCHAR(ch) printchar (ch, printcharfun)
331 /* Nonzero if there is no room to print any more characters
332 so print might as well return right away. */
334 #define PRINTFULLP() \
335 (EQ (printcharfun, Qt) && !noninteractive \
336 && printbufidx >= FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)))))
338 /* This is used to restore the saved contents of print_buffer
339 when there is a recursive call to print. */
341 print_unwind (saved_text
)
342 Lisp_Object saved_text
;
344 bcopy (XSTRING (saved_text
)->data
, print_buffer
, XSTRING (saved_text
)->size
);
347 /* Index of first unused element of FRAME_MESSAGE_BUF (mini_frame). */
348 static int printbufidx
;
357 #ifdef MAX_PRINT_CHARS
360 #endif /* MAX_PRINT_CHARS */
365 unsigned char work
[4], *str
;
368 len
= CHAR_STRING (ch
, work
, str
);
369 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
370 print_buffer
= (char *) xrealloc (print_buffer
,
371 print_buffer_size
*= 2);
372 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
373 print_buffer_pos
+= 1;
374 print_buffer_pos_byte
+= len
;
381 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
382 unsigned char work
[4], *str
;
383 int len
= CHAR_STRING (ch
, work
, str
);
390 putchar (*str
), str
++;
391 noninteractive_need_newline
= 1;
395 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
396 || !message_buf_print
)
398 message_log_maybe_newline ();
399 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
401 echo_area_glyphs_length
= 0;
402 message_buf_print
= 1;
404 if (minibuffer_auto_raise
)
406 Lisp_Object mini_window
;
408 /* Get the frame containing the minibuffer
409 that the selected frame is using. */
410 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
412 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
416 message_dolog (str
, len
, 0, len
> 1);
418 /* Convert message to multibyte if we are now adding multibyte text. */
419 if (! NILP (current_buffer
->enable_multibyte_characters
)
420 && ! message_enable_multibyte
423 int size
= count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame
),
425 unsigned char *tembuf
= (unsigned char *) alloca (size
+ 1);
426 copy_text (FRAME_MESSAGE_BUF (mini_frame
), tembuf
, printbufidx
,
429 if (printbufidx
> FRAME_MESSAGE_BUF_SIZE (mini_frame
))
431 printbufidx
= FRAME_MESSAGE_BUF_SIZE (mini_frame
);
432 /* Rewind incomplete multi-byte form. */
433 while (printbufidx
> 0 && tembuf
[printbufidx
] >= 0xA0)
436 bcopy (tembuf
, FRAME_MESSAGE_BUF (mini_frame
), printbufidx
);
439 /* Record whether the message buffer is multibyte.
440 (If at any point some multibyte characters are added, then it is.) */
441 if (len
> 0 && ! NILP (current_buffer
->enable_multibyte_characters
))
442 message_enable_multibyte
= 1;
444 if (printbufidx
< FRAME_MESSAGE_BUF_SIZE (mini_frame
) - len
)
446 bcopy (str
, &FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
], len
);
449 FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
] = 0;
450 echo_area_glyphs_length
= printbufidx
;
454 #endif /* not standalone */
456 XSETFASTINT (ch1
, ch
);
461 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
464 Lisp_Object printcharfun
;
470 size_byte
= size
= strlen (ptr
);
472 if (EQ (printcharfun
, Qnil
))
474 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
476 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
477 print_buffer
= (char *) xrealloc (print_buffer
,
480 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
481 print_buffer_pos
+= size
;
482 print_buffer_pos_byte
+= size_byte
;
484 #ifdef MAX_PRINT_CHARS
487 #endif /* MAX_PRINT_CHARS */
490 if (EQ (printcharfun
, Qt
))
493 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
497 #ifdef MAX_PRINT_CHARS
500 #endif /* MAX_PRINT_CHARS */
504 fwrite (ptr
, 1, size_byte
, stdout
);
505 noninteractive_need_newline
= 1;
509 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
510 || !message_buf_print
)
512 message_log_maybe_newline ();
513 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
515 echo_area_glyphs_length
= 0;
516 message_buf_print
= 1;
518 if (minibuffer_auto_raise
)
520 Lisp_Object mini_window
;
522 /* Get the frame containing the minibuffer
523 that the selected frame is using. */
524 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
526 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
530 message_dolog (ptr
, size_byte
, 0, multibyte
);
532 /* Convert message to multibyte if we are now adding multibyte text. */
534 && ! message_enable_multibyte
537 int size
= count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame
),
539 unsigned char *tembuf
= (unsigned char *) alloca (size
+ 1);
540 copy_text (FRAME_MESSAGE_BUF (mini_frame
), tembuf
, printbufidx
,
543 if (printbufidx
> FRAME_MESSAGE_BUF_SIZE (mini_frame
))
545 printbufidx
= FRAME_MESSAGE_BUF_SIZE (mini_frame
);
546 /* Rewind incomplete multi-byte form. */
547 while (printbufidx
> 0 && tembuf
[printbufidx
] >= 0xA0)
551 bcopy (tembuf
, FRAME_MESSAGE_BUF (mini_frame
), printbufidx
);
555 message_enable_multibyte
= 1;
557 /* Compute how much of the new text will fit there. */
558 if (size_byte
> FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1)
560 size_byte
= FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1;
561 /* Rewind incomplete multi-byte form. */
562 while (size_byte
&& (unsigned char) ptr
[size_byte
] >= 0xA0)
566 /* Put that part of the new text in. */
567 bcopy (ptr
, &FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
], size_byte
);
568 printbufidx
+= size_byte
;
569 FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
] = 0;
570 echo_area_glyphs_length
= printbufidx
;
576 if (size
== size_byte
)
577 while (i
< size_byte
)
584 while (i
< size_byte
)
586 /* Here, we must convert each multi-byte form to the
587 corresponding character code before handing it to PRINTCHAR. */
589 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
596 /* Print the contents of a string STRING using PRINTCHARFUN.
597 It isn't safe to use strout in many cases,
598 because printing one char can relocate. */
601 print_string (string
, printcharfun
)
603 Lisp_Object printcharfun
;
605 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
609 if (STRING_MULTIBYTE (string
))
610 chars
= XSTRING (string
)->size
;
611 else if (EQ (printcharfun
, Qt
)
612 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
613 : ! NILP (current_buffer
->enable_multibyte_characters
))
614 chars
= multibyte_chars_in_text (XSTRING (string
)->data
,
615 STRING_BYTES (XSTRING (string
)));
617 chars
= STRING_BYTES (XSTRING (string
));
619 /* strout is safe for output to a frame (echo area) or to print_buffer. */
620 strout (XSTRING (string
)->data
,
621 chars
, STRING_BYTES (XSTRING (string
)),
622 printcharfun
, STRING_MULTIBYTE (string
));
626 /* Otherwise, string may be relocated by printing one char.
627 So re-fetch the string address for each character. */
629 int size
= XSTRING (string
)->size
;
630 int size_byte
= STRING_BYTES (XSTRING (string
));
633 if (size
== size_byte
)
634 for (i
= 0; i
< size
; i
++)
635 PRINTCHAR (XSTRING (string
)->data
[i
]);
637 for (i
= 0; i
< size_byte
; i
++)
639 /* Here, we must convert each multi-byte form to the
640 corresponding character code before handing it to PRINTCHAR. */
642 int ch
= STRING_CHAR_AND_CHAR_LENGTH (XSTRING (string
)->data
+ i
,
644 if (!CHAR_VALID_P (ch
, 0))
646 ch
= XSTRING (string
)->data
[i
];
656 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
657 "Output character CHARACTER to stream PRINTCHARFUN.\n\
658 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
659 (character
, printcharfun
)
660 Lisp_Object character
, printcharfun
;
664 if (NILP (printcharfun
))
665 printcharfun
= Vstandard_output
;
666 CHECK_NUMBER (character
, 0);
668 PRINTCHAR (XINT (character
));
673 /* Used from outside of print.c to print a block of SIZE
674 single-byte chars at DATA on the default output stream.
675 Do not use this on the contents of a Lisp string. */
678 write_string (data
, size
)
683 Lisp_Object printcharfun
;
685 printcharfun
= Vstandard_output
;
688 strout (data
, size
, size
, printcharfun
, 0);
692 /* Used from outside of print.c to print a block of SIZE
693 single-byte chars at DATA on a specified stream PRINTCHARFUN.
694 Do not use this on the contents of a Lisp string. */
697 write_string_1 (data
, size
, printcharfun
)
700 Lisp_Object printcharfun
;
705 strout (data
, size
, size
, printcharfun
, 0);
713 temp_output_buffer_setup (bufname
)
716 register struct buffer
*old
= current_buffer
;
717 register Lisp_Object buf
;
719 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
721 current_buffer
->directory
= old
->directory
;
722 current_buffer
->read_only
= Qnil
;
723 current_buffer
->filename
= Qnil
;
724 current_buffer
->undo_list
= Qt
;
725 current_buffer
->overlays_before
= Qnil
;
726 current_buffer
->overlays_after
= Qnil
;
727 current_buffer
->enable_multibyte_characters
728 = buffer_defaults
.enable_multibyte_characters
;
731 XSETBUFFER (buf
, current_buffer
);
732 specbind (Qstandard_output
, buf
);
734 set_buffer_internal (old
);
738 internal_with_output_to_temp_buffer (bufname
, function
, args
)
740 Lisp_Object (*function
) P_ ((Lisp_Object
));
743 int count
= specpdl_ptr
- specpdl
;
744 Lisp_Object buf
, val
;
748 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
749 temp_output_buffer_setup (bufname
);
750 buf
= Vstandard_output
;
753 val
= (*function
) (args
);
756 temp_output_buffer_show (buf
);
759 return unbind_to (count
, val
);
762 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
764 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
765 The buffer is cleared out initially, and marked as unmodified when done.\n\
766 All output done by BODY is inserted in that buffer by default.\n\
767 The buffer is displayed in another window, but not selected.\n\
768 The hook `temp-buffer-show-hook' is run with that window selected\n\
769 temporarily and its buffer current.\n\
770 The value of the last form in BODY is returned.\n\
771 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
772 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
773 to get the buffer displayed instead of just displaying the non-selected\n\
774 buffer and calling the hook. It gets one argument, the buffer to display.")
780 int count
= specpdl_ptr
- specpdl
;
781 Lisp_Object buf
, val
;
784 name
= Feval (Fcar (args
));
787 CHECK_STRING (name
, 0);
788 temp_output_buffer_setup (XSTRING (name
)->data
);
789 buf
= Vstandard_output
;
791 val
= Fprogn (Fcdr (args
));
793 temp_output_buffer_show (buf
);
795 return unbind_to (count
, val
);
797 #endif /* not standalone */
799 static void print ();
801 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
802 "Output a newline to stream PRINTCHARFUN.\n\
803 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
805 Lisp_Object printcharfun
;
809 if (NILP (printcharfun
))
810 printcharfun
= Vstandard_output
;
817 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
818 "Output the printed representation of OBJECT, any Lisp object.\n\
819 Quoting characters are printed when needed to make output that `read'\n\
820 can handle, whenever this is possible.\n\
821 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
822 (object
, printcharfun
)
823 Lisp_Object object
, printcharfun
;
827 #ifdef MAX_PRINT_CHARS
829 #endif /* MAX_PRINT_CHARS */
830 if (NILP (printcharfun
))
831 printcharfun
= Vstandard_output
;
834 print (object
, printcharfun
, 1);
839 /* a buffer which is used to hold output being built by prin1-to-string */
840 Lisp_Object Vprin1_to_string_buffer
;
842 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
843 "Return a string containing the printed representation of OBJECT,\n\
844 any Lisp object. Quoting characters are used when needed to make output\n\
845 that `read' can handle, whenever this is possible, unless the optional\n\
846 second argument NOESCAPE is non-nil.")
848 Lisp_Object object
, noescape
;
851 Lisp_Object printcharfun
;
852 struct gcpro gcpro1
, gcpro2
;
855 /* Save and restore this--we are altering a buffer
856 but we don't want to deactivate the mark just for that.
857 No need for specbind, since errors deactivate the mark. */
858 tem
= Vdeactivate_mark
;
859 GCPRO2 (object
, tem
);
861 printcharfun
= Vprin1_to_string_buffer
;
864 print (object
, printcharfun
, NILP (noescape
));
865 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
867 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
868 object
= Fbuffer_string ();
871 set_buffer_internal (old
);
873 Vdeactivate_mark
= tem
;
879 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
880 "Output the printed representation of OBJECT, any Lisp object.\n\
881 No quoting characters are used; no delimiters are printed around\n\
882 the contents of strings.\n\
883 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
884 (object
, printcharfun
)
885 Lisp_Object object
, printcharfun
;
889 if (NILP (printcharfun
))
890 printcharfun
= Vstandard_output
;
893 print (object
, printcharfun
, 0);
898 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
899 "Output the printed representation of OBJECT, with newlines around it.\n\
900 Quoting characters are printed when needed to make output that `read'\n\
901 can handle, whenever this is possible.\n\
902 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
903 (object
, printcharfun
)
904 Lisp_Object object
, printcharfun
;
909 #ifdef MAX_PRINT_CHARS
911 max_print
= MAX_PRINT_CHARS
;
912 #endif /* MAX_PRINT_CHARS */
913 if (NILP (printcharfun
))
914 printcharfun
= Vstandard_output
;
919 print (object
, printcharfun
, 1);
922 #ifdef MAX_PRINT_CHARS
925 #endif /* MAX_PRINT_CHARS */
930 /* The subroutine object for external-debugging-output is kept here
931 for the convenience of the debugger. */
932 Lisp_Object Qexternal_debugging_output
;
934 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
935 "Write CHARACTER to stderr.\n\
936 You can call print while debugging emacs, and pass it this function\n\
937 to make it write to the debugging output.\n")
939 Lisp_Object character
;
941 CHECK_NUMBER (character
, 0);
942 putc (XINT (character
), stderr
);
945 /* Send the output to a debugger (nothing happens if there isn't one). */
947 char buf
[2] = {(char) XINT (character
), '\0'};
948 OutputDebugString (buf
);
955 /* This is the interface for debugging printing. */
961 Fprin1 (arg
, Qexternal_debugging_output
);
962 fprintf (stderr
, "\r\n");
965 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
967 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
971 struct buffer
*old
= current_buffer
;
972 Lisp_Object original
, printcharfun
, value
;
975 /* If OBJ is (error STRING), just return STRING.
976 That is not only faster, it also avoids the need to allocate
977 space here when the error is due to memory full. */
978 if (CONSP (obj
) && EQ (XCONS (obj
)->car
, Qerror
)
979 && CONSP (XCONS (obj
)->cdr
)
980 && STRINGP (XCONS (XCONS (obj
)->cdr
)->car
)
981 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
982 return XCONS (XCONS (obj
)->cdr
)->car
;
984 print_error_message (obj
, Vprin1_to_string_buffer
);
986 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
987 value
= Fbuffer_string ();
991 set_buffer_internal (old
);
997 /* Print an error message for the error DATA
998 onto Lisp output stream STREAM (suitable for the print functions). */
1001 print_error_message (data
, stream
)
1002 Lisp_Object data
, stream
;
1004 Lisp_Object errname
, errmsg
, file_error
, tail
;
1005 struct gcpro gcpro1
;
1008 errname
= Fcar (data
);
1010 if (EQ (errname
, Qerror
))
1013 if (!CONSP (data
)) data
= Qnil
;
1014 errmsg
= Fcar (data
);
1019 errmsg
= Fget (errname
, Qerror_message
);
1020 file_error
= Fmemq (Qfile_error
,
1021 Fget (errname
, Qerror_conditions
));
1024 /* Print an error message including the data items. */
1026 tail
= Fcdr_safe (data
);
1029 /* For file-error, make error message by concatenating
1030 all the data items. They are all strings. */
1031 if (!NILP (file_error
) && !NILP (tail
))
1032 errmsg
= XCONS (tail
)->car
, tail
= XCONS (tail
)->cdr
;
1034 if (STRINGP (errmsg
))
1035 Fprinc (errmsg
, stream
);
1037 write_string_1 ("peculiar error", -1, stream
);
1039 for (i
= 0; CONSP (tail
); tail
= Fcdr (tail
), i
++)
1041 write_string_1 (i
? ", " : ": ", 2, stream
);
1042 if (!NILP (file_error
))
1043 Fprinc (Fcar (tail
), stream
);
1045 Fprin1 (Fcar (tail
), stream
);
1050 #ifdef LISP_FLOAT_TYPE
1053 * The buffer should be at least as large as the max string size of the
1054 * largest float, printed in the biggest notation. This is undoubtedly
1055 * 20d float_output_format, with the negative of the C-constant "HUGE"
1058 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1060 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1061 * case of -1e307 in 20d float_output_format. What is one to do (short of
1062 * re-writing _doprnt to be more sane)?
1067 float_to_string (buf
, data
)
1074 /* Check for plus infinity in a way that won't lose
1075 if there is no plus infinity. */
1076 if (data
== data
/ 2 && data
> 1.0)
1078 strcpy (buf
, "1.0e+INF");
1081 /* Likewise for minus infinity. */
1082 if (data
== data
/ 2 && data
< -1.0)
1084 strcpy (buf
, "-1.0e+INF");
1087 /* Check for NaN in a way that won't fail if there are no NaNs. */
1088 if (! (data
* 0.0 >= 0.0))
1090 strcpy (buf
, "0.0e+NaN");
1094 if (NILP (Vfloat_output_format
)
1095 || !STRINGP (Vfloat_output_format
))
1098 /* Generate the fewest number of digits that represent the
1099 floating point value without losing information.
1100 The following method is simple but a bit slow.
1101 For ideas about speeding things up, please see:
1103 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1104 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1106 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1107 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1109 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1111 sprintf (buf
, "%.*g", width
, data
);
1112 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1114 else /* oink oink */
1116 /* Check that the spec we have is fully valid.
1117 This means not only valid for printf,
1118 but meant for floats, and reasonable. */
1119 cp
= XSTRING (Vfloat_output_format
)->data
;
1128 /* Check the width specification. */
1130 if ('0' <= *cp
&& *cp
<= '9')
1134 width
= (width
* 10) + (*cp
++ - '0');
1135 while (*cp
>= '0' && *cp
<= '9');
1137 /* A precision of zero is valid only for %f. */
1139 || (width
== 0 && *cp
!= 'f'))
1143 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1149 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
1152 /* Make sure there is a decimal point with digit after, or an
1153 exponent, so that the value is readable as a float. But don't do
1154 this with "%.0f"; it's valid for that not to produce a decimal
1155 point. Note that width can be 0 only for %.0f. */
1158 for (cp
= buf
; *cp
; cp
++)
1159 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1162 if (*cp
== '.' && cp
[1] == 0)
1176 #endif /* LISP_FLOAT_TYPE */
1179 print (obj
, printcharfun
, escapeflag
)
1181 register Lisp_Object printcharfun
;
1188 #if 1 /* I'm not sure this is really worth doing. */
1189 /* Detect circularities and truncate them.
1190 No need to offer any alternative--this is better than an error. */
1191 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
1194 for (i
= 0; i
< print_depth
; i
++)
1195 if (EQ (obj
, being_printed
[i
]))
1197 sprintf (buf
, "#%d", i
);
1198 strout (buf
, -1, -1, printcharfun
, 0);
1204 being_printed
[print_depth
] = obj
;
1207 if (print_depth
> PRINT_CIRCLE
)
1208 error ("Apparently circular structure being printed");
1209 #ifdef MAX_PRINT_CHARS
1210 if (max_print
&& print_chars
> max_print
)
1215 #endif /* MAX_PRINT_CHARS */
1217 switch (XGCTYPE (obj
))
1220 if (sizeof (int) == sizeof (EMACS_INT
))
1221 sprintf (buf
, "%d", XINT (obj
));
1222 else if (sizeof (long) == sizeof (EMACS_INT
))
1223 sprintf (buf
, "%ld", XINT (obj
));
1226 strout (buf
, -1, -1, printcharfun
, 0);
1229 #ifdef LISP_FLOAT_TYPE
1232 char pigbuf
[350]; /* see comments in float_to_string */
1234 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
1235 strout (pigbuf
, -1, -1, printcharfun
, 0);
1242 print_string (obj
, printcharfun
);
1245 register int i
, i_byte
;
1246 register unsigned char c
;
1247 struct gcpro gcpro1
;
1250 /* 1 means we must ensure that the next character we output
1251 cannot be taken as part of a hex character escape. */
1252 int need_nonhex
= 0;
1256 #ifdef USE_TEXT_PROPERTIES
1257 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1265 str
= XSTRING (obj
)->data
;
1266 size_byte
= STRING_BYTES (XSTRING (obj
));
1268 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1270 /* Here, we must convert each multi-byte form to the
1271 corresponding character code before handing it to PRINTCHAR. */
1275 if (STRING_MULTIBYTE (obj
))
1277 c
= STRING_CHAR_AND_CHAR_LENGTH (str
+ i_byte
,
1278 size_byte
- i_byte
, len
);
1279 if (CHAR_VALID_P (c
, 0))
1289 if (c
== '\n' && print_escape_newlines
)
1294 else if (c
== '\f' && print_escape_newlines
)
1299 else if (! SINGLE_BYTE_CHAR_P (c
) && print_escape_multibyte
)
1301 /* When multibyte is disabled,
1302 print multibyte string chars using hex escapes. */
1303 unsigned char outbuf
[50];
1304 sprintf (outbuf
, "\\x%x", c
);
1305 strout (outbuf
, -1, -1, printcharfun
, 0);
1308 else if (SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1309 && print_escape_nonascii
)
1311 /* When printing in a multibyte buffer
1312 or when explicitly requested,
1313 print single-byte non-ASCII string chars
1314 using octal escapes. */
1315 unsigned char outbuf
[5];
1316 sprintf (outbuf
, "\\%03o", c
);
1317 strout (outbuf
, -1, -1, printcharfun
, 0);
1321 /* If we just had a hex escape, and this character
1322 could be taken as part of it,
1323 output `\ ' to prevent that. */
1327 if ((c
>= 'a' && c
<= 'f')
1328 || (c
>= 'A' && c
<= 'F')
1329 || (c
>= '0' && c
<= '9'))
1330 strout ("\\ ", -1, -1, printcharfun
, 0);
1333 if (c
== '\"' || c
== '\\')
1340 #ifdef USE_TEXT_PROPERTIES
1341 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1343 traverse_intervals (XSTRING (obj
)->intervals
,
1344 0, 0, print_interval
, printcharfun
);
1355 register int confusing
;
1356 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
1357 register unsigned char *end
= p
+ STRING_BYTES (XSYMBOL (obj
)->name
);
1359 int i
, i_byte
, size_byte
;
1362 XSETSTRING (name
, XSYMBOL (obj
)->name
);
1364 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1367 /* If symbol name begins with a digit, and ends with a digit,
1368 and contains nothing but digits and `e', it could be treated
1369 as a number. So set CONFUSING.
1371 Symbols that contain periods could also be taken as numbers,
1372 but periods are always escaped, so we don't have to worry
1374 else if (*p
>= '0' && *p
<= '9'
1375 && end
[-1] >= '0' && end
[-1] <= '9')
1377 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1378 /* Needed for \2e10. */
1381 confusing
= (end
== p
);
1386 /* If we print an uninterned symbol as part of a complex object and
1387 the flag print-gensym is non-nil, prefix it with #n= to read the
1388 object back with the #n# reader syntax later if needed. */
1389 if (! NILP (Vprint_gensym
) && NILP (XSYMBOL (obj
)->obarray
))
1391 if (print_depth
> 1)
1394 tem
= Fassq (obj
, Vprint_gensym_alist
);
1398 print (XCDR (tem
), printcharfun
, escapeflag
);
1404 if (CONSP (Vprint_gensym_alist
))
1405 XSETFASTINT (tem
, XFASTINT (XCDR (XCAR (Vprint_gensym_alist
))) + 1);
1407 XSETFASTINT (tem
, 1);
1408 Vprint_gensym_alist
= Fcons (Fcons (obj
, tem
), Vprint_gensym_alist
);
1411 print (tem
, printcharfun
, escapeflag
);
1419 size_byte
= STRING_BYTES (XSTRING (name
));
1421 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1423 /* Here, we must convert each multi-byte form to the
1424 corresponding character code before handing it to PRINTCHAR. */
1426 if (STRING_MULTIBYTE (name
))
1427 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1429 c
= XSTRING (name
)->data
[i_byte
++];
1435 if (c
== '\"' || c
== '\\' || c
== '\''
1436 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1437 || c
== ',' || c
=='.' || c
== '`'
1438 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1440 PRINTCHAR ('\\'), confusing
= 0;
1448 /* If deeper than spec'd depth, print placeholder. */
1449 if (INTEGERP (Vprint_level
)
1450 && print_depth
> XINT (Vprint_level
))
1451 strout ("...", -1, -1, printcharfun
, 0);
1452 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1453 && (EQ (XCAR (obj
), Qquote
)))
1456 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1458 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1459 && (EQ (XCAR (obj
), Qfunction
)))
1463 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1465 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1466 && ((EQ (XCAR (obj
), Qbackquote
)
1467 || EQ (XCAR (obj
), Qcomma
)
1468 || EQ (XCAR (obj
), Qcomma_at
)
1469 || EQ (XCAR (obj
), Qcomma_dot
))))
1471 print (XCAR (obj
), printcharfun
, 0);
1472 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1479 register int print_length
= 0;
1480 Lisp_Object halftail
= obj
;
1482 if (INTEGERP (Vprint_length
))
1483 print_length
= XINT (Vprint_length
);
1486 /* Detect circular list. */
1487 if (i
!= 0 && EQ (obj
, halftail
))
1489 sprintf (buf
, " . #%d", i
/ 2);
1490 strout (buf
, -1, -1, printcharfun
, 0);
1496 if (print_length
&& i
> print_length
)
1498 strout ("...", 3, 3, printcharfun
, 0);
1501 print (XCAR (obj
), printcharfun
, escapeflag
);
1504 halftail
= XCDR (halftail
);
1509 strout (" . ", 3, 3, printcharfun
, 0);
1510 print (obj
, printcharfun
, escapeflag
);
1516 case Lisp_Vectorlike
:
1521 strout ("#<process ", -1, -1, printcharfun
, 0);
1522 print_string (XPROCESS (obj
)->name
, printcharfun
);
1526 print_string (XPROCESS (obj
)->name
, printcharfun
);
1528 else if (BOOL_VECTOR_P (obj
))
1531 register unsigned char c
;
1532 struct gcpro gcpro1
;
1534 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1540 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1541 strout (buf
, -1, -1, printcharfun
, 0);
1544 /* Don't print more characters than the specified maximum. */
1545 if (INTEGERP (Vprint_length
)
1546 && XINT (Vprint_length
) < size_in_chars
)
1547 size_in_chars
= XINT (Vprint_length
);
1549 for (i
= 0; i
< size_in_chars
; i
++)
1552 c
= XBOOL_VECTOR (obj
)->data
[i
];
1553 if (c
== '\n' && print_escape_newlines
)
1558 else if (c
== '\f' && print_escape_newlines
)
1565 if (c
== '\"' || c
== '\\')
1574 else if (SUBRP (obj
))
1576 strout ("#<subr ", -1, -1, printcharfun
, 0);
1577 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1581 else if (WINDOWP (obj
))
1583 strout ("#<window ", -1, -1, printcharfun
, 0);
1584 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1585 strout (buf
, -1, -1, printcharfun
, 0);
1586 if (!NILP (XWINDOW (obj
)->buffer
))
1588 strout (" on ", -1, -1, printcharfun
, 0);
1589 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1593 else if (BUFFERP (obj
))
1595 if (NILP (XBUFFER (obj
)->name
))
1596 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1597 else if (escapeflag
)
1599 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1600 print_string (XBUFFER (obj
)->name
, printcharfun
);
1604 print_string (XBUFFER (obj
)->name
, printcharfun
);
1606 else if (WINDOW_CONFIGURATIONP (obj
))
1608 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1610 else if (FRAMEP (obj
))
1612 strout ((FRAME_LIVE_P (XFRAME (obj
))
1613 ? "#<frame " : "#<dead frame "),
1614 -1, -1, printcharfun
, 0);
1615 print_string (XFRAME (obj
)->name
, printcharfun
);
1616 sprintf (buf
, " 0x%lx\\ ", (unsigned long) (XFRAME (obj
)));
1617 strout (buf
, -1, -1, printcharfun
, 0);
1620 #endif /* not standalone */
1623 int size
= XVECTOR (obj
)->size
;
1624 if (COMPILEDP (obj
))
1627 size
&= PSEUDOVECTOR_SIZE_MASK
;
1629 if (CHAR_TABLE_P (obj
))
1631 /* We print a char-table as if it were a vector,
1632 lumping the parent and default slots in with the
1633 character slots. But we add #^ as a prefix. */
1636 if (SUB_CHAR_TABLE_P (obj
))
1638 size
&= PSEUDOVECTOR_SIZE_MASK
;
1640 if (size
& PSEUDOVECTOR_FLAG
)
1646 register Lisp_Object tem
;
1648 /* Don't print more elements than the specified maximum. */
1649 if (INTEGERP (Vprint_length
)
1650 && XINT (Vprint_length
) < size
)
1651 size
= XINT (Vprint_length
);
1653 for (i
= 0; i
< size
; i
++)
1655 if (i
) PRINTCHAR (' ');
1656 tem
= XVECTOR (obj
)->contents
[i
];
1657 print (tem
, printcharfun
, escapeflag
);
1666 switch (XMISCTYPE (obj
))
1668 case Lisp_Misc_Marker
:
1669 strout ("#<marker ", -1, -1, printcharfun
, 0);
1670 /* Do you think this is necessary? */
1671 if (XMARKER (obj
)->insertion_type
!= 0)
1672 strout ("(before-insertion) ", -1, -1, printcharfun
, 0);
1673 if (!(XMARKER (obj
)->buffer
))
1674 strout ("in no buffer", -1, -1, printcharfun
, 0);
1677 sprintf (buf
, "at %d", marker_position (obj
));
1678 strout (buf
, -1, -1, printcharfun
, 0);
1679 strout (" in ", -1, -1, printcharfun
, 0);
1680 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1685 case Lisp_Misc_Overlay
:
1686 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1687 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1688 strout ("in no buffer", -1, -1, printcharfun
, 0);
1691 sprintf (buf
, "from %d to %d in ",
1692 marker_position (OVERLAY_START (obj
)),
1693 marker_position (OVERLAY_END (obj
)));
1694 strout (buf
, -1, -1, printcharfun
, 0);
1695 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1701 /* Remaining cases shouldn't happen in normal usage, but let's print
1702 them anyway for the benefit of the debugger. */
1703 case Lisp_Misc_Free
:
1704 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1707 case Lisp_Misc_Intfwd
:
1708 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1709 strout (buf
, -1, -1, printcharfun
, 0);
1712 case Lisp_Misc_Boolfwd
:
1713 sprintf (buf
, "#<boolfwd to %s>",
1714 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1715 strout (buf
, -1, -1, printcharfun
, 0);
1718 case Lisp_Misc_Objfwd
:
1719 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
1720 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1724 case Lisp_Misc_Buffer_Objfwd
:
1725 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
1726 print (*(Lisp_Object
*)((char *)current_buffer
1727 + XBUFFER_OBJFWD (obj
)->offset
),
1728 printcharfun
, escapeflag
);
1732 case Lisp_Misc_Kboard_Objfwd
:
1733 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
1734 print (*(Lisp_Object
*)((char *) current_kboard
1735 + XKBOARD_OBJFWD (obj
)->offset
),
1736 printcharfun
, escapeflag
);
1740 case Lisp_Misc_Buffer_Local_Value
:
1741 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
1742 goto do_buffer_local
;
1743 case Lisp_Misc_Some_Buffer_Local_Value
:
1744 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
1746 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
1747 print (XBUFFER_LOCAL_VALUE (obj
)->realvalue
, printcharfun
, escapeflag
);
1748 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
1749 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
1751 strout ("[buffer] ", -1, -1, printcharfun
, 0);
1752 print (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
1753 printcharfun
, escapeflag
);
1754 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
1756 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
1757 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
1759 strout ("[frame] ", -1, -1, printcharfun
, 0);
1760 print (XBUFFER_LOCAL_VALUE (obj
)->frame
,
1761 printcharfun
, escapeflag
);
1763 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
1764 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1765 printcharfun
, escapeflag
);
1766 strout ("[default-value] ", -1, -1, printcharfun
, 0);
1767 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
,
1768 printcharfun
, escapeflag
);
1776 #endif /* standalone */
1781 /* We're in trouble if this happens!
1782 Probably should just abort () */
1783 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
1785 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1786 else if (VECTORLIKEP (obj
))
1787 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1789 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1790 strout (buf
, -1, -1, printcharfun
, 0);
1791 strout (" Save your buffers immediately and please report this bug>",
1792 -1, -1, printcharfun
, 0);
1799 #ifdef USE_TEXT_PROPERTIES
1801 /* Print a description of INTERVAL using PRINTCHARFUN.
1802 This is part of printing a string that has text properties. */
1805 print_interval (interval
, printcharfun
)
1807 Lisp_Object printcharfun
;
1810 print (make_number (interval
->position
), printcharfun
, 1);
1812 print (make_number (interval
->position
+ LENGTH (interval
)),
1815 print (interval
->plist
, printcharfun
, 1);
1818 #endif /* USE_TEXT_PROPERTIES */
1823 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1824 "Output stream `print' uses by default for outputting a character.\n\
1825 This may be any function of one argument.\n\
1826 It may also be a buffer (output is inserted before point)\n\
1827 or a marker (output is inserted and the marker is advanced)\n\
1828 or the symbol t (output appears in the echo area).");
1829 Vstandard_output
= Qt
;
1830 Qstandard_output
= intern ("standard-output");
1831 staticpro (&Qstandard_output
);
1833 #ifdef LISP_FLOAT_TYPE
1834 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1835 "The format descriptor string used to print floats.\n\
1836 This is a %-spec like those accepted by `printf' in C,\n\
1837 but with some restrictions. It must start with the two characters `%.'.\n\
1838 After that comes an integer precision specification,\n\
1839 and then a letter which controls the format.\n\
1840 The letters allowed are `e', `f' and `g'.\n\
1841 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1842 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1843 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1844 The precision in any of these cases is the number of digits following\n\
1845 the decimal point. With `f', a precision of 0 means to omit the\n\
1846 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1847 A value of nil means to use the shortest notation\n\
1848 that represents the number without losing information.");
1849 Vfloat_output_format
= Qnil
;
1850 Qfloat_output_format
= intern ("float-output-format");
1851 staticpro (&Qfloat_output_format
);
1852 #endif /* LISP_FLOAT_TYPE */
1854 DEFVAR_LISP ("print-length", &Vprint_length
,
1855 "Maximum length of list to print before abbreviating.\n\
1856 A value of nil means no limit.");
1857 Vprint_length
= Qnil
;
1859 DEFVAR_LISP ("print-level", &Vprint_level
,
1860 "Maximum depth of list nesting to print before abbreviating.\n\
1861 A value of nil means no limit.");
1862 Vprint_level
= Qnil
;
1864 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1865 "Non-nil means print newlines in strings as backslash-n.\n\
1866 Also print formfeeds as backslash-f.");
1867 print_escape_newlines
= 0;
1869 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
1870 "Non-nil means print unibyte non-ASCII chars in strings as \\OOO.\n\
1871 \(OOO is the octal representation of the character code.)\n\
1872 Only single-byte characters are affected, and only in `prin1'.");
1873 print_escape_nonascii
= 0;
1875 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
1876 "Non-nil means print multibyte characters in strings as \\xXXXX.\n\
1877 \(XXX is the hex representation of the character code.)\n\
1878 This affects only `prin1'.");
1879 print_escape_multibyte
= 0;
1881 DEFVAR_BOOL ("print-quoted", &print_quoted
,
1882 "Non-nil means print quoted forms with reader syntax.\n\
1883 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\
1884 forms print in the new syntax.");
1887 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
1888 "Non-nil means print uninterned symbols so they will read as uninterned.\n\
1889 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\
1890 When the uninterned symbol appears within a larger data structure,\n\
1891 in addition use the #...# and #...= constructs as needed,\n\
1892 so that multiple references to the same symbol are shared once again\n\
1893 when the text is read back.\n\
1895 If the value of `print-gensym' is a cons cell, then in addition refrain from\n\
1896 clearing `print-gensym-alist' on entry to and exit from printing functions,\n\
1897 so that the use of #...# and #...= can carry over for several separately\n\
1899 Vprint_gensym
= Qnil
;
1901 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist
,
1902 "Association list of elements (GENSYM . N) to guide use of #N# and #N=.\n\
1903 In each element, GENSYM is an uninterned symbol that has been associated\n\
1904 with #N= for the specified value of N.");
1905 Vprint_gensym_alist
= Qnil
;
1907 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1908 staticpro (&Vprin1_to_string_buffer
);
1911 defsubr (&Sprin1_to_string
);
1912 defsubr (&Serror_message_string
);
1916 defsubr (&Swrite_char
);
1917 defsubr (&Sexternal_debugging_output
);
1919 Qexternal_debugging_output
= intern ("external-debugging-output");
1920 staticpro (&Qexternal_debugging_output
);
1922 Qprint_escape_newlines
= intern ("print-escape-newlines");
1923 staticpro (&Qprint_escape_newlines
);
1925 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
1926 staticpro (&Qprint_escape_multibyte
);
1928 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
1929 staticpro (&Qprint_escape_nonascii
);
1932 defsubr (&Swith_output_to_temp_buffer
);
1933 #endif /* not standalone */