1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 1998
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
33 #include "dispextern.h"
36 #endif /* not standalone */
38 #ifdef USE_TEXT_PROPERTIES
39 #include "intervals.h"
42 Lisp_Object Vstandard_output
, Qstandard_output
;
44 /* These are used to print like we read. */
45 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
47 #ifdef LISP_FLOAT_TYPE
48 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
50 /* Work around a problem that happens because math.h on hpux 7
51 defines two static variables--which, in Emacs, are not really static,
52 because `static' is defined as nothing. The problem is that they are
53 defined both here and in lread.c.
54 These macros prevent the name conflict. */
55 #if defined (HPUX) && !defined (HPUX8)
56 #define _MAXLDBL print_maxldbl
57 #define _NMAXLDBL print_nmaxldbl
67 /* Default to values appropriate for IEEE floating point. */
72 #define DBL_MANT_DIG 53
78 #define DBL_MIN 2.2250738585072014e-308
81 #ifdef DBL_MIN_REPLACEMENT
83 #define DBL_MIN DBL_MIN_REPLACEMENT
86 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
87 needed to express a float without losing information.
88 The general-case formula is valid for the usual case, IEEE floating point,
89 but many compilers can't optimize the formula to an integer constant,
90 so make a special case for it. */
91 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
92 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
94 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
97 #endif /* LISP_FLOAT_TYPE */
99 /* Avoid actual stack overflow in print. */
102 /* Detect most circularities to print finite output. */
103 #define PRINT_CIRCLE 200
104 Lisp_Object being_printed
[PRINT_CIRCLE
];
106 /* When printing into a buffer, first we put the text in this
107 block, then insert it all at once. */
110 /* Size allocated in print_buffer. */
111 int print_buffer_size
;
112 /* Chars stored in print_buffer. */
113 int print_buffer_pos
;
114 /* Bytes stored in print_buffer. */
115 int print_buffer_pos_byte
;
117 /* Maximum length of list to print in full; noninteger means
118 effectively infinity */
120 Lisp_Object Vprint_length
;
122 /* Maximum depth of list to print in full; noninteger means
123 effectively infinity. */
125 Lisp_Object Vprint_level
;
127 /* Nonzero means print newlines in strings as \n. */
129 int print_escape_newlines
;
131 /* Nonzero means to print single-byte non-ascii characters in strings as
134 int print_escape_nonascii
;
136 /* Nonzero means to print multibyte characters in strings as hex escapes. */
138 int print_escape_multibyte
;
140 Lisp_Object Qprint_escape_newlines
;
141 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
143 /* Nonzero means print (quote foo) forms as 'foo, etc. */
147 /* Non-nil means print #: before uninterned symbols.
148 Neither t nor nil means so that and don't clear Vprint_gensym_alist
149 on entry to and exit from print functions. */
151 Lisp_Object Vprint_gensym
;
153 /* Association list of certain objects that are `eq' in the form being
154 printed and which should be `eq' when read back in, using the #n=object
155 and #n# reader forms. Each element has the form (object . n). */
157 Lisp_Object Vprint_gensym_alist
;
159 /* Nonzero means print newline to stdout before next minibuffer message.
160 Defined in xdisp.c */
162 extern int noninteractive_need_newline
;
164 extern int minibuffer_auto_raise
;
166 #ifdef MAX_PRINT_CHARS
167 static int print_chars
;
168 static int max_print
;
169 #endif /* MAX_PRINT_CHARS */
171 void print_interval ();
174 /* Convert between chars and GLYPHs */
178 register GLYPH
*glyphs
;
188 str_to_glyph_cpy (str
, glyphs
)
192 register GLYPH
*gp
= glyphs
;
193 register char *cp
= str
;
200 str_to_glyph_ncpy (str
, glyphs
, n
)
205 register GLYPH
*gp
= glyphs
;
206 register char *cp
= str
;
213 glyph_to_str_cpy (glyphs
, str
)
217 register GLYPH
*gp
= glyphs
;
218 register char *cp
= str
;
221 *str
++ = *gp
++ & 0377;
225 /* Low level output routines for characters and strings */
227 /* Lisp functions to do output using a stream
228 must have the stream in a variable called printcharfun
229 and must start with PRINTPREPARE, end with PRINTFINISH,
230 and use PRINTDECLARE to declare common variables.
231 Use PRINTCHAR to output one character,
232 or call strout to output a block of characters.
235 #define PRINTDECLARE \
236 struct buffer *old = current_buffer; \
237 int old_point = -1, start_point; \
238 int old_point_byte, start_point_byte; \
239 int specpdl_count = specpdl_ptr - specpdl; \
240 int free_print_buffer = 0; \
243 #define PRINTPREPARE \
244 original = printcharfun; \
245 if (NILP (printcharfun)) printcharfun = Qt; \
246 if (BUFFERP (printcharfun)) \
248 if (XBUFFER (printcharfun) != current_buffer) \
249 Fset_buffer (printcharfun); \
250 printcharfun = Qnil; \
252 if (MARKERP (printcharfun)) \
254 if (!(XMARKER (original)->buffer)) \
255 error ("Marker does not point anywhere"); \
256 if (XMARKER (original)->buffer != current_buffer) \
257 set_buffer_internal (XMARKER (original)->buffer); \
259 old_point_byte = PT_BYTE; \
260 SET_PT_BOTH (marker_position (printcharfun), \
261 marker_byte_position (printcharfun)); \
263 start_point_byte = PT_BYTE; \
264 printcharfun = Qnil; \
266 if (NILP (printcharfun)) \
268 Lisp_Object string; \
269 if (NILP (current_buffer->enable_multibyte_characters) \
270 && ! print_escape_multibyte) \
271 specbind (Qprint_escape_multibyte, Qt); \
272 if (! NILP (current_buffer->enable_multibyte_characters) \
273 && ! print_escape_nonascii) \
274 specbind (Qprint_escape_nonascii, Qt); \
275 if (print_buffer != 0) \
277 string = make_string_from_bytes (print_buffer, \
279 print_buffer_pos_byte); \
280 record_unwind_protect (print_unwind, string); \
284 print_buffer_size = 1000; \
285 print_buffer = (char *) xmalloc (print_buffer_size); \
286 free_print_buffer = 1; \
288 print_buffer_pos = 0; \
289 print_buffer_pos_byte = 0; \
291 if (!CONSP (Vprint_gensym)) \
292 Vprint_gensym_alist = Qnil
294 #define PRINTFINISH \
295 if (NILP (printcharfun)) \
297 if (print_buffer_pos != print_buffer_pos_byte \
298 && NILP (current_buffer->enable_multibyte_characters)) \
300 unsigned char *temp \
301 = (unsigned char *) alloca (print_buffer_pos + 1); \
302 copy_text (print_buffer, temp, print_buffer_pos_byte, \
304 insert_1_both (temp, print_buffer_pos, \
305 print_buffer_pos, 0, 1, 0); \
308 insert_1_both (print_buffer, print_buffer_pos, \
309 print_buffer_pos_byte, 0, 1, 0); \
311 if (free_print_buffer) \
313 xfree (print_buffer); \
316 unbind_to (specpdl_count, Qnil); \
317 if (MARKERP (original)) \
318 set_marker_both (original, Qnil, PT, PT_BYTE); \
319 if (old_point >= 0) \
320 SET_PT_BOTH (old_point + (old_point >= start_point \
321 ? PT - start_point : 0), \
322 old_point_byte + (old_point_byte >= start_point_byte \
323 ? PT_BYTE - start_point_byte : 0)); \
324 if (old != current_buffer) \
325 set_buffer_internal (old); \
326 if (!CONSP (Vprint_gensym)) \
327 Vprint_gensym_alist = Qnil
329 #define PRINTCHAR(ch) printchar (ch, printcharfun)
331 /* Nonzero if there is no room to print any more characters
332 so print might as well return right away. */
334 #define PRINTFULLP() \
335 (EQ (printcharfun, Qt) && !noninteractive \
336 && printbufidx >= FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)))))
338 /* This is used to restore the saved contents of print_buffer
339 when there is a recursive call to print. */
341 print_unwind (saved_text
)
342 Lisp_Object saved_text
;
344 bcopy (XSTRING (saved_text
)->data
, print_buffer
, XSTRING (saved_text
)->size
);
347 /* Index of first unused element of FRAME_MESSAGE_BUF (mini_frame). */
348 static int printbufidx
;
357 #ifdef MAX_PRINT_CHARS
360 #endif /* MAX_PRINT_CHARS */
365 unsigned char work
[4], *str
;
368 len
= CHAR_STRING (ch
, work
, str
);
369 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
370 print_buffer
= (char *) xrealloc (print_buffer
,
371 print_buffer_size
*= 2);
372 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
373 print_buffer_pos
+= 1;
374 print_buffer_pos_byte
+= len
;
381 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
382 unsigned char work
[4], *str
;
383 int len
= CHAR_STRING (ch
, work
, str
);
390 putchar (*str
), str
++;
391 noninteractive_need_newline
= 1;
395 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
396 || !message_buf_print
)
398 message_log_maybe_newline ();
399 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
401 echo_area_glyphs_length
= 0;
402 message_buf_print
= 1;
404 if (minibuffer_auto_raise
)
406 Lisp_Object mini_window
;
408 /* Get the frame containing the minibuffer
409 that the selected frame is using. */
410 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
412 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
416 message_dolog (str
, len
, 0, len
> 1);
418 /* Convert message to multibyte if we are now adding multibyte text. */
419 if (! NILP (current_buffer
->enable_multibyte_characters
)
420 && ! message_enable_multibyte
423 int size
= count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame
),
425 unsigned char *tembuf
= (unsigned char *) alloca (size
+ 1);
426 copy_text (FRAME_MESSAGE_BUF (mini_frame
), tembuf
, printbufidx
,
429 if (printbufidx
> FRAME_MESSAGE_BUF_SIZE (mini_frame
))
431 printbufidx
= FRAME_MESSAGE_BUF_SIZE (mini_frame
);
432 /* Rewind incomplete multi-byte form. */
433 while (printbufidx
> 0 && tembuf
[printbufidx
] >= 0xA0)
436 bcopy (tembuf
, FRAME_MESSAGE_BUF (mini_frame
), printbufidx
);
437 message_enable_multibyte
= 1;
440 if (printbufidx
< FRAME_MESSAGE_BUF_SIZE (mini_frame
) - len
)
441 bcopy (str
, &FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
], len
),
443 FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
] = 0;
444 echo_area_glyphs_length
= printbufidx
;
448 #endif /* not standalone */
450 XSETFASTINT (ch1
, ch
);
455 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
458 Lisp_Object printcharfun
;
464 size_byte
= size
= strlen (ptr
);
466 if (EQ (printcharfun
, Qnil
))
468 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
470 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
471 print_buffer
= (char *) xrealloc (print_buffer
,
474 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
475 print_buffer_pos
+= size
;
476 print_buffer_pos_byte
+= size_byte
;
478 #ifdef MAX_PRINT_CHARS
481 #endif /* MAX_PRINT_CHARS */
484 if (EQ (printcharfun
, Qt
))
487 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
491 #ifdef MAX_PRINT_CHARS
494 #endif /* MAX_PRINT_CHARS */
498 fwrite (ptr
, 1, size_byte
, stdout
);
499 noninteractive_need_newline
= 1;
503 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
504 || !message_buf_print
)
506 message_log_maybe_newline ();
507 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
509 echo_area_glyphs_length
= 0;
510 message_buf_print
= 1;
512 if (minibuffer_auto_raise
)
514 Lisp_Object mini_window
;
516 /* Get the frame containing the minibuffer
517 that the selected frame is using. */
518 mini_window
= FRAME_MINIBUF_WINDOW (selected_frame
);
520 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window
)));
524 message_dolog (ptr
, size_byte
, 0, multibyte
);
526 /* Convert message to multibyte if we are now adding multibyte text. */
528 && ! message_enable_multibyte
531 int size
= count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame
),
533 unsigned char *tembuf
= (unsigned char *) alloca (size
+ 1);
534 copy_text (FRAME_MESSAGE_BUF (mini_frame
), tembuf
, printbufidx
,
537 if (printbufidx
> FRAME_MESSAGE_BUF_SIZE (mini_frame
))
539 printbufidx
= FRAME_MESSAGE_BUF_SIZE (mini_frame
);
540 /* Rewind incomplete multi-byte form. */
541 while (printbufidx
> 0 && tembuf
[printbufidx
] >= 0xA0)
545 bcopy (tembuf
, FRAME_MESSAGE_BUF (mini_frame
), printbufidx
);
549 message_enable_multibyte
= 1;
551 /* Compute how much of the new text will fit there. */
552 if (size_byte
> FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1)
554 size_byte
= FRAME_MESSAGE_BUF_SIZE (mini_frame
) - printbufidx
- 1;
555 /* Rewind incomplete multi-byte form. */
556 while (size_byte
&& (unsigned char) ptr
[size_byte
] >= 0xA0)
560 /* Put that part of the new text in. */
561 bcopy (ptr
, &FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
], size_byte
);
562 printbufidx
+= size_byte
;
563 FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
] = 0;
564 echo_area_glyphs_length
= printbufidx
;
570 if (size
== size_byte
)
571 while (i
< size_byte
)
578 while (i
< size_byte
)
580 /* Here, we must convert each multi-byte form to the
581 corresponding character code before handing it to PRINTCHAR. */
583 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
590 /* Print the contents of a string STRING using PRINTCHARFUN.
591 It isn't safe to use strout in many cases,
592 because printing one char can relocate. */
595 print_string (string
, printcharfun
)
597 Lisp_Object printcharfun
;
599 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
603 if (STRING_MULTIBYTE (string
))
604 chars
= XSTRING (string
)->size
;
605 else if (EQ (printcharfun
, Qt
)
606 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
607 : ! NILP (current_buffer
->enable_multibyte_characters
))
608 chars
= multibyte_chars_in_text (XSTRING (string
)->data
,
609 STRING_BYTES (XSTRING (string
)));
611 chars
= STRING_BYTES (XSTRING (string
));
613 /* strout is safe for output to a frame (echo area) or to print_buffer. */
614 strout (XSTRING (string
)->data
,
615 chars
, STRING_BYTES (XSTRING (string
)),
616 printcharfun
, STRING_MULTIBYTE (string
));
620 /* Otherwise, string may be relocated by printing one char.
621 So re-fetch the string address for each character. */
623 int size
= XSTRING (string
)->size
;
624 int size_byte
= STRING_BYTES (XSTRING (string
));
627 if (size
== size_byte
)
628 for (i
= 0; i
< size
; i
++)
629 PRINTCHAR (XSTRING (string
)->data
[i
]);
631 for (i
= 0; i
< size_byte
; i
++)
633 /* Here, we must convert each multi-byte form to the
634 corresponding character code before handing it to PRINTCHAR. */
636 int ch
= STRING_CHAR_AND_CHAR_LENGTH (XSTRING (string
)->data
+ i
,
638 if (!CHAR_VALID_P (ch
, 0))
640 ch
= XSTRING (string
)->data
[i
];
650 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
651 "Output character CHARACTER to stream PRINTCHARFUN.\n\
652 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
653 (character
, printcharfun
)
654 Lisp_Object character
, printcharfun
;
658 if (NILP (printcharfun
))
659 printcharfun
= Vstandard_output
;
660 CHECK_NUMBER (character
, 0);
662 PRINTCHAR (XINT (character
));
667 /* Used from outside of print.c to print a block of SIZE
668 single-byte chars at DATA on the default output stream.
669 Do not use this on the contents of a Lisp string. */
672 write_string (data
, size
)
677 Lisp_Object printcharfun
;
679 printcharfun
= Vstandard_output
;
682 strout (data
, size
, size
, printcharfun
, 0);
686 /* Used from outside of print.c to print a block of SIZE
687 single-byte chars at DATA on a specified stream PRINTCHARFUN.
688 Do not use this on the contents of a Lisp string. */
691 write_string_1 (data
, size
, printcharfun
)
694 Lisp_Object printcharfun
;
699 strout (data
, size
, size
, printcharfun
, 0);
707 temp_output_buffer_setup (bufname
)
710 register struct buffer
*old
= current_buffer
;
711 register Lisp_Object buf
;
713 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
715 current_buffer
->directory
= old
->directory
;
716 current_buffer
->read_only
= Qnil
;
717 current_buffer
->filename
= Qnil
;
718 current_buffer
->undo_list
= Qt
;
719 current_buffer
->overlays_before
= Qnil
;
720 current_buffer
->overlays_after
= Qnil
;
721 current_buffer
->enable_multibyte_characters
722 = buffer_defaults
.enable_multibyte_characters
;
725 XSETBUFFER (buf
, current_buffer
);
726 specbind (Qstandard_output
, buf
);
728 set_buffer_internal (old
);
732 internal_with_output_to_temp_buffer (bufname
, function
, args
)
734 Lisp_Object (*function
) P_ ((Lisp_Object
));
737 int count
= specpdl_ptr
- specpdl
;
738 Lisp_Object buf
, val
;
742 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
743 temp_output_buffer_setup (bufname
);
744 buf
= Vstandard_output
;
747 val
= (*function
) (args
);
750 temp_output_buffer_show (buf
);
753 return unbind_to (count
, val
);
756 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
758 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
759 The buffer is cleared out initially, and marked as unmodified when done.\n\
760 All output done by BODY is inserted in that buffer by default.\n\
761 The buffer is displayed in another window, but not selected.\n\
762 The hook `temp-buffer-show-hook' is run with that window selected\n\
763 temporarily and its buffer current.\n\
764 The value of the last form in BODY is returned.\n\
765 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
766 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
767 to get the buffer displayed instead of just displaying the non-selected\n\
768 buffer and calling the hook. It gets one argument, the buffer to display.")
774 int count
= specpdl_ptr
- specpdl
;
775 Lisp_Object buf
, val
;
778 name
= Feval (Fcar (args
));
781 CHECK_STRING (name
, 0);
782 temp_output_buffer_setup (XSTRING (name
)->data
);
783 buf
= Vstandard_output
;
785 val
= Fprogn (Fcdr (args
));
787 temp_output_buffer_show (buf
);
789 return unbind_to (count
, val
);
791 #endif /* not standalone */
793 static void print ();
795 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
796 "Output a newline to stream PRINTCHARFUN.\n\
797 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
799 Lisp_Object printcharfun
;
803 if (NILP (printcharfun
))
804 printcharfun
= Vstandard_output
;
811 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
812 "Output the printed representation of OBJECT, any Lisp object.\n\
813 Quoting characters are printed when needed to make output that `read'\n\
814 can handle, whenever this is possible.\n\
815 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
816 (object
, printcharfun
)
817 Lisp_Object object
, printcharfun
;
821 #ifdef MAX_PRINT_CHARS
823 #endif /* MAX_PRINT_CHARS */
824 if (NILP (printcharfun
))
825 printcharfun
= Vstandard_output
;
828 print (object
, printcharfun
, 1);
833 /* a buffer which is used to hold output being built by prin1-to-string */
834 Lisp_Object Vprin1_to_string_buffer
;
836 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
837 "Return a string containing the printed representation of OBJECT,\n\
838 any Lisp object. Quoting characters are used when needed to make output\n\
839 that `read' can handle, whenever this is possible, unless the optional\n\
840 second argument NOESCAPE is non-nil.")
842 Lisp_Object object
, noescape
;
845 Lisp_Object printcharfun
;
846 struct gcpro gcpro1
, gcpro2
;
849 /* Save and restore this--we are altering a buffer
850 but we don't want to deactivate the mark just for that.
851 No need for specbind, since errors deactivate the mark. */
852 tem
= Vdeactivate_mark
;
853 GCPRO2 (object
, tem
);
855 printcharfun
= Vprin1_to_string_buffer
;
858 print (object
, printcharfun
, NILP (noescape
));
859 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
861 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
862 object
= Fbuffer_string ();
865 set_buffer_internal (old
);
867 Vdeactivate_mark
= tem
;
873 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
874 "Output the printed representation of OBJECT, any Lisp object.\n\
875 No quoting characters are used; no delimiters are printed around\n\
876 the contents of strings.\n\
877 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
878 (object
, printcharfun
)
879 Lisp_Object object
, printcharfun
;
883 if (NILP (printcharfun
))
884 printcharfun
= Vstandard_output
;
887 print (object
, printcharfun
, 0);
892 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
893 "Output the printed representation of OBJECT, with newlines around it.\n\
894 Quoting characters are printed when needed to make output that `read'\n\
895 can handle, whenever this is possible.\n\
896 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
897 (object
, printcharfun
)
898 Lisp_Object object
, printcharfun
;
903 #ifdef MAX_PRINT_CHARS
905 max_print
= MAX_PRINT_CHARS
;
906 #endif /* MAX_PRINT_CHARS */
907 if (NILP (printcharfun
))
908 printcharfun
= Vstandard_output
;
913 print (object
, printcharfun
, 1);
916 #ifdef MAX_PRINT_CHARS
919 #endif /* MAX_PRINT_CHARS */
924 /* The subroutine object for external-debugging-output is kept here
925 for the convenience of the debugger. */
926 Lisp_Object Qexternal_debugging_output
;
928 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
929 "Write CHARACTER to stderr.\n\
930 You can call print while debugging emacs, and pass it this function\n\
931 to make it write to the debugging output.\n")
933 Lisp_Object character
;
935 CHECK_NUMBER (character
, 0);
936 putc (XINT (character
), stderr
);
939 /* Send the output to a debugger (nothing happens if there isn't one). */
941 char buf
[2] = {(char) XINT (character
), '\0'};
942 OutputDebugString (buf
);
949 /* This is the interface for debugging printing. */
955 Fprin1 (arg
, Qexternal_debugging_output
);
956 fprintf (stderr
, "\r\n");
959 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
961 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
965 struct buffer
*old
= current_buffer
;
966 Lisp_Object original
, printcharfun
, value
;
969 /* If OBJ is (error STRING), just return STRING.
970 That is not only faster, it also avoids the need to allocate
971 space here when the error is due to memory full. */
972 if (CONSP (obj
) && EQ (XCONS (obj
)->car
, Qerror
)
973 && CONSP (XCONS (obj
)->cdr
)
974 && STRINGP (XCONS (XCONS (obj
)->cdr
)->car
)
975 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
976 return XCONS (XCONS (obj
)->cdr
)->car
;
978 print_error_message (obj
, Vprin1_to_string_buffer
);
980 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
981 value
= Fbuffer_string ();
985 set_buffer_internal (old
);
991 /* Print an error message for the error DATA
992 onto Lisp output stream STREAM (suitable for the print functions). */
995 print_error_message (data
, stream
)
996 Lisp_Object data
, stream
;
998 Lisp_Object errname
, errmsg
, file_error
, tail
;
1002 errname
= Fcar (data
);
1004 if (EQ (errname
, Qerror
))
1007 if (!CONSP (data
)) data
= Qnil
;
1008 errmsg
= Fcar (data
);
1013 errmsg
= Fget (errname
, Qerror_message
);
1014 file_error
= Fmemq (Qfile_error
,
1015 Fget (errname
, Qerror_conditions
));
1018 /* Print an error message including the data items. */
1020 tail
= Fcdr_safe (data
);
1023 /* For file-error, make error message by concatenating
1024 all the data items. They are all strings. */
1025 if (!NILP (file_error
) && !NILP (tail
))
1026 errmsg
= XCONS (tail
)->car
, tail
= XCONS (tail
)->cdr
;
1028 if (STRINGP (errmsg
))
1029 Fprinc (errmsg
, stream
);
1031 write_string_1 ("peculiar error", -1, stream
);
1033 for (i
= 0; CONSP (tail
); tail
= Fcdr (tail
), i
++)
1035 write_string_1 (i
? ", " : ": ", 2, stream
);
1036 if (!NILP (file_error
))
1037 Fprinc (Fcar (tail
), stream
);
1039 Fprin1 (Fcar (tail
), stream
);
1044 #ifdef LISP_FLOAT_TYPE
1047 * The buffer should be at least as large as the max string size of the
1048 * largest float, printed in the biggest notation. This is undoubtedly
1049 * 20d float_output_format, with the negative of the C-constant "HUGE"
1052 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1054 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1055 * case of -1e307 in 20d float_output_format. What is one to do (short of
1056 * re-writing _doprnt to be more sane)?
1061 float_to_string (buf
, data
)
1068 /* Check for plus infinity in a way that won't lose
1069 if there is no plus infinity. */
1070 if (data
== data
/ 2 && data
> 1.0)
1072 strcpy (buf
, "1.0e+INF");
1075 /* Likewise for minus infinity. */
1076 if (data
== data
/ 2 && data
< -1.0)
1078 strcpy (buf
, "-1.0e+INF");
1081 /* Check for NaN in a way that won't fail if there are no NaNs. */
1082 if (! (data
* 0.0 >= 0.0))
1084 strcpy (buf
, "0.0e+NaN");
1088 if (NILP (Vfloat_output_format
)
1089 || !STRINGP (Vfloat_output_format
))
1092 /* Generate the fewest number of digits that represent the
1093 floating point value without losing information.
1094 The following method is simple but a bit slow.
1095 For ideas about speeding things up, please see:
1097 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1098 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1100 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1101 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1103 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1105 sprintf (buf
, "%.*g", width
, data
);
1106 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1108 else /* oink oink */
1110 /* Check that the spec we have is fully valid.
1111 This means not only valid for printf,
1112 but meant for floats, and reasonable. */
1113 cp
= XSTRING (Vfloat_output_format
)->data
;
1122 /* Check the width specification. */
1124 if ('0' <= *cp
&& *cp
<= '9')
1128 width
= (width
* 10) + (*cp
++ - '0');
1129 while (*cp
>= '0' && *cp
<= '9');
1131 /* A precision of zero is valid only for %f. */
1133 || (width
== 0 && *cp
!= 'f'))
1137 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1143 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
1146 /* Make sure there is a decimal point with digit after, or an
1147 exponent, so that the value is readable as a float. But don't do
1148 this with "%.0f"; it's valid for that not to produce a decimal
1149 point. Note that width can be 0 only for %.0f. */
1152 for (cp
= buf
; *cp
; cp
++)
1153 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1156 if (*cp
== '.' && cp
[1] == 0)
1170 #endif /* LISP_FLOAT_TYPE */
1173 print (obj
, printcharfun
, escapeflag
)
1175 register Lisp_Object printcharfun
;
1182 #if 1 /* I'm not sure this is really worth doing. */
1183 /* Detect circularities and truncate them.
1184 No need to offer any alternative--this is better than an error. */
1185 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
1188 for (i
= 0; i
< print_depth
; i
++)
1189 if (EQ (obj
, being_printed
[i
]))
1191 sprintf (buf
, "#%d", i
);
1192 strout (buf
, -1, -1, printcharfun
, 0);
1198 being_printed
[print_depth
] = obj
;
1201 if (print_depth
> PRINT_CIRCLE
)
1202 error ("Apparently circular structure being printed");
1203 #ifdef MAX_PRINT_CHARS
1204 if (max_print
&& print_chars
> max_print
)
1209 #endif /* MAX_PRINT_CHARS */
1211 switch (XGCTYPE (obj
))
1214 if (sizeof (int) == sizeof (EMACS_INT
))
1215 sprintf (buf
, "%d", XINT (obj
));
1216 else if (sizeof (long) == sizeof (EMACS_INT
))
1217 sprintf (buf
, "%ld", XINT (obj
));
1220 strout (buf
, -1, -1, printcharfun
, 0);
1223 #ifdef LISP_FLOAT_TYPE
1226 char pigbuf
[350]; /* see comments in float_to_string */
1228 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
1229 strout (pigbuf
, -1, -1, printcharfun
, 0);
1236 print_string (obj
, printcharfun
);
1239 register int i
, i_byte
;
1240 register unsigned char c
;
1241 struct gcpro gcpro1
;
1244 /* 1 means we must ensure that the next character we output
1245 cannot be taken as part of a hex character escape. */
1246 int need_nonhex
= 0;
1250 #ifdef USE_TEXT_PROPERTIES
1251 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1259 str
= XSTRING (obj
)->data
;
1260 size_byte
= STRING_BYTES (XSTRING (obj
));
1262 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1264 /* Here, we must convert each multi-byte form to the
1265 corresponding character code before handing it to PRINTCHAR. */
1269 if (STRING_MULTIBYTE (obj
))
1271 c
= STRING_CHAR_AND_CHAR_LENGTH (str
+ i_byte
,
1272 size_byte
- i_byte
, len
);
1273 if (CHAR_VALID_P (c
, 0))
1283 if (c
== '\n' && print_escape_newlines
)
1288 else if (c
== '\f' && print_escape_newlines
)
1293 else if (! SINGLE_BYTE_CHAR_P (c
) && print_escape_multibyte
)
1295 /* When multibyte is disabled,
1296 print multibyte string chars using hex escapes. */
1297 unsigned char outbuf
[50];
1298 sprintf (outbuf
, "\\x%x", c
);
1299 strout (outbuf
, -1, -1, printcharfun
, 0);
1302 else if (SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1303 && print_escape_nonascii
)
1305 /* When printing in a multibyte buffer
1306 or when explicitly requested,
1307 print single-byte non-ASCII string chars
1308 using octal escapes. */
1309 unsigned char outbuf
[5];
1310 sprintf (outbuf
, "\\%03o", c
);
1311 strout (outbuf
, -1, -1, printcharfun
, 0);
1315 /* If we just had a hex escape, and this character
1316 could be taken as part of it,
1317 output `\ ' to prevent that. */
1321 if ((c
>= 'a' && c
<= 'f')
1322 || (c
>= 'A' && c
<= 'F')
1323 || (c
>= '0' && c
<= '9'))
1324 strout ("\\ ", -1, -1, printcharfun
, 0);
1327 if (c
== '\"' || c
== '\\')
1334 #ifdef USE_TEXT_PROPERTIES
1335 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1337 traverse_intervals (XSTRING (obj
)->intervals
,
1338 0, 0, print_interval
, printcharfun
);
1349 register int confusing
;
1350 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
1351 register unsigned char *end
= p
+ STRING_BYTES (XSYMBOL (obj
)->name
);
1353 int i
, i_byte
, size_byte
;
1356 XSETSTRING (name
, XSYMBOL (obj
)->name
);
1358 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1361 /* If symbol name begins with a digit, and ends with a digit,
1362 and contains nothing but digits and `e', it could be treated
1363 as a number. So set CONFUSING.
1365 Symbols that contain periods could also be taken as numbers,
1366 but periods are always escaped, so we don't have to worry
1368 else if (*p
>= '0' && *p
<= '9'
1369 && end
[-1] >= '0' && end
[-1] <= '9')
1371 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1372 /* Needed for \2e10. */
1375 confusing
= (end
== p
);
1380 /* If we print an uninterned symbol as part of a complex object and
1381 the flag print-gensym is non-nil, prefix it with #n= to read the
1382 object back with the #n# reader syntax later if needed. */
1383 if (! NILP (Vprint_gensym
) && NILP (XSYMBOL (obj
)->obarray
))
1385 if (print_depth
> 1)
1388 tem
= Fassq (obj
, Vprint_gensym_alist
);
1392 print (XCDR (tem
), printcharfun
, escapeflag
);
1398 if (CONSP (Vprint_gensym_alist
))
1399 XSETFASTINT (tem
, XFASTINT (XCDR (XCAR (Vprint_gensym_alist
))) + 1);
1401 XSETFASTINT (tem
, 1);
1402 Vprint_gensym_alist
= Fcons (Fcons (obj
, tem
), Vprint_gensym_alist
);
1405 print (tem
, printcharfun
, escapeflag
);
1413 size_byte
= STRING_BYTES (XSTRING (name
));
1415 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1417 /* Here, we must convert each multi-byte form to the
1418 corresponding character code before handing it to PRINTCHAR. */
1420 if (STRING_MULTIBYTE (name
))
1421 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1423 c
= XSTRING (name
)->data
[i_byte
++];
1429 if (c
== '\"' || c
== '\\' || c
== '\''
1430 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1431 || c
== ',' || c
=='.' || c
== '`'
1432 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1434 PRINTCHAR ('\\'), confusing
= 0;
1442 /* If deeper than spec'd depth, print placeholder. */
1443 if (INTEGERP (Vprint_level
)
1444 && print_depth
> XINT (Vprint_level
))
1445 strout ("...", -1, -1, printcharfun
, 0);
1446 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1447 && (EQ (XCAR (obj
), Qquote
)))
1450 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1452 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1453 && (EQ (XCAR (obj
), Qfunction
)))
1457 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1459 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1460 && ((EQ (XCAR (obj
), Qbackquote
)
1461 || EQ (XCAR (obj
), Qcomma
)
1462 || EQ (XCAR (obj
), Qcomma_at
)
1463 || EQ (XCAR (obj
), Qcomma_dot
))))
1465 print (XCAR (obj
), printcharfun
, 0);
1466 print (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1473 register int print_length
= 0;
1474 Lisp_Object halftail
= obj
;
1476 if (INTEGERP (Vprint_length
))
1477 print_length
= XINT (Vprint_length
);
1480 /* Detect circular list. */
1481 if (i
!= 0 && EQ (obj
, halftail
))
1483 sprintf (buf
, " . #%d", i
/ 2);
1484 strout (buf
, -1, -1, printcharfun
, 0);
1490 if (print_length
&& i
> print_length
)
1492 strout ("...", 3, 3, printcharfun
, 0);
1495 print (XCAR (obj
), printcharfun
, escapeflag
);
1498 halftail
= XCDR (halftail
);
1503 strout (" . ", 3, 3, printcharfun
, 0);
1504 print (obj
, printcharfun
, escapeflag
);
1510 case Lisp_Vectorlike
:
1515 strout ("#<process ", -1, -1, printcharfun
, 0);
1516 print_string (XPROCESS (obj
)->name
, printcharfun
);
1520 print_string (XPROCESS (obj
)->name
, printcharfun
);
1522 else if (BOOL_VECTOR_P (obj
))
1525 register unsigned char c
;
1526 struct gcpro gcpro1
;
1528 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1534 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1535 strout (buf
, -1, -1, printcharfun
, 0);
1538 /* Don't print more characters than the specified maximum. */
1539 if (INTEGERP (Vprint_length
)
1540 && XINT (Vprint_length
) < size_in_chars
)
1541 size_in_chars
= XINT (Vprint_length
);
1543 for (i
= 0; i
< size_in_chars
; i
++)
1546 c
= XBOOL_VECTOR (obj
)->data
[i
];
1547 if (c
== '\n' && print_escape_newlines
)
1552 else if (c
== '\f' && print_escape_newlines
)
1559 if (c
== '\"' || c
== '\\')
1568 else if (SUBRP (obj
))
1570 strout ("#<subr ", -1, -1, printcharfun
, 0);
1571 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1575 else if (WINDOWP (obj
))
1577 strout ("#<window ", -1, -1, printcharfun
, 0);
1578 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1579 strout (buf
, -1, -1, printcharfun
, 0);
1580 if (!NILP (XWINDOW (obj
)->buffer
))
1582 strout (" on ", -1, -1, printcharfun
, 0);
1583 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1587 else if (BUFFERP (obj
))
1589 if (NILP (XBUFFER (obj
)->name
))
1590 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1591 else if (escapeflag
)
1593 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1594 print_string (XBUFFER (obj
)->name
, printcharfun
);
1598 print_string (XBUFFER (obj
)->name
, printcharfun
);
1600 else if (WINDOW_CONFIGURATIONP (obj
))
1602 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1604 else if (FRAMEP (obj
))
1606 strout ((FRAME_LIVE_P (XFRAME (obj
))
1607 ? "#<frame " : "#<dead frame "),
1608 -1, -1, printcharfun
, 0);
1609 print_string (XFRAME (obj
)->name
, printcharfun
);
1610 sprintf (buf
, " 0x%lx\\ ", (unsigned long) (XFRAME (obj
)));
1611 strout (buf
, -1, -1, printcharfun
, 0);
1614 #endif /* not standalone */
1617 int size
= XVECTOR (obj
)->size
;
1618 if (COMPILEDP (obj
))
1621 size
&= PSEUDOVECTOR_SIZE_MASK
;
1623 if (CHAR_TABLE_P (obj
))
1625 /* We print a char-table as if it were a vector,
1626 lumping the parent and default slots in with the
1627 character slots. But we add #^ as a prefix. */
1630 if (SUB_CHAR_TABLE_P (obj
))
1632 size
&= PSEUDOVECTOR_SIZE_MASK
;
1634 if (size
& PSEUDOVECTOR_FLAG
)
1640 register Lisp_Object tem
;
1642 /* Don't print more elements than the specified maximum. */
1643 if (INTEGERP (Vprint_length
)
1644 && XINT (Vprint_length
) < size
)
1645 size
= XINT (Vprint_length
);
1647 for (i
= 0; i
< size
; i
++)
1649 if (i
) PRINTCHAR (' ');
1650 tem
= XVECTOR (obj
)->contents
[i
];
1651 print (tem
, printcharfun
, escapeflag
);
1660 switch (XMISCTYPE (obj
))
1662 case Lisp_Misc_Marker
:
1663 strout ("#<marker ", -1, -1, printcharfun
, 0);
1664 /* Do you think this is necessary? */
1665 if (XMARKER (obj
)->insertion_type
!= 0)
1666 strout ("(before-insertion) ", -1, -1, printcharfun
, 0);
1667 if (!(XMARKER (obj
)->buffer
))
1668 strout ("in no buffer", -1, -1, printcharfun
, 0);
1671 sprintf (buf
, "at %d", marker_position (obj
));
1672 strout (buf
, -1, -1, printcharfun
, 0);
1673 strout (" in ", -1, -1, printcharfun
, 0);
1674 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1679 case Lisp_Misc_Overlay
:
1680 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1681 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1682 strout ("in no buffer", -1, -1, printcharfun
, 0);
1685 sprintf (buf
, "from %d to %d in ",
1686 marker_position (OVERLAY_START (obj
)),
1687 marker_position (OVERLAY_END (obj
)));
1688 strout (buf
, -1, -1, printcharfun
, 0);
1689 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1695 /* Remaining cases shouldn't happen in normal usage, but let's print
1696 them anyway for the benefit of the debugger. */
1697 case Lisp_Misc_Free
:
1698 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1701 case Lisp_Misc_Intfwd
:
1702 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1703 strout (buf
, -1, -1, printcharfun
, 0);
1706 case Lisp_Misc_Boolfwd
:
1707 sprintf (buf
, "#<boolfwd to %s>",
1708 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1709 strout (buf
, -1, -1, printcharfun
, 0);
1712 case Lisp_Misc_Objfwd
:
1713 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
1714 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1718 case Lisp_Misc_Buffer_Objfwd
:
1719 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
1720 print (*(Lisp_Object
*)((char *)current_buffer
1721 + XBUFFER_OBJFWD (obj
)->offset
),
1722 printcharfun
, escapeflag
);
1726 case Lisp_Misc_Kboard_Objfwd
:
1727 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
1728 print (*(Lisp_Object
*)((char *) current_kboard
1729 + XKBOARD_OBJFWD (obj
)->offset
),
1730 printcharfun
, escapeflag
);
1734 case Lisp_Misc_Buffer_Local_Value
:
1735 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
1736 goto do_buffer_local
;
1737 case Lisp_Misc_Some_Buffer_Local_Value
:
1738 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
1740 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
1741 print (XBUFFER_LOCAL_VALUE (obj
)->realvalue
, printcharfun
, escapeflag
);
1742 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
1743 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
1745 strout ("[buffer] ", -1, -1, printcharfun
, 0);
1746 print (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
1747 printcharfun
, escapeflag
);
1748 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
1750 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
1751 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
1753 strout ("[frame] ", -1, -1, printcharfun
, 0);
1754 print (XBUFFER_LOCAL_VALUE (obj
)->frame
,
1755 printcharfun
, escapeflag
);
1757 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
1758 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1759 printcharfun
, escapeflag
);
1760 strout ("[default-value] ", -1, -1, printcharfun
, 0);
1761 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
,
1762 printcharfun
, escapeflag
);
1770 #endif /* standalone */
1775 /* We're in trouble if this happens!
1776 Probably should just abort () */
1777 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
1779 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1780 else if (VECTORLIKEP (obj
))
1781 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1783 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1784 strout (buf
, -1, -1, printcharfun
, 0);
1785 strout (" Save your buffers immediately and please report this bug>",
1786 -1, -1, printcharfun
, 0);
1793 #ifdef USE_TEXT_PROPERTIES
1795 /* Print a description of INTERVAL using PRINTCHARFUN.
1796 This is part of printing a string that has text properties. */
1799 print_interval (interval
, printcharfun
)
1801 Lisp_Object printcharfun
;
1804 print (make_number (interval
->position
), printcharfun
, 1);
1806 print (make_number (interval
->position
+ LENGTH (interval
)),
1809 print (interval
->plist
, printcharfun
, 1);
1812 #endif /* USE_TEXT_PROPERTIES */
1817 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1818 "Output stream `print' uses by default for outputting a character.\n\
1819 This may be any function of one argument.\n\
1820 It may also be a buffer (output is inserted before point)\n\
1821 or a marker (output is inserted and the marker is advanced)\n\
1822 or the symbol t (output appears in the echo area).");
1823 Vstandard_output
= Qt
;
1824 Qstandard_output
= intern ("standard-output");
1825 staticpro (&Qstandard_output
);
1827 #ifdef LISP_FLOAT_TYPE
1828 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1829 "The format descriptor string used to print floats.\n\
1830 This is a %-spec like those accepted by `printf' in C,\n\
1831 but with some restrictions. It must start with the two characters `%.'.\n\
1832 After that comes an integer precision specification,\n\
1833 and then a letter which controls the format.\n\
1834 The letters allowed are `e', `f' and `g'.\n\
1835 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1836 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1837 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1838 The precision in any of these cases is the number of digits following\n\
1839 the decimal point. With `f', a precision of 0 means to omit the\n\
1840 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1841 A value of nil means to use the shortest notation\n\
1842 that represents the number without losing information.");
1843 Vfloat_output_format
= Qnil
;
1844 Qfloat_output_format
= intern ("float-output-format");
1845 staticpro (&Qfloat_output_format
);
1846 #endif /* LISP_FLOAT_TYPE */
1848 DEFVAR_LISP ("print-length", &Vprint_length
,
1849 "Maximum length of list to print before abbreviating.\n\
1850 A value of nil means no limit.");
1851 Vprint_length
= Qnil
;
1853 DEFVAR_LISP ("print-level", &Vprint_level
,
1854 "Maximum depth of list nesting to print before abbreviating.\n\
1855 A value of nil means no limit.");
1856 Vprint_level
= Qnil
;
1858 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1859 "Non-nil means print newlines in strings as backslash-n.\n\
1860 Also print formfeeds as backslash-f.");
1861 print_escape_newlines
= 0;
1863 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
1864 "Non-nil means print unibyte non-ASCII chars in strings as \\OOO.\n\
1865 \(OOO is the octal representation of the character code.)\n\
1866 Only single-byte characters are affected, and only in `prin1'.");
1867 print_escape_nonascii
= 0;
1869 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
1870 "Non-nil means print multibyte characters in strings as \\xXXXX.\n\
1871 \(XXX is the hex representation of the character code.)\n\
1872 This affects only `prin1'.");
1873 print_escape_multibyte
= 0;
1875 DEFVAR_BOOL ("print-quoted", &print_quoted
,
1876 "Non-nil means print quoted forms with reader syntax.\n\
1877 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\
1878 forms print in the new syntax.");
1881 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
1882 "Non-nil means print uninterned symbols so they will read as uninterned.\n\
1883 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\
1884 When the uninterned symbol appears within a larger data structure,\n\
1885 in addition use the #...# and #...= constructs as needed,\n\
1886 so that multiple references to the same symbol are shared once again\n\
1887 when the text is read back.\n\
1889 If the value of `print-gensym' is a cons cell, then in addition refrain from\n\
1890 clearing `print-gensym-alist' on entry to and exit from printing functions,\n\
1891 so that the use of #...# and #...= can carry over for several separately\n\
1893 Vprint_gensym
= Qnil
;
1895 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist
,
1896 "Association list of elements (GENSYM . N) to guide use of #N# and #N=.\n\
1897 In each element, GENSYM is an uninterned symbol that has been associated\n\
1898 with #N= for the specified value of N.");
1899 Vprint_gensym_alist
= Qnil
;
1901 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1902 staticpro (&Vprin1_to_string_buffer
);
1905 defsubr (&Sprin1_to_string
);
1906 defsubr (&Serror_message_string
);
1910 defsubr (&Swrite_char
);
1911 defsubr (&Sexternal_debugging_output
);
1913 Qexternal_debugging_output
= intern ("external-debugging-output");
1914 staticpro (&Qexternal_debugging_output
);
1916 Qprint_escape_newlines
= intern ("print-escape-newlines");
1917 staticpro (&Qprint_escape_newlines
);
1919 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
1920 staticpro (&Qprint_escape_multibyte
);
1922 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
1923 staticpro (&Qprint_escape_nonascii
);
1926 defsubr (&Swith_output_to_temp_buffer
);
1927 #endif /* not standalone */