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 Lisp_Object Qtemp_buffer_setup_hook
;
46 /* These are used to print like we read. */
47 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
49 #ifdef LISP_FLOAT_TYPE
50 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
52 /* Work around a problem that happens because math.h on hpux 7
53 defines two static variables--which, in Emacs, are not really static,
54 because `static' is defined as nothing. The problem is that they are
55 defined both here and in lread.c.
56 These macros prevent the name conflict. */
57 #if defined (HPUX) && !defined (HPUX8)
58 #define _MAXLDBL print_maxldbl
59 #define _NMAXLDBL print_nmaxldbl
69 /* Default to values appropriate for IEEE floating point. */
74 #define DBL_MANT_DIG 53
80 #define DBL_MIN 2.2250738585072014e-308
83 #ifdef DBL_MIN_REPLACEMENT
85 #define DBL_MIN DBL_MIN_REPLACEMENT
88 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
89 needed to express a float without losing information.
90 The general-case formula is valid for the usual case, IEEE floating point,
91 but many compilers can't optimize the formula to an integer constant,
92 so make a special case for it. */
93 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
94 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
96 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
99 #endif /* LISP_FLOAT_TYPE */
101 /* Avoid actual stack overflow in print. */
104 /* Detect most circularities to print finite output. */
105 #define PRINT_CIRCLE 200
106 Lisp_Object being_printed
[PRINT_CIRCLE
];
108 /* When printing into a buffer, first we put the text in this
109 block, then insert it all at once. */
112 /* Size allocated in print_buffer. */
113 int print_buffer_size
;
114 /* Chars stored in print_buffer. */
115 int print_buffer_pos
;
116 /* Bytes stored in print_buffer. */
117 int print_buffer_pos_byte
;
119 /* Maximum length of list to print in full; noninteger means
120 effectively infinity */
122 Lisp_Object Vprint_length
;
124 /* Maximum depth of list to print in full; noninteger means
125 effectively infinity. */
127 Lisp_Object Vprint_level
;
129 /* Nonzero means print newlines in strings as \n. */
131 int print_escape_newlines
;
133 /* Nonzero means to print single-byte non-ascii characters in strings as
136 int print_escape_nonascii
;
138 /* Nonzero means to print multibyte characters in strings as hex escapes. */
140 int print_escape_multibyte
;
142 Lisp_Object Qprint_escape_newlines
;
143 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
145 /* Nonzero means print (quote foo) forms as 'foo, etc. */
149 /* Non-nil means print #: before uninterned symbols.
150 Neither t nor nil means so that and don't clear Vprint_gensym_alist
151 on entry to and exit from print functions. */
153 Lisp_Object Vprint_gensym
;
155 /* Association list of certain objects that are `eq' in the form being
156 printed and which should be `eq' when read back in, using the #n=object
157 and #n# reader forms. Each element has the form (object . n). */
159 Lisp_Object Vprint_gensym_alist
;
161 /* Nonzero means print newline to stdout before next minibuffer message.
162 Defined in xdisp.c */
164 extern int noninteractive_need_newline
;
166 extern int minibuffer_auto_raise
;
168 #ifdef MAX_PRINT_CHARS
169 static int print_chars
;
170 static int max_print
;
171 #endif /* MAX_PRINT_CHARS */
173 void print_interval ();
176 /* Convert between chars and GLYPHs */
180 register GLYPH
*glyphs
;
190 str_to_glyph_cpy (str
, glyphs
)
194 register GLYPH
*gp
= glyphs
;
195 register char *cp
= str
;
202 str_to_glyph_ncpy (str
, glyphs
, n
)
207 register GLYPH
*gp
= glyphs
;
208 register char *cp
= str
;
215 glyph_to_str_cpy (glyphs
, str
)
219 register GLYPH
*gp
= glyphs
;
220 register char *cp
= str
;
223 *str
++ = *gp
++ & 0377;
227 /* Low level output routines for characters and strings */
229 /* Lisp functions to do output using a stream
230 must have the stream in a variable called printcharfun
231 and must start with PRINTPREPARE, end with PRINTFINISH,
232 and use PRINTDECLARE to declare common variables.
233 Use PRINTCHAR to output one character,
234 or call strout to output a block of characters.
237 #define PRINTDECLARE \
238 struct buffer *old = current_buffer; \
239 int old_point = -1, start_point; \
240 int old_point_byte, start_point_byte; \
241 int specpdl_count = specpdl_ptr - specpdl; \
242 int free_print_buffer = 0; \
245 #define PRINTPREPARE \
246 original = printcharfun; \
247 if (NILP (printcharfun)) printcharfun = Qt; \
248 if (BUFFERP (printcharfun)) \
250 if (XBUFFER (printcharfun) != current_buffer) \
251 Fset_buffer (printcharfun); \
252 printcharfun = Qnil; \
254 if (MARKERP (printcharfun)) \
256 if (!(XMARKER (original)->buffer)) \
257 error ("Marker does not point anywhere"); \
258 if (XMARKER (original)->buffer != current_buffer) \
259 set_buffer_internal (XMARKER (original)->buffer); \
261 old_point_byte = PT_BYTE; \
262 SET_PT_BOTH (marker_position (printcharfun), \
263 marker_byte_position (printcharfun)); \
265 start_point_byte = PT_BYTE; \
266 printcharfun = Qnil; \
268 if (NILP (printcharfun)) \
270 Lisp_Object string; \
271 if (NILP (current_buffer->enable_multibyte_characters) \
272 && ! print_escape_multibyte) \
273 specbind (Qprint_escape_multibyte, Qt); \
274 if (! NILP (current_buffer->enable_multibyte_characters) \
275 && ! print_escape_nonascii) \
276 specbind (Qprint_escape_nonascii, Qt); \
277 if (print_buffer != 0) \
279 string = make_string_from_bytes (print_buffer, \
281 print_buffer_pos_byte); \
282 record_unwind_protect (print_unwind, string); \
286 print_buffer_size = 1000; \
287 print_buffer = (char *) xmalloc (print_buffer_size); \
288 free_print_buffer = 1; \
290 print_buffer_pos = 0; \
291 print_buffer_pos_byte = 0; \
293 if (!CONSP (Vprint_gensym)) \
294 Vprint_gensym_alist = Qnil
296 #define PRINTFINISH \
297 if (NILP (printcharfun)) \
299 if (print_buffer_pos != print_buffer_pos_byte \
300 && NILP (current_buffer->enable_multibyte_characters)) \
302 unsigned char *temp \
303 = (unsigned char *) alloca (print_buffer_pos + 1); \
304 copy_text (print_buffer, temp, print_buffer_pos_byte, \
306 insert_1_both (temp, print_buffer_pos, \
307 print_buffer_pos, 0, 1, 0); \
310 insert_1_both (print_buffer, print_buffer_pos, \
311 print_buffer_pos_byte, 0, 1, 0); \
313 if (free_print_buffer) \
315 xfree (print_buffer); \
318 unbind_to (specpdl_count, Qnil); \
319 if (MARKERP (original)) \
320 set_marker_both (original, Qnil, PT, PT_BYTE); \
321 if (old_point >= 0) \
322 SET_PT_BOTH (old_point + (old_point >= start_point \
323 ? PT - start_point : 0), \
324 old_point_byte + (old_point_byte >= start_point_byte \
325 ? PT_BYTE - start_point_byte : 0)); \
326 if (old != current_buffer) \
327 set_buffer_internal (old); \
328 if (!CONSP (Vprint_gensym)) \
329 Vprint_gensym_alist = Qnil
331 #define PRINTCHAR(ch) printchar (ch, printcharfun)
333 /* Nonzero if there is no room to print any more characters
334 so print might as well return right away. */
336 #define PRINTFULLP() \
337 (EQ (printcharfun, Qt) && !noninteractive \
338 && printbufidx >= FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)))))
340 /* This is used to restore the saved contents of print_buffer
341 when there is a recursive call to print. */
343 print_unwind (saved_text
)
344 Lisp_Object saved_text
;
346 bcopy (XSTRING (saved_text
)->data
, print_buffer
, XSTRING (saved_text
)->size
);
349 /* Index of first unused element of FRAME_MESSAGE_BUF (mini_frame). */
350 static int printbufidx
;
359 #ifdef MAX_PRINT_CHARS
362 #endif /* MAX_PRINT_CHARS */
367 unsigned char work
[4], *str
;
370 len
= CHAR_STRING (ch
, work
, str
);
371 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
372 print_buffer
= (char *) xrealloc (print_buffer
,
373 print_buffer_size
*= 2);
374 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
375 print_buffer_pos
+= 1;
376 print_buffer_pos_byte
+= len
;
383 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
384 unsigned char work
[4], *str
;
385 int len
= CHAR_STRING (ch
, work
, str
);
392 putchar (*str
), str
++;
393 noninteractive_need_newline
= 1;
397 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
398 || !message_buf_print
)
400 message_log_maybe_newline ();
401 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
403 echo_area_glyphs_length
= 0;
404 message_buf_print
= 1;
406 if (minibuffer_auto_raise
)
408 Lisp_Object mini_window
;
410 /* Get the frame containing the minibuffer
411 that the selected frame is using. */
412 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
414 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
419 && ! NILP (current_buffer
->enable_multibyte_characters
)
420 && ! CHAR_HEAD_P (*str
))
422 /* Convert the unibyte character to multibyte. */
423 unsigned char c
= *str
;
425 len
= count_size_as_multibyte (&c
, 1);
426 copy_text (&c
, work
, 1, 0, 1);
430 message_dolog (str
, len
, 0, len
> 1);
432 if (! NILP (current_buffer
->enable_multibyte_characters
)
433 && ! message_enable_multibyte
)
435 /* Record that the message buffer is multibyte. */
436 message_enable_multibyte
= 1;
438 /* If we have already had some message text in the messsage
439 buffer, we convert it to multibyte. */
443 = count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame
),
445 unsigned char *tembuf
= (unsigned char *) alloca (size
+ 1);
446 copy_text (FRAME_MESSAGE_BUF (mini_frame
), tembuf
, printbufidx
,
449 if (printbufidx
> FRAME_MESSAGE_BUF_SIZE (mini_frame
))
451 printbufidx
= FRAME_MESSAGE_BUF_SIZE (mini_frame
);
452 /* Rewind incomplete multi-byte form. */
453 while (printbufidx
> 0 && tembuf
[printbufidx
] >= 0xA0)
456 bcopy (tembuf
, FRAME_MESSAGE_BUF (mini_frame
), printbufidx
);
460 if (printbufidx
< FRAME_MESSAGE_BUF_SIZE (mini_frame
) - len
)
462 bcopy (str
, &FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
], len
);
465 FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
] = 0;
466 echo_area_glyphs_length
= printbufidx
;
470 #endif /* not standalone */
472 XSETFASTINT (ch1
, ch
);
477 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
480 Lisp_Object printcharfun
;
486 size_byte
= size
= strlen (ptr
);
488 if (EQ (printcharfun
, Qnil
))
490 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
492 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
493 print_buffer
= (char *) xrealloc (print_buffer
,
496 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
497 print_buffer_pos
+= size
;
498 print_buffer_pos_byte
+= size_byte
;
500 #ifdef MAX_PRINT_CHARS
503 #endif /* MAX_PRINT_CHARS */
506 if (EQ (printcharfun
, Qt
))
509 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
513 #ifdef MAX_PRINT_CHARS
516 #endif /* MAX_PRINT_CHARS */
520 fwrite (ptr
, 1, size_byte
, stdout
);
521 noninteractive_need_newline
= 1;
525 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
526 || !message_buf_print
)
528 message_log_maybe_newline ();
529 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
531 echo_area_glyphs_length
= 0;
532 message_buf_print
= 1;
534 if (minibuffer_auto_raise
)
536 Lisp_Object mini_window
;
538 /* Get the frame containing the minibuffer
539 that the selected frame is using. */
540 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
542 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
546 message_dolog (ptr
, size_byte
, 0, multibyte
);
548 /* Convert message to multibyte if we are now adding multibyte text. */
550 && ! message_enable_multibyte
553 int size
= count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame
),
555 unsigned char *tembuf
= (unsigned char *) alloca (size
+ 1);
556 copy_text (FRAME_MESSAGE_BUF (mini_frame
), tembuf
, printbufidx
,
559 if (printbufidx
> FRAME_MESSAGE_BUF_SIZE (mini_frame
))
561 printbufidx
= FRAME_MESSAGE_BUF_SIZE (mini_frame
);
562 /* Rewind incomplete multi-byte form. */
563 while (printbufidx
> 0 && tembuf
[printbufidx
] >= 0xA0)
567 bcopy (tembuf
, FRAME_MESSAGE_BUF (mini_frame
), printbufidx
);
571 message_enable_multibyte
= 1;
573 /* Compute how much of the new text will fit there. */
574 if (size_byte
> FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1)
576 size_byte
= FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1;
577 /* Rewind incomplete multi-byte form. */
578 while (size_byte
&& (unsigned char) ptr
[size_byte
] >= 0xA0)
582 /* Put that part of the new text in. */
583 bcopy (ptr
, &FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
], size_byte
);
584 printbufidx
+= size_byte
;
585 FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
] = 0;
586 echo_area_glyphs_length
= printbufidx
;
592 if (size
== size_byte
)
593 while (i
< size_byte
)
600 while (i
< size_byte
)
602 /* Here, we must convert each multi-byte form to the
603 corresponding character code before handing it to PRINTCHAR. */
605 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
612 /* Print the contents of a string STRING using PRINTCHARFUN.
613 It isn't safe to use strout in many cases,
614 because printing one char can relocate. */
617 print_string (string
, printcharfun
)
619 Lisp_Object printcharfun
;
621 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
625 if (STRING_MULTIBYTE (string
))
626 chars
= XSTRING (string
)->size
;
627 else if (EQ (printcharfun
, Qt
)
628 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
629 : ! NILP (current_buffer
->enable_multibyte_characters
))
630 chars
= multibyte_chars_in_text (XSTRING (string
)->data
,
631 STRING_BYTES (XSTRING (string
)));
633 chars
= STRING_BYTES (XSTRING (string
));
635 /* strout is safe for output to a frame (echo area) or to print_buffer. */
636 strout (XSTRING (string
)->data
,
637 chars
, STRING_BYTES (XSTRING (string
)),
638 printcharfun
, STRING_MULTIBYTE (string
));
642 /* Otherwise, string may be relocated by printing one char.
643 So re-fetch the string address for each character. */
645 int size
= XSTRING (string
)->size
;
646 int size_byte
= STRING_BYTES (XSTRING (string
));
649 if (size
== size_byte
)
650 for (i
= 0; i
< size
; i
++)
651 PRINTCHAR (XSTRING (string
)->data
[i
]);
653 for (i
= 0; i
< size_byte
; i
++)
655 /* Here, we must convert each multi-byte form to the
656 corresponding character code before handing it to PRINTCHAR. */
658 int ch
= STRING_CHAR_AND_CHAR_LENGTH (XSTRING (string
)->data
+ i
,
660 if (!CHAR_VALID_P (ch
, 0))
662 ch
= XSTRING (string
)->data
[i
];
672 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
673 "Output character CHARACTER to stream PRINTCHARFUN.\n\
674 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
675 (character
, printcharfun
)
676 Lisp_Object character
, printcharfun
;
680 if (NILP (printcharfun
))
681 printcharfun
= Vstandard_output
;
682 CHECK_NUMBER (character
, 0);
684 PRINTCHAR (XINT (character
));
689 /* Used from outside of print.c to print a block of SIZE
690 single-byte chars at DATA on the default output stream.
691 Do not use this on the contents of a Lisp string. */
694 write_string (data
, size
)
699 Lisp_Object printcharfun
;
701 printcharfun
= Vstandard_output
;
704 strout (data
, size
, size
, printcharfun
, 0);
708 /* Used from outside of print.c to print a block of SIZE
709 single-byte chars at DATA on a specified stream PRINTCHARFUN.
710 Do not use this on the contents of a Lisp string. */
713 write_string_1 (data
, size
, printcharfun
)
716 Lisp_Object printcharfun
;
721 strout (data
, size
, size
, printcharfun
, 0);
729 temp_output_buffer_setup (bufname
)
732 int count
= specpdl_ptr
- specpdl
;
733 register struct buffer
*old
= current_buffer
;
734 register Lisp_Object buf
;
736 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
738 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
740 current_buffer
->directory
= old
->directory
;
741 current_buffer
->read_only
= Qnil
;
742 current_buffer
->filename
= Qnil
;
743 current_buffer
->undo_list
= Qt
;
744 current_buffer
->overlays_before
= Qnil
;
745 current_buffer
->overlays_after
= Qnil
;
746 current_buffer
->enable_multibyte_characters
747 = buffer_defaults
.enable_multibyte_characters
;
749 XSETBUFFER (buf
, current_buffer
);
751 call1 (Vrun_hooks
, Qtemp_buffer_setup_hook
);
753 unbind_to (count
, Qnil
);
755 specbind (Qstandard_output
, buf
);
759 internal_with_output_to_temp_buffer (bufname
, function
, args
)
761 Lisp_Object (*function
) P_ ((Lisp_Object
));
764 int count
= specpdl_ptr
- specpdl
;
765 Lisp_Object buf
, val
;
769 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
770 temp_output_buffer_setup (bufname
);
771 buf
= Vstandard_output
;
774 val
= (*function
) (args
);
777 temp_output_buffer_show (buf
);
780 return unbind_to (count
, val
);
783 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
785 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
786 The buffer is cleared out initially, and marked as unmodified when done.\n\
787 All output done by BODY is inserted in that buffer by default.\n\
788 The buffer is displayed in another window, but not selected.\n\
789 The value of the last form in BODY is returned.\n\
790 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\
792 The hook `temp-buffer-setup-hook' is run before BODY,\n\
793 with the buffer BUFNAME temporarily current.\n\
794 The hook `temp-buffer-show-hook' is run after the buffer is displayed,\n\
795 with the buffer temporarily current, and the window that was used\n\
796 to display it temporarily selected.\n\
798 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
799 to get the buffer displayed instead of just displaying the non-selected\n\
800 buffer and calling the hook. It gets one argument, the buffer to display.")
806 int count
= specpdl_ptr
- specpdl
;
807 Lisp_Object buf
, val
;
810 name
= Feval (Fcar (args
));
813 CHECK_STRING (name
, 0);
814 temp_output_buffer_setup (XSTRING (name
)->data
);
815 buf
= Vstandard_output
;
817 val
= Fprogn (Fcdr (args
));
819 temp_output_buffer_show (buf
);
821 return unbind_to (count
, val
);
823 #endif /* not standalone */
825 static void print ();
827 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
828 "Output a newline to stream PRINTCHARFUN.\n\
829 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
831 Lisp_Object printcharfun
;
835 if (NILP (printcharfun
))
836 printcharfun
= Vstandard_output
;
843 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
844 "Output the printed representation of OBJECT, any Lisp object.\n\
845 Quoting characters are printed when needed to make output that `read'\n\
846 can handle, whenever this is possible.\n\
847 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
848 (object
, printcharfun
)
849 Lisp_Object object
, printcharfun
;
853 #ifdef MAX_PRINT_CHARS
855 #endif /* MAX_PRINT_CHARS */
856 if (NILP (printcharfun
))
857 printcharfun
= Vstandard_output
;
860 print (object
, printcharfun
, 1);
865 /* a buffer which is used to hold output being built by prin1-to-string */
866 Lisp_Object Vprin1_to_string_buffer
;
868 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
869 "Return a string containing the printed representation of OBJECT,\n\
870 any Lisp object. Quoting characters are used when needed to make output\n\
871 that `read' can handle, whenever this is possible, unless the optional\n\
872 second argument NOESCAPE is non-nil.")
874 Lisp_Object object
, noescape
;
877 Lisp_Object printcharfun
;
878 struct gcpro gcpro1
, gcpro2
;
881 /* Save and restore this--we are altering a buffer
882 but we don't want to deactivate the mark just for that.
883 No need for specbind, since errors deactivate the mark. */
884 tem
= Vdeactivate_mark
;
885 GCPRO2 (object
, tem
);
887 printcharfun
= Vprin1_to_string_buffer
;
890 print (object
, printcharfun
, NILP (noescape
));
891 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
893 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
894 object
= Fbuffer_string ();
897 set_buffer_internal (old
);
899 Vdeactivate_mark
= tem
;
905 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
906 "Output the printed representation of OBJECT, any Lisp object.\n\
907 No quoting characters are used; no delimiters are printed around\n\
908 the contents of strings.\n\
909 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
910 (object
, printcharfun
)
911 Lisp_Object object
, printcharfun
;
915 if (NILP (printcharfun
))
916 printcharfun
= Vstandard_output
;
919 print (object
, printcharfun
, 0);
924 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
925 "Output the printed representation of OBJECT, with newlines around it.\n\
926 Quoting characters are printed when needed to make output that `read'\n\
927 can handle, whenever this is possible.\n\
928 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
929 (object
, printcharfun
)
930 Lisp_Object object
, printcharfun
;
935 #ifdef MAX_PRINT_CHARS
937 max_print
= MAX_PRINT_CHARS
;
938 #endif /* MAX_PRINT_CHARS */
939 if (NILP (printcharfun
))
940 printcharfun
= Vstandard_output
;
945 print (object
, printcharfun
, 1);
948 #ifdef MAX_PRINT_CHARS
951 #endif /* MAX_PRINT_CHARS */
956 /* The subroutine object for external-debugging-output is kept here
957 for the convenience of the debugger. */
958 Lisp_Object Qexternal_debugging_output
;
960 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
961 "Write CHARACTER to stderr.\n\
962 You can call print while debugging emacs, and pass it this function\n\
963 to make it write to the debugging output.\n")
965 Lisp_Object character
;
967 CHECK_NUMBER (character
, 0);
968 putc (XINT (character
), stderr
);
971 /* Send the output to a debugger (nothing happens if there isn't one). */
973 char buf
[2] = {(char) XINT (character
), '\0'};
974 OutputDebugString (buf
);
981 /* This is the interface for debugging printing. */
987 Fprin1 (arg
, Qexternal_debugging_output
);
988 fprintf (stderr
, "\r\n");
991 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
993 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
997 struct buffer
*old
= current_buffer
;
998 Lisp_Object original
, printcharfun
, value
;
1001 /* If OBJ is (error STRING), just return STRING.
1002 That is not only faster, it also avoids the need to allocate
1003 space here when the error is due to memory full. */
1004 if (CONSP (obj
) && EQ (XCONS (obj
)->car
, Qerror
)
1005 && CONSP (XCONS (obj
)->cdr
)
1006 && STRINGP (XCONS (XCONS (obj
)->cdr
)->car
)
1007 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
1008 return XCONS (XCONS (obj
)->cdr
)->car
;
1010 print_error_message (obj
, Vprin1_to_string_buffer
);
1012 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
1013 value
= Fbuffer_string ();
1017 set_buffer_internal (old
);
1023 /* Print an error message for the error DATA
1024 onto Lisp output stream STREAM (suitable for the print functions). */
1027 print_error_message (data
, stream
)
1028 Lisp_Object data
, stream
;
1030 Lisp_Object errname
, errmsg
, file_error
, tail
;
1031 struct gcpro gcpro1
;
1034 errname
= Fcar (data
);
1036 if (EQ (errname
, Qerror
))
1039 if (!CONSP (data
)) data
= Qnil
;
1040 errmsg
= Fcar (data
);
1045 errmsg
= Fget (errname
, Qerror_message
);
1046 file_error
= Fmemq (Qfile_error
,
1047 Fget (errname
, Qerror_conditions
));
1050 /* Print an error message including the data items. */
1052 tail
= Fcdr_safe (data
);
1055 /* For file-error, make error message by concatenating
1056 all the data items. They are all strings. */
1057 if (!NILP (file_error
) && !NILP (tail
))
1058 errmsg
= XCONS (tail
)->car
, tail
= XCONS (tail
)->cdr
;
1060 if (STRINGP (errmsg
))
1061 Fprinc (errmsg
, stream
);
1063 write_string_1 ("peculiar error", -1, stream
);
1065 for (i
= 0; CONSP (tail
); tail
= Fcdr (tail
), i
++)
1067 write_string_1 (i
? ", " : ": ", 2, stream
);
1068 if (!NILP (file_error
))
1069 Fprinc (Fcar (tail
), stream
);
1071 Fprin1 (Fcar (tail
), stream
);
1076 #ifdef LISP_FLOAT_TYPE
1079 * The buffer should be at least as large as the max string size of the
1080 * largest float, printed in the biggest notation. This is undoubtedly
1081 * 20d float_output_format, with the negative of the C-constant "HUGE"
1084 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1086 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1087 * case of -1e307 in 20d float_output_format. What is one to do (short of
1088 * re-writing _doprnt to be more sane)?
1093 float_to_string (buf
, data
)
1100 /* Check for plus infinity in a way that won't lose
1101 if there is no plus infinity. */
1102 if (data
== data
/ 2 && data
> 1.0)
1104 strcpy (buf
, "1.0e+INF");
1107 /* Likewise for minus infinity. */
1108 if (data
== data
/ 2 && data
< -1.0)
1110 strcpy (buf
, "-1.0e+INF");
1113 /* Check for NaN in a way that won't fail if there are no NaNs. */
1114 if (! (data
* 0.0 >= 0.0))
1116 strcpy (buf
, "0.0e+NaN");
1120 if (NILP (Vfloat_output_format
)
1121 || !STRINGP (Vfloat_output_format
))
1124 /* Generate the fewest number of digits that represent the
1125 floating point value without losing information.
1126 The following method is simple but a bit slow.
1127 For ideas about speeding things up, please see:
1129 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1130 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1132 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1133 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1135 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1137 sprintf (buf
, "%.*g", width
, data
);
1138 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1140 else /* oink oink */
1142 /* Check that the spec we have is fully valid.
1143 This means not only valid for printf,
1144 but meant for floats, and reasonable. */
1145 cp
= XSTRING (Vfloat_output_format
)->data
;
1154 /* Check the width specification. */
1156 if ('0' <= *cp
&& *cp
<= '9')
1160 width
= (width
* 10) + (*cp
++ - '0');
1161 while (*cp
>= '0' && *cp
<= '9');
1163 /* A precision of zero is valid only for %f. */
1165 || (width
== 0 && *cp
!= 'f'))
1169 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1175 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
1178 /* Make sure there is a decimal point with digit after, or an
1179 exponent, so that the value is readable as a float. But don't do
1180 this with "%.0f"; it's valid for that not to produce a decimal
1181 point. Note that width can be 0 only for %.0f. */
1184 for (cp
= buf
; *cp
; cp
++)
1185 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1188 if (*cp
== '.' && cp
[1] == 0)
1202 #endif /* LISP_FLOAT_TYPE */
1205 print (obj
, printcharfun
, escapeflag
)
1207 register Lisp_Object printcharfun
;
1214 #if 1 /* I'm not sure this is really worth doing. */
1215 /* Detect circularities and truncate them.
1216 No need to offer any alternative--this is better than an error. */
1217 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
1220 for (i
= 0; i
< print_depth
; i
++)
1221 if (EQ (obj
, being_printed
[i
]))
1223 sprintf (buf
, "#%d", i
);
1224 strout (buf
, -1, -1, printcharfun
, 0);
1230 being_printed
[print_depth
] = obj
;
1233 if (print_depth
> PRINT_CIRCLE
)
1234 error ("Apparently circular structure being printed");
1235 #ifdef MAX_PRINT_CHARS
1236 if (max_print
&& print_chars
> max_print
)
1241 #endif /* MAX_PRINT_CHARS */
1243 switch (XGCTYPE (obj
))
1246 if (sizeof (int) == sizeof (EMACS_INT
))
1247 sprintf (buf
, "%d", XINT (obj
));
1248 else if (sizeof (long) == sizeof (EMACS_INT
))
1249 sprintf (buf
, "%ld", XINT (obj
));
1252 strout (buf
, -1, -1, printcharfun
, 0);
1255 #ifdef LISP_FLOAT_TYPE
1258 char pigbuf
[350]; /* see comments in float_to_string */
1260 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
1261 strout (pigbuf
, -1, -1, printcharfun
, 0);
1268 print_string (obj
, printcharfun
);
1271 register int i
, i_byte
;
1272 register unsigned char c
;
1273 struct gcpro gcpro1
;
1276 /* 1 means we must ensure that the next character we output
1277 cannot be taken as part of a hex character escape. */
1278 int need_nonhex
= 0;
1282 #ifdef USE_TEXT_PROPERTIES
1283 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1291 str
= XSTRING (obj
)->data
;
1292 size_byte
= STRING_BYTES (XSTRING (obj
));
1294 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1296 /* Here, we must convert each multi-byte form to the
1297 corresponding character code before handing it to PRINTCHAR. */
1301 if (STRING_MULTIBYTE (obj
))
1303 c
= STRING_CHAR_AND_CHAR_LENGTH (str
+ i_byte
,
1304 size_byte
- i_byte
, len
);
1305 if (CHAR_VALID_P (c
, 0))
1315 if (c
== '\n' && print_escape_newlines
)
1320 else if (c
== '\f' && print_escape_newlines
)
1325 else if (! SINGLE_BYTE_CHAR_P (c
) && print_escape_multibyte
)
1327 /* When multibyte is disabled,
1328 print multibyte string chars using hex escapes. */
1329 unsigned char outbuf
[50];
1330 sprintf (outbuf
, "\\x%x", c
);
1331 strout (outbuf
, -1, -1, printcharfun
, 0);
1334 else if (SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1335 && print_escape_nonascii
)
1337 /* When printing in a multibyte buffer
1338 or when explicitly requested,
1339 print single-byte non-ASCII string chars
1340 using octal escapes. */
1341 unsigned char outbuf
[5];
1342 sprintf (outbuf
, "\\%03o", c
);
1343 strout (outbuf
, -1, -1, printcharfun
, 0);
1347 /* If we just had a hex escape, and this character
1348 could be taken as part of it,
1349 output `\ ' to prevent that. */
1353 if ((c
>= 'a' && c
<= 'f')
1354 || (c
>= 'A' && c
<= 'F')
1355 || (c
>= '0' && c
<= '9'))
1356 strout ("\\ ", -1, -1, printcharfun
, 0);
1359 if (c
== '\"' || c
== '\\')
1366 #ifdef USE_TEXT_PROPERTIES
1367 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1369 traverse_intervals (XSTRING (obj
)->intervals
,
1370 0, 0, print_interval
, printcharfun
);
1381 register int confusing
;
1382 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
1383 register unsigned char *end
= p
+ STRING_BYTES (XSYMBOL (obj
)->name
);
1385 int i
, i_byte
, size_byte
;
1388 XSETSTRING (name
, XSYMBOL (obj
)->name
);
1390 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1393 /* If symbol name begins with a digit, and ends with a digit,
1394 and contains nothing but digits and `e', it could be treated
1395 as a number. So set CONFUSING.
1397 Symbols that contain periods could also be taken as numbers,
1398 but periods are always escaped, so we don't have to worry
1400 else if (*p
>= '0' && *p
<= '9'
1401 && end
[-1] >= '0' && end
[-1] <= '9')
1403 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1404 /* Needed for \2e10. */
1407 confusing
= (end
== p
);
1412 /* If we print an uninterned symbol as part of a complex object and
1413 the flag print-gensym is non-nil, prefix it with #n= to read the
1414 object back with the #n# reader syntax later if needed. */
1415 if (! NILP (Vprint_gensym
) && NILP (XSYMBOL (obj
)->obarray
))
1417 if (print_depth
> 1)
1420 tem
= Fassq (obj
, Vprint_gensym_alist
);
1424 print (XCDR (tem
), printcharfun
, escapeflag
);
1430 if (CONSP (Vprint_gensym_alist
))
1431 XSETFASTINT (tem
, XFASTINT (XCDR (XCAR (Vprint_gensym_alist
))) + 1);
1433 XSETFASTINT (tem
, 1);
1434 Vprint_gensym_alist
= Fcons (Fcons (obj
, tem
), Vprint_gensym_alist
);
1437 print (tem
, printcharfun
, escapeflag
);
1445 size_byte
= STRING_BYTES (XSTRING (name
));
1447 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1449 /* Here, we must convert each multi-byte form to the
1450 corresponding character code before handing it to PRINTCHAR. */
1452 if (STRING_MULTIBYTE (name
))
1453 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1455 c
= XSTRING (name
)->data
[i_byte
++];
1461 if (c
== '\"' || c
== '\\' || c
== '\''
1462 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1463 || c
== ',' || c
=='.' || c
== '`'
1464 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1466 PRINTCHAR ('\\'), confusing
= 0;
1474 /* If deeper than spec'd depth, print placeholder. */
1475 if (INTEGERP (Vprint_level
)
1476 && print_depth
> XINT (Vprint_level
))
1477 strout ("...", -1, -1, printcharfun
, 0);
1478 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1479 && (EQ (XCAR (obj
), Qquote
)))
1482 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1484 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1485 && (EQ (XCAR (obj
), Qfunction
)))
1489 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1491 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1492 && ((EQ (XCAR (obj
), Qbackquote
)
1493 || EQ (XCAR (obj
), Qcomma
)
1494 || EQ (XCAR (obj
), Qcomma_at
)
1495 || EQ (XCAR (obj
), Qcomma_dot
))))
1497 print (XCAR (obj
), printcharfun
, 0);
1498 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1505 register int print_length
= 0;
1506 Lisp_Object halftail
= obj
;
1508 if (INTEGERP (Vprint_length
))
1509 print_length
= XINT (Vprint_length
);
1512 /* Detect circular list. */
1513 if (i
!= 0 && EQ (obj
, halftail
))
1515 sprintf (buf
, " . #%d", i
/ 2);
1516 strout (buf
, -1, -1, printcharfun
, 0);
1522 if (print_length
&& i
> print_length
)
1524 strout ("...", 3, 3, printcharfun
, 0);
1527 print (XCAR (obj
), printcharfun
, escapeflag
);
1530 halftail
= XCDR (halftail
);
1535 strout (" . ", 3, 3, printcharfun
, 0);
1536 print (obj
, printcharfun
, escapeflag
);
1542 case Lisp_Vectorlike
:
1547 strout ("#<process ", -1, -1, printcharfun
, 0);
1548 print_string (XPROCESS (obj
)->name
, printcharfun
);
1552 print_string (XPROCESS (obj
)->name
, printcharfun
);
1554 else if (BOOL_VECTOR_P (obj
))
1557 register unsigned char c
;
1558 struct gcpro gcpro1
;
1560 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1566 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1567 strout (buf
, -1, -1, printcharfun
, 0);
1570 /* Don't print more characters than the specified maximum. */
1571 if (INTEGERP (Vprint_length
)
1572 && XINT (Vprint_length
) < size_in_chars
)
1573 size_in_chars
= XINT (Vprint_length
);
1575 for (i
= 0; i
< size_in_chars
; i
++)
1578 c
= XBOOL_VECTOR (obj
)->data
[i
];
1579 if (c
== '\n' && print_escape_newlines
)
1584 else if (c
== '\f' && print_escape_newlines
)
1591 if (c
== '\"' || c
== '\\')
1600 else if (SUBRP (obj
))
1602 strout ("#<subr ", -1, -1, printcharfun
, 0);
1603 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1607 else if (WINDOWP (obj
))
1609 strout ("#<window ", -1, -1, printcharfun
, 0);
1610 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1611 strout (buf
, -1, -1, printcharfun
, 0);
1612 if (!NILP (XWINDOW (obj
)->buffer
))
1614 strout (" on ", -1, -1, printcharfun
, 0);
1615 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1619 else if (BUFFERP (obj
))
1621 if (NILP (XBUFFER (obj
)->name
))
1622 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1623 else if (escapeflag
)
1625 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1626 print_string (XBUFFER (obj
)->name
, printcharfun
);
1630 print_string (XBUFFER (obj
)->name
, printcharfun
);
1632 else if (WINDOW_CONFIGURATIONP (obj
))
1634 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1636 else if (FRAMEP (obj
))
1638 strout ((FRAME_LIVE_P (XFRAME (obj
))
1639 ? "#<frame " : "#<dead frame "),
1640 -1, -1, printcharfun
, 0);
1641 print_string (XFRAME (obj
)->name
, printcharfun
);
1642 sprintf (buf
, " 0x%lx\\ ", (unsigned long) (XFRAME (obj
)));
1643 strout (buf
, -1, -1, printcharfun
, 0);
1646 #endif /* not standalone */
1649 int size
= XVECTOR (obj
)->size
;
1650 if (COMPILEDP (obj
))
1653 size
&= PSEUDOVECTOR_SIZE_MASK
;
1655 if (CHAR_TABLE_P (obj
))
1657 /* We print a char-table as if it were a vector,
1658 lumping the parent and default slots in with the
1659 character slots. But we add #^ as a prefix. */
1662 if (SUB_CHAR_TABLE_P (obj
))
1664 size
&= PSEUDOVECTOR_SIZE_MASK
;
1666 if (size
& PSEUDOVECTOR_FLAG
)
1672 register Lisp_Object tem
;
1674 /* Don't print more elements than the specified maximum. */
1675 if (INTEGERP (Vprint_length
)
1676 && XINT (Vprint_length
) < size
)
1677 size
= XINT (Vprint_length
);
1679 for (i
= 0; i
< size
; i
++)
1681 if (i
) PRINTCHAR (' ');
1682 tem
= XVECTOR (obj
)->contents
[i
];
1683 print (tem
, printcharfun
, escapeflag
);
1692 switch (XMISCTYPE (obj
))
1694 case Lisp_Misc_Marker
:
1695 strout ("#<marker ", -1, -1, printcharfun
, 0);
1696 /* Do you think this is necessary? */
1697 if (XMARKER (obj
)->insertion_type
!= 0)
1698 strout ("(before-insertion) ", -1, -1, printcharfun
, 0);
1699 if (!(XMARKER (obj
)->buffer
))
1700 strout ("in no buffer", -1, -1, printcharfun
, 0);
1703 sprintf (buf
, "at %d", marker_position (obj
));
1704 strout (buf
, -1, -1, printcharfun
, 0);
1705 strout (" in ", -1, -1, printcharfun
, 0);
1706 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1711 case Lisp_Misc_Overlay
:
1712 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1713 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1714 strout ("in no buffer", -1, -1, printcharfun
, 0);
1717 sprintf (buf
, "from %d to %d in ",
1718 marker_position (OVERLAY_START (obj
)),
1719 marker_position (OVERLAY_END (obj
)));
1720 strout (buf
, -1, -1, printcharfun
, 0);
1721 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1727 /* Remaining cases shouldn't happen in normal usage, but let's print
1728 them anyway for the benefit of the debugger. */
1729 case Lisp_Misc_Free
:
1730 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1733 case Lisp_Misc_Intfwd
:
1734 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1735 strout (buf
, -1, -1, printcharfun
, 0);
1738 case Lisp_Misc_Boolfwd
:
1739 sprintf (buf
, "#<boolfwd to %s>",
1740 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1741 strout (buf
, -1, -1, printcharfun
, 0);
1744 case Lisp_Misc_Objfwd
:
1745 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
1746 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1750 case Lisp_Misc_Buffer_Objfwd
:
1751 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
1752 print (*(Lisp_Object
*)((char *)current_buffer
1753 + XBUFFER_OBJFWD (obj
)->offset
),
1754 printcharfun
, escapeflag
);
1758 case Lisp_Misc_Kboard_Objfwd
:
1759 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
1760 print (*(Lisp_Object
*)((char *) current_kboard
1761 + XKBOARD_OBJFWD (obj
)->offset
),
1762 printcharfun
, escapeflag
);
1766 case Lisp_Misc_Buffer_Local_Value
:
1767 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
1768 goto do_buffer_local
;
1769 case Lisp_Misc_Some_Buffer_Local_Value
:
1770 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
1772 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
1773 print (XBUFFER_LOCAL_VALUE (obj
)->realvalue
, printcharfun
, escapeflag
);
1774 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
1775 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
1777 strout ("[buffer] ", -1, -1, printcharfun
, 0);
1778 print (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
1779 printcharfun
, escapeflag
);
1780 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
1782 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
1783 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
1785 strout ("[frame] ", -1, -1, printcharfun
, 0);
1786 print (XBUFFER_LOCAL_VALUE (obj
)->frame
,
1787 printcharfun
, escapeflag
);
1789 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
1790 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1791 printcharfun
, escapeflag
);
1792 strout ("[default-value] ", -1, -1, printcharfun
, 0);
1793 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
,
1794 printcharfun
, escapeflag
);
1802 #endif /* standalone */
1807 /* We're in trouble if this happens!
1808 Probably should just abort () */
1809 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
1811 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1812 else if (VECTORLIKEP (obj
))
1813 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1815 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1816 strout (buf
, -1, -1, printcharfun
, 0);
1817 strout (" Save your buffers immediately and please report this bug>",
1818 -1, -1, printcharfun
, 0);
1825 #ifdef USE_TEXT_PROPERTIES
1827 /* Print a description of INTERVAL using PRINTCHARFUN.
1828 This is part of printing a string that has text properties. */
1831 print_interval (interval
, printcharfun
)
1833 Lisp_Object printcharfun
;
1836 print (make_number (interval
->position
), printcharfun
, 1);
1838 print (make_number (interval
->position
+ LENGTH (interval
)),
1841 print (interval
->plist
, printcharfun
, 1);
1844 #endif /* USE_TEXT_PROPERTIES */
1849 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
1850 staticpro (&Qtemp_buffer_setup_hook
);
1852 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1853 "Output stream `print' uses by default for outputting a character.\n\
1854 This may be any function of one argument.\n\
1855 It may also be a buffer (output is inserted before point)\n\
1856 or a marker (output is inserted and the marker is advanced)\n\
1857 or the symbol t (output appears in the echo area).");
1858 Vstandard_output
= Qt
;
1859 Qstandard_output
= intern ("standard-output");
1860 staticpro (&Qstandard_output
);
1862 #ifdef LISP_FLOAT_TYPE
1863 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1864 "The format descriptor string used to print floats.\n\
1865 This is a %-spec like those accepted by `printf' in C,\n\
1866 but with some restrictions. It must start with the two characters `%.'.\n\
1867 After that comes an integer precision specification,\n\
1868 and then a letter which controls the format.\n\
1869 The letters allowed are `e', `f' and `g'.\n\
1870 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1871 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1872 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1873 The precision in any of these cases is the number of digits following\n\
1874 the decimal point. With `f', a precision of 0 means to omit the\n\
1875 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1876 A value of nil means to use the shortest notation\n\
1877 that represents the number without losing information.");
1878 Vfloat_output_format
= Qnil
;
1879 Qfloat_output_format
= intern ("float-output-format");
1880 staticpro (&Qfloat_output_format
);
1881 #endif /* LISP_FLOAT_TYPE */
1883 DEFVAR_LISP ("print-length", &Vprint_length
,
1884 "Maximum length of list to print before abbreviating.\n\
1885 A value of nil means no limit.");
1886 Vprint_length
= Qnil
;
1888 DEFVAR_LISP ("print-level", &Vprint_level
,
1889 "Maximum depth of list nesting to print before abbreviating.\n\
1890 A value of nil means no limit.");
1891 Vprint_level
= Qnil
;
1893 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1894 "Non-nil means print newlines in strings as backslash-n.\n\
1895 Also print formfeeds as backslash-f.");
1896 print_escape_newlines
= 0;
1898 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
1899 "Non-nil means print unibyte non-ASCII chars in strings as \\OOO.\n\
1900 \(OOO is the octal representation of the character code.)\n\
1901 Only single-byte characters are affected, and only in `prin1'.");
1902 print_escape_nonascii
= 0;
1904 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
1905 "Non-nil means print multibyte characters in strings as \\xXXXX.\n\
1906 \(XXX is the hex representation of the character code.)\n\
1907 This affects only `prin1'.");
1908 print_escape_multibyte
= 0;
1910 DEFVAR_BOOL ("print-quoted", &print_quoted
,
1911 "Non-nil means print quoted forms with reader syntax.\n\
1912 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\
1913 forms print in the new syntax.");
1916 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
1917 "Non-nil means print uninterned symbols so they will read as uninterned.\n\
1918 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\
1919 When the uninterned symbol appears within a larger data structure,\n\
1920 in addition use the #...# and #...= constructs as needed,\n\
1921 so that multiple references to the same symbol are shared once again\n\
1922 when the text is read back.\n\
1924 If the value of `print-gensym' is a cons cell, then in addition refrain from\n\
1925 clearing `print-gensym-alist' on entry to and exit from printing functions,\n\
1926 so that the use of #...# and #...= can carry over for several separately\n\
1928 Vprint_gensym
= Qnil
;
1930 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist
,
1931 "Association list of elements (GENSYM . N) to guide use of #N# and #N=.\n\
1932 In each element, GENSYM is an uninterned symbol that has been associated\n\
1933 with #N= for the specified value of N.");
1934 Vprint_gensym_alist
= Qnil
;
1936 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1937 staticpro (&Vprin1_to_string_buffer
);
1940 defsubr (&Sprin1_to_string
);
1941 defsubr (&Serror_message_string
);
1945 defsubr (&Swrite_char
);
1946 defsubr (&Sexternal_debugging_output
);
1948 Qexternal_debugging_output
= intern ("external-debugging-output");
1949 staticpro (&Qexternal_debugging_output
);
1951 Qprint_escape_newlines
= intern ("print-escape-newlines");
1952 staticpro (&Qprint_escape_newlines
);
1954 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
1955 staticpro (&Qprint_escape_multibyte
);
1957 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
1958 staticpro (&Qprint_escape_nonascii
);
1961 defsubr (&Swith_output_to_temp_buffer
);
1962 #endif /* not standalone */