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
);
402 echo_area_message
= Qnil
;
404 echo_area_glyphs_length
= 0;
405 message_buf_print
= 1;
407 if (minibuffer_auto_raise
)
409 Lisp_Object mini_window
;
411 /* Get the frame containing the minibuffer
412 that the selected frame is using. */
413 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
415 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
420 && ! NILP (current_buffer
->enable_multibyte_characters
)
421 && ! CHAR_HEAD_P (*str
))
423 /* Convert the unibyte character to multibyte. */
424 unsigned char c
= *str
;
426 len
= count_size_as_multibyte (&c
, 1);
427 copy_text (&c
, work
, 1, 0, 1);
431 message_dolog (str
, len
, 0, len
> 1);
433 if (! NILP (current_buffer
->enable_multibyte_characters
)
434 && ! message_enable_multibyte
)
436 /* Record that the message buffer is multibyte. */
437 message_enable_multibyte
= 1;
439 /* If we have already had some message text in the messsage
440 buffer, we convert it to multibyte. */
444 = count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame
),
446 unsigned char *tembuf
= (unsigned char *) alloca (size
+ 1);
447 copy_text (FRAME_MESSAGE_BUF (mini_frame
), tembuf
, printbufidx
,
450 if (printbufidx
> FRAME_MESSAGE_BUF_SIZE (mini_frame
))
452 printbufidx
= FRAME_MESSAGE_BUF_SIZE (mini_frame
);
453 /* Rewind incomplete multi-byte form. */
454 while (printbufidx
> 0 && tembuf
[printbufidx
] >= 0xA0)
457 bcopy (tembuf
, FRAME_MESSAGE_BUF (mini_frame
), printbufidx
);
461 if (printbufidx
< FRAME_MESSAGE_BUF_SIZE (mini_frame
) - len
)
463 bcopy (str
, &FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
], len
);
466 FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
] = 0;
467 echo_area_glyphs_length
= printbufidx
;
471 #endif /* not standalone */
473 XSETFASTINT (ch1
, ch
);
478 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
481 Lisp_Object printcharfun
;
487 size_byte
= size
= strlen (ptr
);
489 if (EQ (printcharfun
, Qnil
))
491 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
493 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
494 print_buffer
= (char *) xrealloc (print_buffer
,
497 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
498 print_buffer_pos
+= size
;
499 print_buffer_pos_byte
+= size_byte
;
501 #ifdef MAX_PRINT_CHARS
504 #endif /* MAX_PRINT_CHARS */
507 if (EQ (printcharfun
, Qt
))
510 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
514 #ifdef MAX_PRINT_CHARS
517 #endif /* MAX_PRINT_CHARS */
521 fwrite (ptr
, 1, size_byte
, stdout
);
522 noninteractive_need_newline
= 1;
526 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
527 || !message_buf_print
)
529 message_log_maybe_newline ();
530 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
531 echo_area_message
= Qnil
;
533 echo_area_glyphs_length
= 0;
534 message_buf_print
= 1;
536 if (minibuffer_auto_raise
)
538 Lisp_Object mini_window
;
540 /* Get the frame containing the minibuffer
541 that the selected frame is using. */
542 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
544 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
548 message_dolog (ptr
, size_byte
, 0, multibyte
);
550 /* Convert message to multibyte if we are now adding multibyte text. */
552 && ! message_enable_multibyte
555 int size
= count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame
),
557 unsigned char *tembuf
= (unsigned char *) alloca (size
+ 1);
558 copy_text (FRAME_MESSAGE_BUF (mini_frame
), tembuf
, printbufidx
,
561 if (printbufidx
> FRAME_MESSAGE_BUF_SIZE (mini_frame
))
563 printbufidx
= FRAME_MESSAGE_BUF_SIZE (mini_frame
);
564 /* Rewind incomplete multi-byte form. */
565 while (printbufidx
> 0 && tembuf
[printbufidx
] >= 0xA0)
569 bcopy (tembuf
, FRAME_MESSAGE_BUF (mini_frame
), printbufidx
);
573 message_enable_multibyte
= 1;
575 /* Compute how much of the new text will fit there. */
576 if (size_byte
> FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1)
578 size_byte
= FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1;
579 /* Rewind incomplete multi-byte form. */
580 while (size_byte
&& (unsigned char) ptr
[size_byte
] >= 0xA0)
584 /* Put that part of the new text in. */
585 bcopy (ptr
, &FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
], size_byte
);
586 printbufidx
+= size_byte
;
587 FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
] = 0;
588 echo_area_glyphs_length
= printbufidx
;
594 if (size
== size_byte
)
595 while (i
< size_byte
)
602 while (i
< size_byte
)
604 /* Here, we must convert each multi-byte form to the
605 corresponding character code before handing it to PRINTCHAR. */
607 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
614 /* Print the contents of a string STRING using PRINTCHARFUN.
615 It isn't safe to use strout in many cases,
616 because printing one char can relocate. */
619 print_string (string
, printcharfun
)
621 Lisp_Object printcharfun
;
623 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
627 if (STRING_MULTIBYTE (string
))
628 chars
= XSTRING (string
)->size
;
629 else if (EQ (printcharfun
, Qt
)
630 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
631 : ! NILP (current_buffer
->enable_multibyte_characters
))
632 chars
= multibyte_chars_in_text (XSTRING (string
)->data
,
633 STRING_BYTES (XSTRING (string
)));
635 chars
= STRING_BYTES (XSTRING (string
));
637 /* strout is safe for output to a frame (echo area) or to print_buffer. */
638 strout (XSTRING (string
)->data
,
639 chars
, STRING_BYTES (XSTRING (string
)),
640 printcharfun
, STRING_MULTIBYTE (string
));
644 /* Otherwise, string may be relocated by printing one char.
645 So re-fetch the string address for each character. */
647 int size
= XSTRING (string
)->size
;
648 int size_byte
= STRING_BYTES (XSTRING (string
));
651 if (size
== size_byte
)
652 for (i
= 0; i
< size
; i
++)
653 PRINTCHAR (XSTRING (string
)->data
[i
]);
655 for (i
= 0; i
< size_byte
; i
++)
657 /* Here, we must convert each multi-byte form to the
658 corresponding character code before handing it to PRINTCHAR. */
660 int ch
= STRING_CHAR_AND_CHAR_LENGTH (XSTRING (string
)->data
+ i
,
662 if (!CHAR_VALID_P (ch
, 0))
664 ch
= XSTRING (string
)->data
[i
];
674 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
675 "Output character CHARACTER to stream PRINTCHARFUN.\n\
676 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
677 (character
, printcharfun
)
678 Lisp_Object character
, printcharfun
;
682 if (NILP (printcharfun
))
683 printcharfun
= Vstandard_output
;
684 CHECK_NUMBER (character
, 0);
686 PRINTCHAR (XINT (character
));
691 /* Used from outside of print.c to print a block of SIZE
692 single-byte chars at DATA on the default output stream.
693 Do not use this on the contents of a Lisp string. */
696 write_string (data
, size
)
701 Lisp_Object printcharfun
;
703 printcharfun
= Vstandard_output
;
706 strout (data
, size
, size
, printcharfun
, 0);
710 /* Used from outside of print.c to print a block of SIZE
711 single-byte chars at DATA on a specified stream PRINTCHARFUN.
712 Do not use this on the contents of a Lisp string. */
715 write_string_1 (data
, size
, printcharfun
)
718 Lisp_Object printcharfun
;
723 strout (data
, size
, size
, printcharfun
, 0);
731 temp_output_buffer_setup (bufname
)
734 int count
= specpdl_ptr
- specpdl
;
735 register struct buffer
*old
= current_buffer
;
736 register Lisp_Object buf
;
738 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
740 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
742 current_buffer
->directory
= old
->directory
;
743 current_buffer
->read_only
= Qnil
;
744 current_buffer
->filename
= Qnil
;
745 current_buffer
->undo_list
= Qt
;
746 current_buffer
->overlays_before
= Qnil
;
747 current_buffer
->overlays_after
= Qnil
;
748 current_buffer
->enable_multibyte_characters
749 = buffer_defaults
.enable_multibyte_characters
;
751 XSETBUFFER (buf
, current_buffer
);
753 call1 (Vrun_hooks
, Qtemp_buffer_setup_hook
);
755 unbind_to (count
, Qnil
);
757 specbind (Qstandard_output
, buf
);
761 internal_with_output_to_temp_buffer (bufname
, function
, args
)
763 Lisp_Object (*function
) P_ ((Lisp_Object
));
766 int count
= specpdl_ptr
- specpdl
;
767 Lisp_Object buf
, val
;
771 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
772 temp_output_buffer_setup (bufname
);
773 buf
= Vstandard_output
;
776 val
= (*function
) (args
);
779 temp_output_buffer_show (buf
);
782 return unbind_to (count
, val
);
785 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
787 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
788 The buffer is cleared out initially, and marked as unmodified when done.\n\
789 All output done by BODY is inserted in that buffer by default.\n\
790 The buffer is displayed in another window, but not selected.\n\
791 The value of the last form in BODY is returned.\n\
792 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\
794 The hook `temp-buffer-setup-hook' is run before BODY,\n\
795 with the buffer BUFNAME temporarily current.\n\
796 The hook `temp-buffer-show-hook' is run after the buffer is displayed,\n\
797 with the buffer temporarily current, and the window that was used\n\
798 to display it temporarily selected.\n\
800 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
801 to get the buffer displayed instead of just displaying the non-selected\n\
802 buffer and calling the hook. It gets one argument, the buffer to display.")
808 int count
= specpdl_ptr
- specpdl
;
809 Lisp_Object buf
, val
;
812 name
= Feval (Fcar (args
));
815 CHECK_STRING (name
, 0);
816 temp_output_buffer_setup (XSTRING (name
)->data
);
817 buf
= Vstandard_output
;
819 val
= Fprogn (Fcdr (args
));
821 temp_output_buffer_show (buf
);
823 return unbind_to (count
, val
);
825 #endif /* not standalone */
827 static void print ();
829 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
830 "Output a newline to stream PRINTCHARFUN.\n\
831 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
833 Lisp_Object printcharfun
;
837 if (NILP (printcharfun
))
838 printcharfun
= Vstandard_output
;
845 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
846 "Output the printed representation of OBJECT, any Lisp object.\n\
847 Quoting characters are printed when needed to make output that `read'\n\
848 can handle, whenever this is possible.\n\
849 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
850 (object
, printcharfun
)
851 Lisp_Object object
, printcharfun
;
855 #ifdef MAX_PRINT_CHARS
857 #endif /* MAX_PRINT_CHARS */
858 if (NILP (printcharfun
))
859 printcharfun
= Vstandard_output
;
862 print (object
, printcharfun
, 1);
867 /* a buffer which is used to hold output being built by prin1-to-string */
868 Lisp_Object Vprin1_to_string_buffer
;
870 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
871 "Return a string containing the printed representation of OBJECT,\n\
872 any Lisp object. Quoting characters are used when needed to make output\n\
873 that `read' can handle, whenever this is possible, unless the optional\n\
874 second argument NOESCAPE is non-nil.")
876 Lisp_Object object
, noescape
;
879 Lisp_Object printcharfun
;
880 struct gcpro gcpro1
, gcpro2
;
883 /* Save and restore this--we are altering a buffer
884 but we don't want to deactivate the mark just for that.
885 No need for specbind, since errors deactivate the mark. */
886 tem
= Vdeactivate_mark
;
887 GCPRO2 (object
, tem
);
889 printcharfun
= Vprin1_to_string_buffer
;
892 print (object
, printcharfun
, NILP (noescape
));
893 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
895 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
896 object
= Fbuffer_string ();
899 set_buffer_internal (old
);
901 Vdeactivate_mark
= tem
;
907 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
908 "Output the printed representation of OBJECT, any Lisp object.\n\
909 No quoting characters are used; no delimiters are printed around\n\
910 the contents of strings.\n\
911 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
912 (object
, printcharfun
)
913 Lisp_Object object
, printcharfun
;
917 if (NILP (printcharfun
))
918 printcharfun
= Vstandard_output
;
921 print (object
, printcharfun
, 0);
926 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
927 "Output the printed representation of OBJECT, with newlines around it.\n\
928 Quoting characters are printed when needed to make output that `read'\n\
929 can handle, whenever this is possible.\n\
930 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
931 (object
, printcharfun
)
932 Lisp_Object object
, printcharfun
;
937 #ifdef MAX_PRINT_CHARS
939 max_print
= MAX_PRINT_CHARS
;
940 #endif /* MAX_PRINT_CHARS */
941 if (NILP (printcharfun
))
942 printcharfun
= Vstandard_output
;
947 print (object
, printcharfun
, 1);
950 #ifdef MAX_PRINT_CHARS
953 #endif /* MAX_PRINT_CHARS */
958 /* The subroutine object for external-debugging-output is kept here
959 for the convenience of the debugger. */
960 Lisp_Object Qexternal_debugging_output
;
962 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
963 "Write CHARACTER to stderr.\n\
964 You can call print while debugging emacs, and pass it this function\n\
965 to make it write to the debugging output.\n")
967 Lisp_Object character
;
969 CHECK_NUMBER (character
, 0);
970 putc (XINT (character
), stderr
);
973 /* Send the output to a debugger (nothing happens if there isn't one). */
975 char buf
[2] = {(char) XINT (character
), '\0'};
976 OutputDebugString (buf
);
983 /* This is the interface for debugging printing. */
989 Fprin1 (arg
, Qexternal_debugging_output
);
990 fprintf (stderr
, "\r\n");
993 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
995 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
999 struct buffer
*old
= current_buffer
;
1000 Lisp_Object original
, printcharfun
, value
;
1001 struct gcpro gcpro1
;
1003 /* If OBJ is (error STRING), just return STRING.
1004 That is not only faster, it also avoids the need to allocate
1005 space here when the error is due to memory full. */
1006 if (CONSP (obj
) && EQ (XCONS (obj
)->car
, Qerror
)
1007 && CONSP (XCONS (obj
)->cdr
)
1008 && STRINGP (XCONS (XCONS (obj
)->cdr
)->car
)
1009 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
1010 return XCONS (XCONS (obj
)->cdr
)->car
;
1012 print_error_message (obj
, Vprin1_to_string_buffer
);
1014 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
1015 value
= Fbuffer_string ();
1019 set_buffer_internal (old
);
1025 /* Print an error message for the error DATA
1026 onto Lisp output stream STREAM (suitable for the print functions). */
1029 print_error_message (data
, stream
)
1030 Lisp_Object data
, stream
;
1032 Lisp_Object errname
, errmsg
, file_error
, tail
;
1033 struct gcpro gcpro1
;
1036 errname
= Fcar (data
);
1038 if (EQ (errname
, Qerror
))
1041 if (!CONSP (data
)) data
= Qnil
;
1042 errmsg
= Fcar (data
);
1047 errmsg
= Fget (errname
, Qerror_message
);
1048 file_error
= Fmemq (Qfile_error
,
1049 Fget (errname
, Qerror_conditions
));
1052 /* Print an error message including the data items. */
1054 tail
= Fcdr_safe (data
);
1057 /* For file-error, make error message by concatenating
1058 all the data items. They are all strings. */
1059 if (!NILP (file_error
) && CONSP (tail
))
1060 errmsg
= XCONS (tail
)->car
, tail
= XCONS (tail
)->cdr
;
1062 if (STRINGP (errmsg
))
1063 Fprinc (errmsg
, stream
);
1065 write_string_1 ("peculiar error", -1, stream
);
1067 for (i
= 0; CONSP (tail
); tail
= Fcdr (tail
), i
++)
1069 write_string_1 (i
? ", " : ": ", 2, stream
);
1070 if (!NILP (file_error
))
1071 Fprinc (Fcar (tail
), stream
);
1073 Fprin1 (Fcar (tail
), stream
);
1078 #ifdef LISP_FLOAT_TYPE
1081 * The buffer should be at least as large as the max string size of the
1082 * largest float, printed in the biggest notation. This is undoubtedly
1083 * 20d float_output_format, with the negative of the C-constant "HUGE"
1086 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1088 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1089 * case of -1e307 in 20d float_output_format. What is one to do (short of
1090 * re-writing _doprnt to be more sane)?
1095 float_to_string (buf
, data
)
1102 /* Check for plus infinity in a way that won't lose
1103 if there is no plus infinity. */
1104 if (data
== data
/ 2 && data
> 1.0)
1106 strcpy (buf
, "1.0e+INF");
1109 /* Likewise for minus infinity. */
1110 if (data
== data
/ 2 && data
< -1.0)
1112 strcpy (buf
, "-1.0e+INF");
1115 /* Check for NaN in a way that won't fail if there are no NaNs. */
1116 if (! (data
* 0.0 >= 0.0))
1118 strcpy (buf
, "0.0e+NaN");
1122 if (NILP (Vfloat_output_format
)
1123 || !STRINGP (Vfloat_output_format
))
1126 /* Generate the fewest number of digits that represent the
1127 floating point value without losing information.
1128 The following method is simple but a bit slow.
1129 For ideas about speeding things up, please see:
1131 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1132 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1134 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1135 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1137 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1139 sprintf (buf
, "%.*g", width
, data
);
1140 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1142 else /* oink oink */
1144 /* Check that the spec we have is fully valid.
1145 This means not only valid for printf,
1146 but meant for floats, and reasonable. */
1147 cp
= XSTRING (Vfloat_output_format
)->data
;
1156 /* Check the width specification. */
1158 if ('0' <= *cp
&& *cp
<= '9')
1162 width
= (width
* 10) + (*cp
++ - '0');
1163 while (*cp
>= '0' && *cp
<= '9');
1165 /* A precision of zero is valid only for %f. */
1167 || (width
== 0 && *cp
!= 'f'))
1171 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1177 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
1180 /* Make sure there is a decimal point with digit after, or an
1181 exponent, so that the value is readable as a float. But don't do
1182 this with "%.0f"; it's valid for that not to produce a decimal
1183 point. Note that width can be 0 only for %.0f. */
1186 for (cp
= buf
; *cp
; cp
++)
1187 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1190 if (*cp
== '.' && cp
[1] == 0)
1204 #endif /* LISP_FLOAT_TYPE */
1207 print (obj
, printcharfun
, escapeflag
)
1209 register Lisp_Object printcharfun
;
1216 #if 1 /* I'm not sure this is really worth doing. */
1217 /* Detect circularities and truncate them.
1218 No need to offer any alternative--this is better than an error. */
1219 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
1222 for (i
= 0; i
< print_depth
; i
++)
1223 if (EQ (obj
, being_printed
[i
]))
1225 sprintf (buf
, "#%d", i
);
1226 strout (buf
, -1, -1, printcharfun
, 0);
1232 being_printed
[print_depth
] = obj
;
1235 if (print_depth
> PRINT_CIRCLE
)
1236 error ("Apparently circular structure being printed");
1237 #ifdef MAX_PRINT_CHARS
1238 if (max_print
&& print_chars
> max_print
)
1243 #endif /* MAX_PRINT_CHARS */
1245 switch (XGCTYPE (obj
))
1248 if (sizeof (int) == sizeof (EMACS_INT
))
1249 sprintf (buf
, "%d", XINT (obj
));
1250 else if (sizeof (long) == sizeof (EMACS_INT
))
1251 sprintf (buf
, "%ld", XINT (obj
));
1254 strout (buf
, -1, -1, printcharfun
, 0);
1257 #ifdef LISP_FLOAT_TYPE
1260 char pigbuf
[350]; /* see comments in float_to_string */
1262 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
1263 strout (pigbuf
, -1, -1, printcharfun
, 0);
1270 print_string (obj
, printcharfun
);
1273 register int i
, i_byte
;
1274 register unsigned char c
;
1275 struct gcpro gcpro1
;
1278 /* 1 means we must ensure that the next character we output
1279 cannot be taken as part of a hex character escape. */
1280 int need_nonhex
= 0;
1284 #ifdef USE_TEXT_PROPERTIES
1285 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1293 str
= XSTRING (obj
)->data
;
1294 size_byte
= STRING_BYTES (XSTRING (obj
));
1296 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1298 /* Here, we must convert each multi-byte form to the
1299 corresponding character code before handing it to PRINTCHAR. */
1303 if (STRING_MULTIBYTE (obj
))
1305 c
= STRING_CHAR_AND_CHAR_LENGTH (str
+ i_byte
,
1306 size_byte
- i_byte
, len
);
1307 if (CHAR_VALID_P (c
, 0))
1317 if (c
== '\n' && print_escape_newlines
)
1322 else if (c
== '\f' && print_escape_newlines
)
1327 else if (! SINGLE_BYTE_CHAR_P (c
) && print_escape_multibyte
)
1329 /* When multibyte is disabled,
1330 print multibyte string chars using hex escapes. */
1331 unsigned char outbuf
[50];
1332 sprintf (outbuf
, "\\x%x", c
);
1333 strout (outbuf
, -1, -1, printcharfun
, 0);
1336 else if (SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1337 && print_escape_nonascii
)
1339 /* When printing in a multibyte buffer
1340 or when explicitly requested,
1341 print single-byte non-ASCII string chars
1342 using octal escapes. */
1343 unsigned char outbuf
[5];
1344 sprintf (outbuf
, "\\%03o", c
);
1345 strout (outbuf
, -1, -1, printcharfun
, 0);
1349 /* If we just had a hex escape, and this character
1350 could be taken as part of it,
1351 output `\ ' to prevent that. */
1355 if ((c
>= 'a' && c
<= 'f')
1356 || (c
>= 'A' && c
<= 'F')
1357 || (c
>= '0' && c
<= '9'))
1358 strout ("\\ ", -1, -1, printcharfun
, 0);
1361 if (c
== '\"' || c
== '\\')
1368 #ifdef USE_TEXT_PROPERTIES
1369 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1371 traverse_intervals (XSTRING (obj
)->intervals
,
1372 0, 0, print_interval
, printcharfun
);
1383 register int confusing
;
1384 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
1385 register unsigned char *end
= p
+ STRING_BYTES (XSYMBOL (obj
)->name
);
1387 int i
, i_byte
, size_byte
;
1390 XSETSTRING (name
, XSYMBOL (obj
)->name
);
1392 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1395 /* If symbol name begins with a digit, and ends with a digit,
1396 and contains nothing but digits and `e', it could be treated
1397 as a number. So set CONFUSING.
1399 Symbols that contain periods could also be taken as numbers,
1400 but periods are always escaped, so we don't have to worry
1402 else if (*p
>= '0' && *p
<= '9'
1403 && end
[-1] >= '0' && end
[-1] <= '9')
1405 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1406 /* Needed for \2e10. */
1409 confusing
= (end
== p
);
1414 /* If we print an uninterned symbol as part of a complex object and
1415 the flag print-gensym is non-nil, prefix it with #n= to read the
1416 object back with the #n# reader syntax later if needed. */
1417 if (! NILP (Vprint_gensym
) && NILP (XSYMBOL (obj
)->obarray
))
1419 if (print_depth
> 1)
1422 tem
= Fassq (obj
, Vprint_gensym_alist
);
1426 print (XCDR (tem
), printcharfun
, escapeflag
);
1432 if (CONSP (Vprint_gensym_alist
))
1433 XSETFASTINT (tem
, XFASTINT (XCDR (XCAR (Vprint_gensym_alist
))) + 1);
1435 XSETFASTINT (tem
, 1);
1436 Vprint_gensym_alist
= Fcons (Fcons (obj
, tem
), Vprint_gensym_alist
);
1439 print (tem
, printcharfun
, escapeflag
);
1447 size_byte
= STRING_BYTES (XSTRING (name
));
1449 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1451 /* Here, we must convert each multi-byte form to the
1452 corresponding character code before handing it to PRINTCHAR. */
1454 if (STRING_MULTIBYTE (name
))
1455 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1457 c
= XSTRING (name
)->data
[i_byte
++];
1463 if (c
== '\"' || c
== '\\' || c
== '\''
1464 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1465 || c
== ',' || c
=='.' || c
== '`'
1466 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1468 PRINTCHAR ('\\'), confusing
= 0;
1476 /* If deeper than spec'd depth, print placeholder. */
1477 if (INTEGERP (Vprint_level
)
1478 && print_depth
> XINT (Vprint_level
))
1479 strout ("...", -1, -1, printcharfun
, 0);
1480 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1481 && (EQ (XCAR (obj
), Qquote
)))
1484 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1486 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1487 && (EQ (XCAR (obj
), Qfunction
)))
1491 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1493 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1494 && ((EQ (XCAR (obj
), Qbackquote
)
1495 || EQ (XCAR (obj
), Qcomma
)
1496 || EQ (XCAR (obj
), Qcomma_at
)
1497 || EQ (XCAR (obj
), Qcomma_dot
))))
1499 print (XCAR (obj
), printcharfun
, 0);
1500 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1507 register int print_length
= 0;
1508 Lisp_Object halftail
= obj
;
1510 if (INTEGERP (Vprint_length
))
1511 print_length
= XINT (Vprint_length
);
1514 /* Detect circular list. */
1515 if (i
!= 0 && EQ (obj
, halftail
))
1517 sprintf (buf
, " . #%d", i
/ 2);
1518 strout (buf
, -1, -1, printcharfun
, 0);
1524 if (print_length
&& i
> print_length
)
1526 strout ("...", 3, 3, printcharfun
, 0);
1529 print (XCAR (obj
), printcharfun
, escapeflag
);
1532 halftail
= XCDR (halftail
);
1537 strout (" . ", 3, 3, printcharfun
, 0);
1538 print (obj
, printcharfun
, escapeflag
);
1544 case Lisp_Vectorlike
:
1549 strout ("#<process ", -1, -1, printcharfun
, 0);
1550 print_string (XPROCESS (obj
)->name
, printcharfun
);
1554 print_string (XPROCESS (obj
)->name
, printcharfun
);
1556 else if (BOOL_VECTOR_P (obj
))
1559 register unsigned char c
;
1560 struct gcpro gcpro1
;
1562 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1568 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1569 strout (buf
, -1, -1, printcharfun
, 0);
1572 /* Don't print more characters than the specified maximum. */
1573 if (INTEGERP (Vprint_length
)
1574 && XINT (Vprint_length
) < size_in_chars
)
1575 size_in_chars
= XINT (Vprint_length
);
1577 for (i
= 0; i
< size_in_chars
; i
++)
1580 c
= XBOOL_VECTOR (obj
)->data
[i
];
1581 if (c
== '\n' && print_escape_newlines
)
1586 else if (c
== '\f' && print_escape_newlines
)
1593 if (c
== '\"' || c
== '\\')
1602 else if (SUBRP (obj
))
1604 strout ("#<subr ", -1, -1, printcharfun
, 0);
1605 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1609 else if (WINDOWP (obj
))
1611 strout ("#<window ", -1, -1, printcharfun
, 0);
1612 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1613 strout (buf
, -1, -1, printcharfun
, 0);
1614 if (!NILP (XWINDOW (obj
)->buffer
))
1616 strout (" on ", -1, -1, printcharfun
, 0);
1617 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1621 else if (HASH_TABLE_P (obj
))
1623 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1624 strout ("#<hash-table", -1, -1, printcharfun
, 0);
1625 if (SYMBOLP (h
->test
))
1629 strout (XSYMBOL (h
->test
)->name
->data
, -1, -1, printcharfun
, 0);
1631 strout (XSYMBOL (h
->weak
)->name
->data
, -1, -1, printcharfun
, 0);
1633 sprintf (buf
, "%d/%d", XFASTINT (h
->count
),
1634 XVECTOR (h
->next
)->size
);
1635 strout (buf
, -1, -1, printcharfun
, 0);
1637 sprintf (buf
, " 0x%lx", (unsigned long) h
);
1638 strout (buf
, -1, -1, printcharfun
, 0);
1641 else if (BUFFERP (obj
))
1643 if (NILP (XBUFFER (obj
)->name
))
1644 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1645 else if (escapeflag
)
1647 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1648 print_string (XBUFFER (obj
)->name
, printcharfun
);
1652 print_string (XBUFFER (obj
)->name
, printcharfun
);
1654 else if (WINDOW_CONFIGURATIONP (obj
))
1656 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1658 else if (FRAMEP (obj
))
1660 strout ((FRAME_LIVE_P (XFRAME (obj
))
1661 ? "#<frame " : "#<dead frame "),
1662 -1, -1, printcharfun
, 0);
1663 print_string (XFRAME (obj
)->name
, printcharfun
);
1664 sprintf (buf
, " 0x%lx\\ ", (unsigned long) (XFRAME (obj
)));
1665 strout (buf
, -1, -1, printcharfun
, 0);
1668 #endif /* not standalone */
1671 int size
= XVECTOR (obj
)->size
;
1672 if (COMPILEDP (obj
))
1675 size
&= PSEUDOVECTOR_SIZE_MASK
;
1677 if (CHAR_TABLE_P (obj
))
1679 /* We print a char-table as if it were a vector,
1680 lumping the parent and default slots in with the
1681 character slots. But we add #^ as a prefix. */
1684 if (SUB_CHAR_TABLE_P (obj
))
1686 size
&= PSEUDOVECTOR_SIZE_MASK
;
1688 if (size
& PSEUDOVECTOR_FLAG
)
1694 register Lisp_Object tem
;
1696 /* Don't print more elements than the specified maximum. */
1697 if (INTEGERP (Vprint_length
)
1698 && XINT (Vprint_length
) < size
)
1699 size
= XINT (Vprint_length
);
1701 for (i
= 0; i
< size
; i
++)
1703 if (i
) PRINTCHAR (' ');
1704 tem
= XVECTOR (obj
)->contents
[i
];
1705 print (tem
, printcharfun
, escapeflag
);
1714 switch (XMISCTYPE (obj
))
1716 case Lisp_Misc_Marker
:
1717 strout ("#<marker ", -1, -1, printcharfun
, 0);
1718 /* Do you think this is necessary? */
1719 if (XMARKER (obj
)->insertion_type
!= 0)
1720 strout ("(before-insertion) ", -1, -1, printcharfun
, 0);
1721 if (!(XMARKER (obj
)->buffer
))
1722 strout ("in no buffer", -1, -1, printcharfun
, 0);
1725 sprintf (buf
, "at %d", marker_position (obj
));
1726 strout (buf
, -1, -1, printcharfun
, 0);
1727 strout (" in ", -1, -1, printcharfun
, 0);
1728 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1733 case Lisp_Misc_Overlay
:
1734 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1735 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1736 strout ("in no buffer", -1, -1, printcharfun
, 0);
1739 sprintf (buf
, "from %d to %d in ",
1740 marker_position (OVERLAY_START (obj
)),
1741 marker_position (OVERLAY_END (obj
)));
1742 strout (buf
, -1, -1, printcharfun
, 0);
1743 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1749 /* Remaining cases shouldn't happen in normal usage, but let's print
1750 them anyway for the benefit of the debugger. */
1751 case Lisp_Misc_Free
:
1752 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1755 case Lisp_Misc_Intfwd
:
1756 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1757 strout (buf
, -1, -1, printcharfun
, 0);
1760 case Lisp_Misc_Boolfwd
:
1761 sprintf (buf
, "#<boolfwd to %s>",
1762 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1763 strout (buf
, -1, -1, printcharfun
, 0);
1766 case Lisp_Misc_Objfwd
:
1767 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
1768 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1772 case Lisp_Misc_Buffer_Objfwd
:
1773 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
1774 print (*(Lisp_Object
*)((char *)current_buffer
1775 + XBUFFER_OBJFWD (obj
)->offset
),
1776 printcharfun
, escapeflag
);
1780 case Lisp_Misc_Kboard_Objfwd
:
1781 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
1782 print (*(Lisp_Object
*)((char *) current_kboard
1783 + XKBOARD_OBJFWD (obj
)->offset
),
1784 printcharfun
, escapeflag
);
1788 case Lisp_Misc_Buffer_Local_Value
:
1789 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
1790 goto do_buffer_local
;
1791 case Lisp_Misc_Some_Buffer_Local_Value
:
1792 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
1794 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
1795 print (XBUFFER_LOCAL_VALUE (obj
)->realvalue
, printcharfun
, escapeflag
);
1796 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
1797 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
1799 strout ("[buffer] ", -1, -1, printcharfun
, 0);
1800 print (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
1801 printcharfun
, escapeflag
);
1802 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
1804 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
1805 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
1807 strout ("[frame] ", -1, -1, printcharfun
, 0);
1808 print (XBUFFER_LOCAL_VALUE (obj
)->frame
,
1809 printcharfun
, escapeflag
);
1811 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
1812 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1813 printcharfun
, escapeflag
);
1814 strout ("[default-value] ", -1, -1, printcharfun
, 0);
1815 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
,
1816 printcharfun
, escapeflag
);
1824 #endif /* standalone */
1829 /* We're in trouble if this happens!
1830 Probably should just abort () */
1831 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
1833 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1834 else if (VECTORLIKEP (obj
))
1835 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1837 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1838 strout (buf
, -1, -1, printcharfun
, 0);
1839 strout (" Save your buffers immediately and please report this bug>",
1840 -1, -1, printcharfun
, 0);
1847 #ifdef USE_TEXT_PROPERTIES
1849 /* Print a description of INTERVAL using PRINTCHARFUN.
1850 This is part of printing a string that has text properties. */
1853 print_interval (interval
, printcharfun
)
1855 Lisp_Object printcharfun
;
1858 print (make_number (interval
->position
), printcharfun
, 1);
1860 print (make_number (interval
->position
+ LENGTH (interval
)),
1863 print (interval
->plist
, printcharfun
, 1);
1866 #endif /* USE_TEXT_PROPERTIES */
1871 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
1872 staticpro (&Qtemp_buffer_setup_hook
);
1874 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1875 "Output stream `print' uses by default for outputting a character.\n\
1876 This may be any function of one argument.\n\
1877 It may also be a buffer (output is inserted before point)\n\
1878 or a marker (output is inserted and the marker is advanced)\n\
1879 or the symbol t (output appears in the echo area).");
1880 Vstandard_output
= Qt
;
1881 Qstandard_output
= intern ("standard-output");
1882 staticpro (&Qstandard_output
);
1884 #ifdef LISP_FLOAT_TYPE
1885 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1886 "The format descriptor string used to print floats.\n\
1887 This is a %-spec like those accepted by `printf' in C,\n\
1888 but with some restrictions. It must start with the two characters `%.'.\n\
1889 After that comes an integer precision specification,\n\
1890 and then a letter which controls the format.\n\
1891 The letters allowed are `e', `f' and `g'.\n\
1892 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1893 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1894 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1895 The precision in any of these cases is the number of digits following\n\
1896 the decimal point. With `f', a precision of 0 means to omit the\n\
1897 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1898 A value of nil means to use the shortest notation\n\
1899 that represents the number without losing information.");
1900 Vfloat_output_format
= Qnil
;
1901 Qfloat_output_format
= intern ("float-output-format");
1902 staticpro (&Qfloat_output_format
);
1903 #endif /* LISP_FLOAT_TYPE */
1905 DEFVAR_LISP ("print-length", &Vprint_length
,
1906 "Maximum length of list to print before abbreviating.\n\
1907 A value of nil means no limit.");
1908 Vprint_length
= Qnil
;
1910 DEFVAR_LISP ("print-level", &Vprint_level
,
1911 "Maximum depth of list nesting to print before abbreviating.\n\
1912 A value of nil means no limit.");
1913 Vprint_level
= Qnil
;
1915 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1916 "Non-nil means print newlines in strings as backslash-n.\n\
1917 Also print formfeeds as backslash-f.");
1918 print_escape_newlines
= 0;
1920 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
1921 "Non-nil means print unibyte non-ASCII chars in strings as \\OOO.\n\
1922 \(OOO is the octal representation of the character code.)\n\
1923 Only single-byte characters are affected, and only in `prin1'.");
1924 print_escape_nonascii
= 0;
1926 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
1927 "Non-nil means print multibyte characters in strings as \\xXXXX.\n\
1928 \(XXX is the hex representation of the character code.)\n\
1929 This affects only `prin1'.");
1930 print_escape_multibyte
= 0;
1932 DEFVAR_BOOL ("print-quoted", &print_quoted
,
1933 "Non-nil means print quoted forms with reader syntax.\n\
1934 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\
1935 forms print in the new syntax.");
1938 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
1939 "Non-nil means print uninterned symbols so they will read as uninterned.\n\
1940 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\
1941 When the uninterned symbol appears within a larger data structure,\n\
1942 in addition use the #...# and #...= constructs as needed,\n\
1943 so that multiple references to the same symbol are shared once again\n\
1944 when the text is read back.\n\
1946 If the value of `print-gensym' is a cons cell, then in addition refrain from\n\
1947 clearing `print-gensym-alist' on entry to and exit from printing functions,\n\
1948 so that the use of #...# and #...= can carry over for several separately\n\
1950 Vprint_gensym
= Qnil
;
1952 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist
,
1953 "Association list of elements (GENSYM . N) to guide use of #N# and #N=.\n\
1954 In each element, GENSYM is an uninterned symbol that has been associated\n\
1955 with #N= for the specified value of N.");
1956 Vprint_gensym_alist
= Qnil
;
1958 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1959 staticpro (&Vprin1_to_string_buffer
);
1962 defsubr (&Sprin1_to_string
);
1963 defsubr (&Serror_message_string
);
1967 defsubr (&Swrite_char
);
1968 defsubr (&Sexternal_debugging_output
);
1970 Qexternal_debugging_output
= intern ("external-debugging-output");
1971 staticpro (&Qexternal_debugging_output
);
1973 Qprint_escape_newlines
= intern ("print-escape-newlines");
1974 staticpro (&Qprint_escape_newlines
);
1976 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
1977 staticpro (&Qprint_escape_multibyte
);
1979 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
1980 staticpro (&Qprint_escape_nonascii
);
1983 defsubr (&Swith_output_to_temp_buffer
);
1984 #endif /* not standalone */