1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001
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. */
32 #include "dispextern.h"
34 #include "intervals.h"
36 Lisp_Object Vstandard_output
, Qstandard_output
;
38 Lisp_Object Qtemp_buffer_setup_hook
;
40 /* These are used to print like we read. */
41 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
43 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
45 /* Work around a problem that happens because math.h on hpux 7
46 defines two static variables--which, in Emacs, are not really static,
47 because `static' is defined as nothing. The problem is that they are
48 defined both here and in lread.c.
49 These macros prevent the name conflict. */
50 #if defined (HPUX) && !defined (HPUX8)
51 #define _MAXLDBL print_maxldbl
52 #define _NMAXLDBL print_nmaxldbl
61 /* Default to values appropriate for IEEE floating point. */
66 #define DBL_MANT_DIG 53
72 #define DBL_MIN 2.2250738585072014e-308
75 #ifdef DBL_MIN_REPLACEMENT
77 #define DBL_MIN DBL_MIN_REPLACEMENT
80 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
81 needed to express a float without losing information.
82 The general-case formula is valid for the usual case, IEEE floating point,
83 but many compilers can't optimize the formula to an integer constant,
84 so make a special case for it. */
85 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
86 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
88 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
91 /* Avoid actual stack overflow in print. */
94 /* Detect most circularities to print finite output. */
95 #define PRINT_CIRCLE 200
96 Lisp_Object being_printed
[PRINT_CIRCLE
];
98 /* When printing into a buffer, first we put the text in this
99 block, then insert it all at once. */
102 /* Size allocated in print_buffer. */
103 int print_buffer_size
;
104 /* Chars stored in print_buffer. */
105 int print_buffer_pos
;
106 /* Bytes stored in print_buffer. */
107 int print_buffer_pos_byte
;
109 /* Maximum length of list to print in full; noninteger means
110 effectively infinity */
112 Lisp_Object Vprint_length
;
114 /* Maximum depth of list to print in full; noninteger means
115 effectively infinity. */
117 Lisp_Object Vprint_level
;
119 /* Nonzero means print newlines in strings as \n. */
121 int print_escape_newlines
;
123 /* Nonzero means to print single-byte non-ascii characters in strings as
126 int print_escape_nonascii
;
128 /* Nonzero means to print multibyte characters in strings as hex escapes. */
130 int print_escape_multibyte
;
132 Lisp_Object Qprint_escape_newlines
;
133 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
135 /* Nonzero means print (quote foo) forms as 'foo, etc. */
139 /* Non-nil means print #: before uninterned symbols. */
141 Lisp_Object Vprint_gensym
;
143 /* Non-nil means print recursive structures using #n= and #n# syntax. */
145 Lisp_Object Vprint_circle
;
147 /* Non-nil means keep continuous number for #n= and #n# syntax
148 between several print functions. */
150 Lisp_Object Vprint_continuous_numbering
;
152 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
153 where OBJn are objects going to be printed, and STATn are their status,
154 which may be different meanings during process. See the comments of
155 the functions print and print_preprocess for details.
156 print_number_index keeps the last position the next object should be added,
157 twice of which is the actual vector position in Vprint_number_table. */
158 int print_number_index
;
159 Lisp_Object Vprint_number_table
;
161 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
162 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
163 See the comment of the variable Vprint_number_table. */
164 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
165 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
167 /* Nonzero means print newline to stdout before next minibuffer message.
168 Defined in xdisp.c */
170 extern int noninteractive_need_newline
;
172 extern int minibuffer_auto_raise
;
174 #ifdef MAX_PRINT_CHARS
175 static int print_chars
;
176 static int max_print
;
177 #endif /* MAX_PRINT_CHARS */
179 void print_interval ();
182 /* Low level output routines for characters and strings */
184 /* Lisp functions to do output using a stream
185 must have the stream in a variable called printcharfun
186 and must start with PRINTPREPARE, end with PRINTFINISH,
187 and use PRINTDECLARE to declare common variables.
188 Use PRINTCHAR to output one character,
189 or call strout to output a block of characters. */
191 #define PRINTDECLARE \
192 struct buffer *old = current_buffer; \
193 int old_point = -1, start_point = -1; \
194 int old_point_byte = -1, start_point_byte = -1; \
195 int specpdl_count = specpdl_ptr - specpdl; \
196 int free_print_buffer = 0; \
197 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
200 #define PRINTPREPARE \
201 original = printcharfun; \
202 if (NILP (printcharfun)) printcharfun = Qt; \
203 if (BUFFERP (printcharfun)) \
205 if (XBUFFER (printcharfun) != current_buffer) \
206 Fset_buffer (printcharfun); \
207 printcharfun = Qnil; \
209 if (MARKERP (printcharfun)) \
211 if (!(XMARKER (original)->buffer)) \
212 error ("Marker does not point anywhere"); \
213 if (XMARKER (original)->buffer != current_buffer) \
214 set_buffer_internal (XMARKER (original)->buffer); \
216 old_point_byte = PT_BYTE; \
217 SET_PT_BOTH (marker_position (printcharfun), \
218 marker_byte_position (printcharfun)); \
220 start_point_byte = PT_BYTE; \
221 printcharfun = Qnil; \
223 if (NILP (printcharfun)) \
225 Lisp_Object string; \
226 if (NILP (current_buffer->enable_multibyte_characters) \
227 && ! print_escape_multibyte) \
228 specbind (Qprint_escape_multibyte, Qt); \
229 if (! NILP (current_buffer->enable_multibyte_characters) \
230 && ! print_escape_nonascii) \
231 specbind (Qprint_escape_nonascii, Qt); \
232 if (print_buffer != 0) \
234 string = make_string_from_bytes (print_buffer, \
236 print_buffer_pos_byte); \
237 record_unwind_protect (print_unwind, string); \
241 print_buffer_size = 1000; \
242 print_buffer = (char *) xmalloc (print_buffer_size); \
243 free_print_buffer = 1; \
245 print_buffer_pos = 0; \
246 print_buffer_pos_byte = 0; \
248 if (EQ (printcharfun, Qt) && ! noninteractive) \
249 setup_echo_area_for_printing (multibyte);
251 #define PRINTFINISH \
252 if (NILP (printcharfun)) \
254 if (print_buffer_pos != print_buffer_pos_byte \
255 && NILP (current_buffer->enable_multibyte_characters)) \
257 unsigned char *temp \
258 = (unsigned char *) alloca (print_buffer_pos + 1); \
259 copy_text (print_buffer, temp, print_buffer_pos_byte, \
261 insert_1_both (temp, print_buffer_pos, \
262 print_buffer_pos, 0, 1, 0); \
265 insert_1_both (print_buffer, print_buffer_pos, \
266 print_buffer_pos_byte, 0, 1, 0); \
268 if (free_print_buffer) \
270 xfree (print_buffer); \
273 unbind_to (specpdl_count, Qnil); \
274 if (MARKERP (original)) \
275 set_marker_both (original, Qnil, PT, PT_BYTE); \
276 if (old_point >= 0) \
277 SET_PT_BOTH (old_point + (old_point >= start_point \
278 ? PT - start_point : 0), \
279 old_point_byte + (old_point_byte >= start_point_byte \
280 ? PT_BYTE - start_point_byte : 0)); \
281 if (old != current_buffer) \
282 set_buffer_internal (old);
284 #define PRINTCHAR(ch) printchar (ch, printcharfun)
286 /* This is used to restore the saved contents of print_buffer
287 when there is a recursive call to print. */
290 print_unwind (saved_text
)
291 Lisp_Object saved_text
;
293 bcopy (XSTRING (saved_text
)->data
, print_buffer
, XSTRING (saved_text
)->size
);
298 /* Print character CH using method FUN. FUN nil means print to
299 print_buffer. FUN t means print to echo area or stdout if
300 non-interactive. If FUN is neither nil nor t, call FUN with CH as
308 #ifdef MAX_PRINT_CHARS
311 #endif /* MAX_PRINT_CHARS */
313 if (!NILP (fun
) && !EQ (fun
, Qt
))
314 call1 (fun
, make_number (ch
));
317 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
318 int len
= CHAR_STRING (ch
, str
);
324 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
325 print_buffer
= (char *) xrealloc (print_buffer
,
326 print_buffer_size
*= 2);
327 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
328 print_buffer_pos
+= 1;
329 print_buffer_pos_byte
+= len
;
331 else if (noninteractive
)
333 fwrite (str
, 1, len
, stdout
);
334 noninteractive_need_newline
= 1;
339 = !NILP (current_buffer
->enable_multibyte_characters
);
341 setup_echo_area_for_printing (multibyte_p
);
343 message_dolog (str
, len
, 0, multibyte_p
);
349 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
350 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
351 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
352 print_buffer. PRINTCHARFUN t means output to the echo area or to
353 stdout if non-interactive. If neither nil nor t, call Lisp
354 function PRINTCHARFUN for each character printed. MULTIBYTE
355 non-zero means PTR contains multibyte characters. */
358 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
361 Lisp_Object printcharfun
;
365 size_byte
= size
= strlen (ptr
);
367 if (NILP (printcharfun
))
369 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
371 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
372 print_buffer
= (char *) xrealloc (print_buffer
,
375 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
376 print_buffer_pos
+= size
;
377 print_buffer_pos_byte
+= size_byte
;
379 #ifdef MAX_PRINT_CHARS
382 #endif /* MAX_PRINT_CHARS */
384 else if (noninteractive
&& EQ (printcharfun
, Qt
))
386 fwrite (ptr
, 1, size_byte
, stdout
);
387 noninteractive_need_newline
= 1;
389 else if (EQ (printcharfun
, Qt
))
391 /* Output to echo area. We're trying to avoid a little overhead
392 here, that's the reason we don't call printchar to do the
396 = !NILP (current_buffer
->enable_multibyte_characters
);
398 setup_echo_area_for_printing (multibyte_p
);
399 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
401 if (size
== size_byte
)
403 for (i
= 0; i
< size
; ++i
)
404 insert_char ((unsigned char )*ptr
++);
409 for (i
= 0; i
< size_byte
; i
+= len
)
411 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
416 #ifdef MAX_PRINT_CHARS
419 #endif /* MAX_PRINT_CHARS */
423 /* PRINTCHARFUN is a Lisp function. */
426 if (size
== size_byte
)
428 while (i
< size_byte
)
436 while (i
< size_byte
)
438 /* Here, we must convert each multi-byte form to the
439 corresponding character code before handing it to
442 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
450 /* Print the contents of a string STRING using PRINTCHARFUN.
451 It isn't safe to use strout in many cases,
452 because printing one char can relocate. */
455 print_string (string
, printcharfun
)
457 Lisp_Object printcharfun
;
459 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
463 if (STRING_MULTIBYTE (string
))
464 chars
= XSTRING (string
)->size
;
465 else if (EQ (printcharfun
, Qt
)
466 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
467 : ! NILP (current_buffer
->enable_multibyte_characters
))
469 /* If unibyte string STRING contains 8-bit codes, we must
470 convert STRING to a multibyte string containing the same
475 chars
= STRING_BYTES (XSTRING (string
));
476 bytes
= parse_str_to_multibyte (XSTRING (string
)->data
, chars
);
479 newstr
= make_uninit_multibyte_string (chars
, bytes
);
480 bcopy (XSTRING (string
)->data
, XSTRING (newstr
)->data
, chars
);
481 str_to_multibyte (XSTRING (newstr
)->data
, bytes
, chars
);
486 chars
= STRING_BYTES (XSTRING (string
));
488 /* strout is safe for output to a frame (echo area) or to print_buffer. */
489 strout (XSTRING (string
)->data
,
490 chars
, STRING_BYTES (XSTRING (string
)),
491 printcharfun
, STRING_MULTIBYTE (string
));
495 /* Otherwise, string may be relocated by printing one char.
496 So re-fetch the string address for each character. */
498 int size
= XSTRING (string
)->size
;
499 int size_byte
= STRING_BYTES (XSTRING (string
));
502 if (size
== size_byte
)
503 for (i
= 0; i
< size
; i
++)
504 PRINTCHAR (XSTRING (string
)->data
[i
]);
506 for (i
= 0; i
< size_byte
; i
++)
508 /* Here, we must convert each multi-byte form to the
509 corresponding character code before handing it to PRINTCHAR. */
511 int ch
= STRING_CHAR_AND_LENGTH (XSTRING (string
)->data
+ i
,
513 if (!CHAR_VALID_P (ch
, 0))
515 ch
= XSTRING (string
)->data
[i
];
525 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
526 doc
: /* Output character CHARACTER to stream PRINTCHARFUN.
527 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
528 (character
, printcharfun
)
529 Lisp_Object character
, printcharfun
;
533 if (NILP (printcharfun
))
534 printcharfun
= Vstandard_output
;
535 CHECK_NUMBER (character
);
537 PRINTCHAR (XINT (character
));
542 /* Used from outside of print.c to print a block of SIZE
543 single-byte chars at DATA on the default output stream.
544 Do not use this on the contents of a Lisp string. */
547 write_string (data
, size
)
552 Lisp_Object printcharfun
;
554 printcharfun
= Vstandard_output
;
557 strout (data
, size
, size
, printcharfun
, 0);
561 /* Used from outside of print.c to print a block of SIZE
562 single-byte chars at DATA on a specified stream PRINTCHARFUN.
563 Do not use this on the contents of a Lisp string. */
566 write_string_1 (data
, size
, printcharfun
)
569 Lisp_Object printcharfun
;
574 strout (data
, size
, size
, printcharfun
, 0);
580 temp_output_buffer_setup (bufname
)
583 int count
= specpdl_ptr
- specpdl
;
584 register struct buffer
*old
= current_buffer
;
585 register Lisp_Object buf
;
587 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
589 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
591 current_buffer
->directory
= old
->directory
;
592 current_buffer
->read_only
= Qnil
;
593 current_buffer
->filename
= Qnil
;
594 current_buffer
->undo_list
= Qt
;
595 current_buffer
->overlays_before
= Qnil
;
596 current_buffer
->overlays_after
= Qnil
;
597 current_buffer
->enable_multibyte_characters
598 = buffer_defaults
.enable_multibyte_characters
;
600 XSETBUFFER (buf
, current_buffer
);
602 Frun_hooks (1, &Qtemp_buffer_setup_hook
);
604 unbind_to (count
, Qnil
);
606 specbind (Qstandard_output
, buf
);
610 internal_with_output_to_temp_buffer (bufname
, function
, args
)
612 Lisp_Object (*function
) P_ ((Lisp_Object
));
615 int count
= specpdl_ptr
- specpdl
;
616 Lisp_Object buf
, val
;
620 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
621 temp_output_buffer_setup (bufname
);
622 buf
= Vstandard_output
;
625 val
= (*function
) (args
);
628 temp_output_buffer_show (buf
);
631 return unbind_to (count
, val
);
634 DEFUN ("with-output-to-temp-buffer",
635 Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
637 doc
: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
638 The buffer is cleared out initially, and marked as unmodified when done.
639 All output done by BODY is inserted in that buffer by default.
640 The buffer is displayed in another window, but not selected.
641 The value of the last form in BODY is returned.
642 If BODY does not finish normally, the buffer BUFNAME is not displayed.
644 The hook `temp-buffer-setup-hook' is run before BODY,
645 with the buffer BUFNAME temporarily current.
646 The hook `temp-buffer-show-hook' is run after the buffer is displayed,
647 with the buffer temporarily current, and the window that was used
648 to display it temporarily selected.
650 If variable `temp-buffer-show-function' is non-nil, call it at the end
651 to get the buffer displayed instead of just displaying the non-selected
652 buffer and calling the hook. It gets one argument, the buffer to display.
654 usage: (with-output-to-temp-buffer BUFFNAME BODY ...) */)
660 int count
= specpdl_ptr
- specpdl
;
661 Lisp_Object buf
, val
;
664 name
= Feval (Fcar (args
));
666 temp_output_buffer_setup (XSTRING (name
)->data
);
667 buf
= Vstandard_output
;
670 val
= Fprogn (XCDR (args
));
673 temp_output_buffer_show (buf
);
676 return unbind_to (count
, val
);
680 static void print ();
681 static void print_preprocess ();
682 static void print_preprocess_string ();
683 static void print_object ();
685 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
686 doc
: /* Output a newline to stream PRINTCHARFUN.
687 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
689 Lisp_Object printcharfun
;
693 if (NILP (printcharfun
))
694 printcharfun
= Vstandard_output
;
701 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
702 doc
: /* Output the printed representation of OBJECT, any Lisp object.
703 Quoting characters are printed when needed to make output that `read'
704 can handle, whenever this is possible. For complex objects, the behavior
705 is controlled by `print-level' and `print-length', which see.
707 OBJECT is any of the Lisp data types: a number, a string, a symbol,
708 a list, a buffer, a window, a frame, etc.
710 A printed representation of an object is text which describes that object.
712 Optional argument PRINTCHARFUN is the output stream, which can be one
715 - a buffer, in which case output is inserted into that buffer at point;
716 - a marker, in which case output is inserted at marker's position;
717 - a function, in which case that function is called once for each
718 character of OBJECT's printed representation;
719 - a symbol, in which case that symbol's function definition is called; or
720 - t, in which case the output is displayed in the echo area.
722 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
724 (object
, printcharfun
)
725 Lisp_Object object
, printcharfun
;
729 #ifdef MAX_PRINT_CHARS
731 #endif /* MAX_PRINT_CHARS */
732 if (NILP (printcharfun
))
733 printcharfun
= Vstandard_output
;
735 print (object
, printcharfun
, 1);
740 /* a buffer which is used to hold output being built by prin1-to-string */
741 Lisp_Object Vprin1_to_string_buffer
;
743 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
744 doc
: /* Return a string containing the printed representation of OBJECT.
745 OBJECT can be any Lisp object. This function outputs quoting characters
746 when necessary to make output that `read' can handle, whenever possible,
747 unless the optional second argument NOESCAPE is non-nil.
749 OBJECT is any of the Lisp data types: a number, a string, a symbol,
750 a list, a buffer, a window, a frame, etc.
752 A printed representation of an object is text which describes that object. */)
754 Lisp_Object object
, noescape
;
757 Lisp_Object printcharfun
;
758 struct gcpro gcpro1
, gcpro2
;
761 /* Save and restore this--we are altering a buffer
762 but we don't want to deactivate the mark just for that.
763 No need for specbind, since errors deactivate the mark. */
764 tem
= Vdeactivate_mark
;
765 GCPRO2 (object
, tem
);
767 printcharfun
= Vprin1_to_string_buffer
;
769 print (object
, printcharfun
, NILP (noescape
));
770 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
772 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
773 object
= Fbuffer_string ();
776 set_buffer_internal (old
);
778 Vdeactivate_mark
= tem
;
784 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
785 doc
: /* Output the printed representation of OBJECT, any Lisp object.
786 No quoting characters are used; no delimiters are printed around
787 the contents of strings.
789 OBJECT is any of the Lisp data types: a number, a string, a symbol,
790 a list, a buffer, a window, a frame, etc.
792 A printed representation of an object is text which describes that object.
794 Optional argument PRINTCHARFUN is the output stream, which can be one
797 - a buffer, in which case output is inserted into that buffer at point;
798 - a marker, in which case output is inserted at marker's position;
799 - a function, in which case that function is called once for each
800 character of OBJECT's printed representation;
801 - a symbol, in which case that symbol's function definition is called; or
802 - t, in which case the output is displayed in the echo area.
804 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
806 (object
, printcharfun
)
807 Lisp_Object object
, printcharfun
;
811 if (NILP (printcharfun
))
812 printcharfun
= Vstandard_output
;
814 print (object
, printcharfun
, 0);
819 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
820 doc
: /* Output the printed representation of OBJECT, with newlines around it.
821 Quoting characters are printed when needed to make output that `read'
822 can handle, whenever this is possible. For complex objects, the behavior
823 is controlled by `print-level' and `print-length', which see.
825 OBJECT is any of the Lisp data types: a number, a string, a symbol,
826 a list, a buffer, a window, a frame, etc.
828 A printed representation of an object is text which describes that object.
830 Optional argument PRINTCHARFUN is the output stream, which can be one
833 - a buffer, in which case output is inserted into that buffer at point;
834 - a marker, in which case output is inserted at marker's position;
835 - a function, in which case that function is called once for each
836 character of OBJECT's printed representation;
837 - a symbol, in which case that symbol's function definition is called; or
838 - t, in which case the output is displayed in the echo area.
840 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
842 (object
, printcharfun
)
843 Lisp_Object object
, printcharfun
;
848 #ifdef MAX_PRINT_CHARS
850 max_print
= MAX_PRINT_CHARS
;
851 #endif /* MAX_PRINT_CHARS */
852 if (NILP (printcharfun
))
853 printcharfun
= Vstandard_output
;
857 print (object
, printcharfun
, 1);
860 #ifdef MAX_PRINT_CHARS
863 #endif /* MAX_PRINT_CHARS */
868 /* The subroutine object for external-debugging-output is kept here
869 for the convenience of the debugger. */
870 Lisp_Object Qexternal_debugging_output
;
872 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
873 doc
: /* Write CHARACTER to stderr.
874 You can call print while debugging emacs, and pass it this function
875 to make it write to the debugging output. */)
877 Lisp_Object character
;
879 CHECK_NUMBER (character
);
880 putc (XINT (character
), stderr
);
883 /* Send the output to a debugger (nothing happens if there isn't one). */
885 char buf
[2] = {(char) XINT (character
), '\0'};
886 OutputDebugString (buf
);
893 /* This is the interface for debugging printing. */
899 Fprin1 (arg
, Qexternal_debugging_output
);
900 fprintf (stderr
, "\r\n");
903 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
905 doc
: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message. */)
909 struct buffer
*old
= current_buffer
;
913 /* If OBJ is (error STRING), just return STRING.
914 That is not only faster, it also avoids the need to allocate
915 space here when the error is due to memory full. */
916 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
917 && CONSP (XCDR (obj
))
918 && STRINGP (XCAR (XCDR (obj
)))
919 && NILP (XCDR (XCDR (obj
))))
920 return XCAR (XCDR (obj
));
922 print_error_message (obj
, Vprin1_to_string_buffer
);
924 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
925 value
= Fbuffer_string ();
929 set_buffer_internal (old
);
935 /* Print an error message for the error DATA onto Lisp output stream
936 STREAM (suitable for the print functions). */
939 print_error_message (data
, stream
)
940 Lisp_Object data
, stream
;
942 Lisp_Object errname
, errmsg
, file_error
, tail
;
946 errname
= Fcar (data
);
948 if (EQ (errname
, Qerror
))
953 errmsg
= Fcar (data
);
958 Lisp_Object error_conditions
;
959 errmsg
= Fget (errname
, Qerror_message
);
960 error_conditions
= Fget (errname
, Qerror_conditions
);
961 file_error
= Fmemq (Qfile_error
, error_conditions
);
964 /* Print an error message including the data items. */
966 tail
= Fcdr_safe (data
);
969 /* If we know from where the error was signaled, show it in
971 if (!NILP (Vsignaling_function
) && SYMBOLP (Vsignaling_function
))
973 char *name
= XSYMBOL (Vsignaling_function
)->name
->data
;
974 message_dolog (name
, strlen (name
), 0, 0);
975 message_dolog (": ", 2, 0, 0);
976 Vsignaling_function
= Qnil
;
979 /* For file-error, make error message by concatenating
980 all the data items. They are all strings. */
981 if (!NILP (file_error
) && CONSP (tail
))
982 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
984 if (STRINGP (errmsg
))
985 Fprinc (errmsg
, stream
);
987 write_string_1 ("peculiar error", -1, stream
);
989 for (i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
993 write_string_1 (i
? ", " : ": ", 2, stream
);
995 if (!NILP (file_error
) || EQ (errname
, Qend_of_file
))
996 Fprinc (obj
, stream
);
998 Fprin1 (obj
, stream
);
1007 * The buffer should be at least as large as the max string size of the
1008 * largest float, printed in the biggest notation. This is undoubtedly
1009 * 20d float_output_format, with the negative of the C-constant "HUGE"
1012 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1014 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1015 * case of -1e307 in 20d float_output_format. What is one to do (short of
1016 * re-writing _doprnt to be more sane)?
1021 float_to_string (buf
, data
)
1028 /* Check for plus infinity in a way that won't lose
1029 if there is no plus infinity. */
1030 if (data
== data
/ 2 && data
> 1.0)
1032 strcpy (buf
, "1.0e+INF");
1035 /* Likewise for minus infinity. */
1036 if (data
== data
/ 2 && data
< -1.0)
1038 strcpy (buf
, "-1.0e+INF");
1041 /* Check for NaN in a way that won't fail if there are no NaNs. */
1042 if (! (data
* 0.0 >= 0.0))
1044 /* Prepend "-" if the NaN's sign bit is negative.
1045 The sign bit of a double is the bit that is 1 in -0.0. */
1047 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
1049 u_minus_zero
.d
= - 0.0;
1050 for (i
= 0; i
< sizeof (double); i
++)
1051 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1057 strcpy (buf
, "0.0e+NaN");
1061 if (NILP (Vfloat_output_format
)
1062 || !STRINGP (Vfloat_output_format
))
1065 /* Generate the fewest number of digits that represent the
1066 floating point value without losing information.
1067 The following method is simple but a bit slow.
1068 For ideas about speeding things up, please see:
1070 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1071 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1073 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1074 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1076 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1078 sprintf (buf
, "%.*g", width
, data
);
1079 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1081 else /* oink oink */
1083 /* Check that the spec we have is fully valid.
1084 This means not only valid for printf,
1085 but meant for floats, and reasonable. */
1086 cp
= XSTRING (Vfloat_output_format
)->data
;
1095 /* Check the width specification. */
1097 if ('0' <= *cp
&& *cp
<= '9')
1101 width
= (width
* 10) + (*cp
++ - '0');
1102 while (*cp
>= '0' && *cp
<= '9');
1104 /* A precision of zero is valid only for %f. */
1106 || (width
== 0 && *cp
!= 'f'))
1110 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1116 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
1119 /* Make sure there is a decimal point with digit after, or an
1120 exponent, so that the value is readable as a float. But don't do
1121 this with "%.0f"; it's valid for that not to produce a decimal
1122 point. Note that width can be 0 only for %.0f. */
1125 for (cp
= buf
; *cp
; cp
++)
1126 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1129 if (*cp
== '.' && cp
[1] == 0)
1146 print (obj
, printcharfun
, escapeflag
)
1148 register Lisp_Object printcharfun
;
1153 /* Reset print_number_index and Vprint_number_table only when
1154 the variable Vprint_continuous_numbering is nil. Otherwise,
1155 the values of these variables will be kept between several
1157 if (NILP (Vprint_continuous_numbering
))
1159 print_number_index
= 0;
1160 Vprint_number_table
= Qnil
;
1163 /* Construct Vprint_number_table for print-gensym and print-circle. */
1164 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1166 int i
, start
, index
;
1167 /* Construct Vprint_number_table. */
1168 start
= index
= print_number_index
;
1169 print_preprocess (obj
);
1170 /* Remove unnecessary objects, which appear only once in OBJ;
1171 that is, whose status is Qnil. */
1172 for (i
= start
; i
< print_number_index
; i
++)
1173 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1175 PRINT_NUMBER_OBJECT (Vprint_number_table
, index
)
1176 = PRINT_NUMBER_OBJECT (Vprint_number_table
, i
);
1177 /* Reset the status field for the next print step. Now this
1178 field means whether the object has already been printed. */
1179 PRINT_NUMBER_STATUS (Vprint_number_table
, index
) = Qnil
;
1182 print_number_index
= index
;
1185 print_object (obj
, printcharfun
, escapeflag
);
1188 /* Construct Vprint_number_table according to the structure of OBJ.
1189 OBJ itself and all its elements will be added to Vprint_number_table
1190 recursively if it is a list, vector, compiled function, char-table,
1191 string (its text properties will be traced), or a symbol that has
1192 no obarray (this is for the print-gensym feature).
1193 The status fields of Vprint_number_table mean whether each object appears
1194 more than once in OBJ: Qnil at the first time, and Qt after that . */
1196 print_preprocess (obj
)
1202 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1203 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1204 || (! NILP (Vprint_gensym
)
1206 && !SYMBOL_INTERNED_P (obj
)))
1208 /* In case print-circle is nil and print-gensym is t,
1209 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1210 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1212 for (i
= 0; i
< print_number_index
; i
++)
1213 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1215 /* OBJ appears more than once. Let's remember that. */
1216 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1220 /* OBJ is not yet recorded. Let's add to the table. */
1221 if (print_number_index
== 0)
1223 /* Initialize the table. */
1224 Vprint_number_table
= Fmake_vector (make_number (40), Qnil
);
1226 else if (XVECTOR (Vprint_number_table
)->size
== print_number_index
* 2)
1228 /* Reallocate the table. */
1229 int i
= print_number_index
* 4;
1230 Lisp_Object old_table
= Vprint_number_table
;
1231 Vprint_number_table
= Fmake_vector (make_number (i
), Qnil
);
1232 for (i
= 0; i
< print_number_index
; i
++)
1234 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
)
1235 = PRINT_NUMBER_OBJECT (old_table
, i
);
1236 PRINT_NUMBER_STATUS (Vprint_number_table
, i
)
1237 = PRINT_NUMBER_STATUS (old_table
, i
);
1240 PRINT_NUMBER_OBJECT (Vprint_number_table
, print_number_index
) = obj
;
1241 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1242 always print the gensym with a number. This is a special for
1243 the lisp function byte-compile-output-docform. */
1244 if (!NILP (Vprint_continuous_numbering
)
1246 && !SYMBOL_INTERNED_P (obj
))
1247 PRINT_NUMBER_STATUS (Vprint_number_table
, print_number_index
) = Qt
;
1248 print_number_index
++;
1251 switch (XGCTYPE (obj
))
1254 /* A string may have text properties, which can be circular. */
1255 traverse_intervals_noorder (XSTRING (obj
)->intervals
,
1256 print_preprocess_string
, Qnil
);
1260 print_preprocess (XCAR (obj
));
1264 case Lisp_Vectorlike
:
1265 size
= XVECTOR (obj
)->size
& PSEUDOVECTOR_SIZE_MASK
;
1266 for (i
= 0; i
< size
; i
++)
1267 print_preprocess (XVECTOR (obj
)->contents
[i
]);
1277 print_preprocess_string (interval
, arg
)
1281 print_preprocess (interval
->plist
);
1285 print_object (obj
, printcharfun
, escapeflag
)
1287 register Lisp_Object printcharfun
;
1294 /* Detect circularities and truncate them. */
1295 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1296 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1297 || (! NILP (Vprint_gensym
)
1299 && !SYMBOL_INTERNED_P (obj
)))
1301 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1303 /* Simple but incomplete way. */
1305 for (i
= 0; i
< print_depth
; i
++)
1306 if (EQ (obj
, being_printed
[i
]))
1308 sprintf (buf
, "#%d", i
);
1309 strout (buf
, -1, -1, printcharfun
, 0);
1312 being_printed
[print_depth
] = obj
;
1316 /* With the print-circle feature. */
1318 for (i
= 0; i
< print_number_index
; i
++)
1319 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1321 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1323 /* Add a prefix #n= if OBJ has not yet been printed;
1324 that is, its status field is nil. */
1325 sprintf (buf
, "#%d=", i
+ 1);
1326 strout (buf
, -1, -1, printcharfun
, 0);
1327 /* OBJ is going to be printed. Set the status to t. */
1328 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1333 /* Just print #n# if OBJ has already been printed. */
1334 sprintf (buf
, "#%d#", i
+ 1);
1335 strout (buf
, -1, -1, printcharfun
, 0);
1344 if (print_depth
> PRINT_CIRCLE
)
1345 error ("Apparently circular structure being printed");
1346 #ifdef MAX_PRINT_CHARS
1347 if (max_print
&& print_chars
> max_print
)
1352 #endif /* MAX_PRINT_CHARS */
1354 switch (XGCTYPE (obj
))
1357 if (sizeof (int) == sizeof (EMACS_INT
))
1358 sprintf (buf
, "%d", XINT (obj
));
1359 else if (sizeof (long) == sizeof (EMACS_INT
))
1360 sprintf (buf
, "%ld", (long) XINT (obj
));
1363 strout (buf
, -1, -1, printcharfun
, 0);
1368 char pigbuf
[350]; /* see comments in float_to_string */
1370 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1371 strout (pigbuf
, -1, -1, printcharfun
, 0);
1377 print_string (obj
, printcharfun
);
1380 register int i
, i_byte
;
1381 struct gcpro gcpro1
;
1384 /* 1 means we must ensure that the next character we output
1385 cannot be taken as part of a hex character escape. */
1386 int need_nonhex
= 0;
1387 int multibyte
= STRING_MULTIBYTE (obj
);
1391 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1398 str
= XSTRING (obj
)->data
;
1399 size_byte
= STRING_BYTES (XSTRING (obj
));
1401 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1403 /* Here, we must convert each multi-byte form to the
1404 corresponding character code before handing it to PRINTCHAR. */
1410 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
,
1411 size_byte
- i_byte
, len
);
1412 if (CHAR_VALID_P (c
, 0))
1422 if (c
== '\n' && print_escape_newlines
)
1427 else if (c
== '\f' && print_escape_newlines
)
1433 && ! ASCII_BYTE_P (c
)
1434 && (SINGLE_BYTE_CHAR_P (c
) || print_escape_multibyte
))
1436 /* When multibyte is disabled,
1437 print multibyte string chars using hex escapes.
1438 For a char code that could be in a unibyte string,
1439 when found in a multibyte string, always use a hex escape
1440 so it reads back as multibyte. */
1441 unsigned char outbuf
[50];
1442 sprintf (outbuf
, "\\x%x", c
);
1443 strout (outbuf
, -1, -1, printcharfun
, 0);
1446 else if (! multibyte
1447 && SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1448 && print_escape_nonascii
)
1450 /* When printing in a multibyte buffer
1451 or when explicitly requested,
1452 print single-byte non-ASCII string chars
1453 using octal escapes. */
1454 unsigned char outbuf
[5];
1455 sprintf (outbuf
, "\\%03o", c
);
1456 strout (outbuf
, -1, -1, printcharfun
, 0);
1460 /* If we just had a hex escape, and this character
1461 could be taken as part of it,
1462 output `\ ' to prevent that. */
1466 if ((c
>= 'a' && c
<= 'f')
1467 || (c
>= 'A' && c
<= 'F')
1468 || (c
>= '0' && c
<= '9'))
1469 strout ("\\ ", -1, -1, printcharfun
, 0);
1472 if (c
== '\"' || c
== '\\')
1479 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1481 traverse_intervals (XSTRING (obj
)->intervals
,
1482 0, print_interval
, printcharfun
);
1492 register int confusing
;
1493 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
1494 register unsigned char *end
= p
+ STRING_BYTES (XSYMBOL (obj
)->name
);
1496 int i
, i_byte
, size_byte
;
1499 XSETSTRING (name
, XSYMBOL (obj
)->name
);
1501 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1504 /* If symbol name begins with a digit, and ends with a digit,
1505 and contains nothing but digits and `e', it could be treated
1506 as a number. So set CONFUSING.
1508 Symbols that contain periods could also be taken as numbers,
1509 but periods are always escaped, so we don't have to worry
1511 else if (*p
>= '0' && *p
<= '9'
1512 && end
[-1] >= '0' && end
[-1] <= '9')
1514 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1515 /* Needed for \2e10. */
1518 confusing
= (end
== p
);
1523 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1529 size_byte
= STRING_BYTES (XSTRING (name
));
1531 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1533 /* Here, we must convert each multi-byte form to the
1534 corresponding character code before handing it to PRINTCHAR. */
1535 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1540 if (c
== '\"' || c
== '\\' || c
== '\''
1541 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1542 || c
== ',' || c
=='.' || c
== '`'
1543 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1545 PRINTCHAR ('\\'), confusing
= 0;
1553 /* If deeper than spec'd depth, print placeholder. */
1554 if (INTEGERP (Vprint_level
)
1555 && print_depth
> XINT (Vprint_level
))
1556 strout ("...", -1, -1, printcharfun
, 0);
1557 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1558 && (EQ (XCAR (obj
), Qquote
)))
1561 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1563 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1564 && (EQ (XCAR (obj
), Qfunction
)))
1568 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1570 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1571 && ((EQ (XCAR (obj
), Qbackquote
)
1572 || EQ (XCAR (obj
), Qcomma
)
1573 || EQ (XCAR (obj
), Qcomma_at
)
1574 || EQ (XCAR (obj
), Qcomma_dot
))))
1576 print_object (XCAR (obj
), printcharfun
, 0);
1577 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1583 int print_length
, i
;
1584 Lisp_Object halftail
= obj
;
1586 /* Negative values of print-length are invalid in CL.
1587 Treat them like nil, as CMUCL does. */
1588 if (NATNUMP (Vprint_length
))
1589 print_length
= XFASTINT (Vprint_length
);
1596 /* Detect circular list. */
1597 if (NILP (Vprint_circle
))
1599 /* Simple but imcomplete way. */
1600 if (i
!= 0 && EQ (obj
, halftail
))
1602 sprintf (buf
, " . #%d", i
/ 2);
1603 strout (buf
, -1, -1, printcharfun
, 0);
1609 /* With the print-circle feature. */
1613 for (i
= 0; i
< print_number_index
; i
++)
1614 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
),
1617 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1619 strout (" . ", 3, 3, printcharfun
, 0);
1620 print_object (obj
, printcharfun
, escapeflag
);
1624 sprintf (buf
, " . #%d#", i
+ 1);
1625 strout (buf
, -1, -1, printcharfun
, 0);
1635 if (print_length
&& i
> print_length
)
1637 strout ("...", 3, 3, printcharfun
, 0);
1641 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1645 halftail
= XCDR (halftail
);
1649 /* OBJ non-nil here means it's the end of a dotted list. */
1652 strout (" . ", 3, 3, printcharfun
, 0);
1653 print_object (obj
, printcharfun
, escapeflag
);
1661 case Lisp_Vectorlike
:
1666 strout ("#<process ", -1, -1, printcharfun
, 0);
1667 print_string (XPROCESS (obj
)->name
, printcharfun
);
1671 print_string (XPROCESS (obj
)->name
, printcharfun
);
1673 else if (BOOL_VECTOR_P (obj
))
1676 register unsigned char c
;
1677 struct gcpro gcpro1
;
1679 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1685 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1686 strout (buf
, -1, -1, printcharfun
, 0);
1689 /* Don't print more characters than the specified maximum.
1690 Negative values of print-length are invalid. Treat them
1691 like a print-length of nil. */
1692 if (NATNUMP (Vprint_length
)
1693 && XFASTINT (Vprint_length
) < size_in_chars
)
1694 size_in_chars
= XFASTINT (Vprint_length
);
1696 for (i
= 0; i
< size_in_chars
; i
++)
1699 c
= XBOOL_VECTOR (obj
)->data
[i
];
1700 if (c
== '\n' && print_escape_newlines
)
1705 else if (c
== '\f' && print_escape_newlines
)
1712 if (c
== '\"' || c
== '\\')
1721 else if (SUBRP (obj
))
1723 strout ("#<subr ", -1, -1, printcharfun
, 0);
1724 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1727 else if (WINDOWP (obj
))
1729 strout ("#<window ", -1, -1, printcharfun
, 0);
1730 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1731 strout (buf
, -1, -1, printcharfun
, 0);
1732 if (!NILP (XWINDOW (obj
)->buffer
))
1734 strout (" on ", -1, -1, printcharfun
, 0);
1735 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1739 else if (HASH_TABLE_P (obj
))
1741 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1742 strout ("#<hash-table", -1, -1, printcharfun
, 0);
1743 if (SYMBOLP (h
->test
))
1747 strout (XSYMBOL (h
->test
)->name
->data
, -1, -1, printcharfun
, 0);
1749 strout (XSYMBOL (h
->weak
)->name
->data
, -1, -1, printcharfun
, 0);
1751 sprintf (buf
, "%d/%d", XFASTINT (h
->count
),
1752 XVECTOR (h
->next
)->size
);
1753 strout (buf
, -1, -1, printcharfun
, 0);
1755 sprintf (buf
, " 0x%lx", (unsigned long) h
);
1756 strout (buf
, -1, -1, printcharfun
, 0);
1759 else if (BUFFERP (obj
))
1761 if (NILP (XBUFFER (obj
)->name
))
1762 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1763 else if (escapeflag
)
1765 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1766 print_string (XBUFFER (obj
)->name
, printcharfun
);
1770 print_string (XBUFFER (obj
)->name
, printcharfun
);
1772 else if (WINDOW_CONFIGURATIONP (obj
))
1774 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1776 else if (FRAMEP (obj
))
1778 strout ((FRAME_LIVE_P (XFRAME (obj
))
1779 ? "#<frame " : "#<dead frame "),
1780 -1, -1, printcharfun
, 0);
1781 print_string (XFRAME (obj
)->name
, printcharfun
);
1782 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
1783 strout (buf
, -1, -1, printcharfun
, 0);
1788 int size
= XVECTOR (obj
)->size
;
1789 if (COMPILEDP (obj
))
1792 size
&= PSEUDOVECTOR_SIZE_MASK
;
1794 if (CHAR_TABLE_P (obj
))
1796 /* We print a char-table as if it were a vector,
1797 lumping the parent and default slots in with the
1798 character slots. But we add #^ as a prefix. */
1801 if (SUB_CHAR_TABLE_P (obj
))
1803 size
&= PSEUDOVECTOR_SIZE_MASK
;
1805 if (size
& PSEUDOVECTOR_FLAG
)
1811 register Lisp_Object tem
;
1812 int real_size
= size
;
1814 /* Don't print more elements than the specified maximum. */
1815 if (NATNUMP (Vprint_length
)
1816 && XFASTINT (Vprint_length
) < size
)
1817 size
= XFASTINT (Vprint_length
);
1819 for (i
= 0; i
< size
; i
++)
1821 if (i
) PRINTCHAR (' ');
1822 tem
= XVECTOR (obj
)->contents
[i
];
1823 print_object (tem
, printcharfun
, escapeflag
);
1825 if (size
< real_size
)
1826 strout (" ...", 4, 4, printcharfun
, 0);
1833 switch (XMISCTYPE (obj
))
1835 case Lisp_Misc_Marker
:
1836 strout ("#<marker ", -1, -1, printcharfun
, 0);
1837 /* Do you think this is necessary? */
1838 if (XMARKER (obj
)->insertion_type
!= 0)
1839 strout ("(moves after insertion) ", -1, -1, printcharfun
, 0);
1840 if (!(XMARKER (obj
)->buffer
))
1841 strout ("in no buffer", -1, -1, printcharfun
, 0);
1844 sprintf (buf
, "at %d", marker_position (obj
));
1845 strout (buf
, -1, -1, printcharfun
, 0);
1846 strout (" in ", -1, -1, printcharfun
, 0);
1847 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1852 case Lisp_Misc_Overlay
:
1853 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1854 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1855 strout ("in no buffer", -1, -1, printcharfun
, 0);
1858 sprintf (buf
, "from %d to %d in ",
1859 marker_position (OVERLAY_START (obj
)),
1860 marker_position (OVERLAY_END (obj
)));
1861 strout (buf
, -1, -1, printcharfun
, 0);
1862 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1868 /* Remaining cases shouldn't happen in normal usage, but let's print
1869 them anyway for the benefit of the debugger. */
1870 case Lisp_Misc_Free
:
1871 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1874 case Lisp_Misc_Intfwd
:
1875 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1876 strout (buf
, -1, -1, printcharfun
, 0);
1879 case Lisp_Misc_Boolfwd
:
1880 sprintf (buf
, "#<boolfwd to %s>",
1881 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1882 strout (buf
, -1, -1, printcharfun
, 0);
1885 case Lisp_Misc_Objfwd
:
1886 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
1887 print_object (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1891 case Lisp_Misc_Buffer_Objfwd
:
1892 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
1893 print_object (PER_BUFFER_VALUE (current_buffer
,
1894 XBUFFER_OBJFWD (obj
)->offset
),
1895 printcharfun
, escapeflag
);
1899 case Lisp_Misc_Kboard_Objfwd
:
1900 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
1901 print_object (*(Lisp_Object
*)((char *) current_kboard
1902 + XKBOARD_OBJFWD (obj
)->offset
),
1903 printcharfun
, escapeflag
);
1907 case Lisp_Misc_Buffer_Local_Value
:
1908 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
1909 goto do_buffer_local
;
1910 case Lisp_Misc_Some_Buffer_Local_Value
:
1911 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
1913 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
1914 print_object (XBUFFER_LOCAL_VALUE (obj
)->realvalue
,
1915 printcharfun
, escapeflag
);
1916 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
1917 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
1919 strout ("[buffer] ", -1, -1, printcharfun
, 0);
1920 print_object (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
1921 printcharfun
, escapeflag
);
1922 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
1924 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
1925 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
1927 strout ("[frame] ", -1, -1, printcharfun
, 0);
1928 print_object (XBUFFER_LOCAL_VALUE (obj
)->frame
,
1929 printcharfun
, escapeflag
);
1931 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
1932 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
1933 printcharfun
, escapeflag
);
1934 strout ("[default-value] ", -1, -1, printcharfun
, 0);
1935 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
1936 printcharfun
, escapeflag
);
1948 /* We're in trouble if this happens!
1949 Probably should just abort () */
1950 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
1952 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1953 else if (VECTORLIKEP (obj
))
1954 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1956 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1957 strout (buf
, -1, -1, printcharfun
, 0);
1958 strout (" Save your buffers immediately and please report this bug>",
1959 -1, -1, printcharfun
, 0);
1967 /* Print a description of INTERVAL using PRINTCHARFUN.
1968 This is part of printing a string that has text properties. */
1971 print_interval (interval
, printcharfun
)
1973 Lisp_Object printcharfun
;
1976 print_object (make_number (interval
->position
), printcharfun
, 1);
1978 print_object (make_number (interval
->position
+ LENGTH (interval
)),
1981 print_object (interval
->plist
, printcharfun
, 1);
1988 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
1989 staticpro (&Qtemp_buffer_setup_hook
);
1991 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1992 doc
: /* Output stream `print' uses by default for outputting a character.
1993 This may be any function of one argument.
1994 It may also be a buffer (output is inserted before point)
1995 or a marker (output is inserted and the marker is advanced)
1996 or the symbol t (output appears in the echo area). */);
1997 Vstandard_output
= Qt
;
1998 Qstandard_output
= intern ("standard-output");
1999 staticpro (&Qstandard_output
);
2001 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
2002 doc
: /* The format descriptor string used to print floats.
2003 This is a %-spec like those accepted by `printf' in C,
2004 but with some restrictions. It must start with the two characters `%.'.
2005 After that comes an integer precision specification,
2006 and then a letter which controls the format.
2007 The letters allowed are `e', `f' and `g'.
2008 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2009 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2010 Use `g' to choose the shorter of those two formats for the number at hand.
2011 The precision in any of these cases is the number of digits following
2012 the decimal point. With `f', a precision of 0 means to omit the
2013 decimal point. 0 is not allowed with `e' or `g'.
2015 A value of nil means to use the shortest notation
2016 that represents the number without losing information. */);
2017 Vfloat_output_format
= Qnil
;
2018 Qfloat_output_format
= intern ("float-output-format");
2019 staticpro (&Qfloat_output_format
);
2021 DEFVAR_LISP ("print-length", &Vprint_length
,
2022 doc
: /* Maximum length of list to print before abbreviating.
2023 A value of nil means no limit. See also `eval-expression-print-length'. */);
2024 Vprint_length
= Qnil
;
2026 DEFVAR_LISP ("print-level", &Vprint_level
,
2027 doc
: /* Maximum depth of list nesting to print before abbreviating.
2028 A value of nil means no limit. See also `eval-expression-print-level'. */);
2029 Vprint_level
= Qnil
;
2031 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
2032 doc
: /* Non-nil means print newlines in strings as `\\n'.
2033 Also print formfeeds as `\\f'. */);
2034 print_escape_newlines
= 0;
2036 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
2037 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2038 \(OOO is the octal representation of the character code.)
2039 Only single-byte characters are affected, and only in `prin1'. */);
2040 print_escape_nonascii
= 0;
2042 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
2043 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2044 \(XXXX is the hex representation of the character code.)
2045 This affects only `prin1'. */);
2046 print_escape_multibyte
= 0;
2048 DEFVAR_BOOL ("print-quoted", &print_quoted
,
2049 doc
: /* Non-nil means print quoted forms with reader syntax.
2050 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2051 forms print as in the new syntax. */);
2054 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
2055 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2056 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2057 When the uninterned symbol appears within a recursive data structure,
2058 and the symbol appears more than once, in addition use the #N# and #N=
2059 constructs as needed, so that multiple references to the same symbol are
2060 shared once again when the text is read back. */);
2061 Vprint_gensym
= Qnil
;
2063 DEFVAR_LISP ("print-circle", &Vprint_circle
,
2064 doc
: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2065 If nil, printing proceeds recursively and may lead to
2066 `max-lisp-eval-depth' being exceeded or an error may occur:
2067 \"Apparently circular structure being printed.\" Also see
2068 `print-length' and `print-level'.
2069 If non-nil, shared substructures anywhere in the structure are printed
2070 with `#N=' before the first occurrence (in the order of the print
2071 representation) and `#N#' in place of each subsequent occurrence,
2072 where N is a positive decimal integer. */);
2073 Vprint_circle
= Qnil
;
2075 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
2076 doc
: /* *Non-nil means number continuously across print calls.
2077 This affects the numbers printed for #N= labels and #M# references.
2078 See also `print-circle', `print-gensym', and `print-number-table'.
2079 This variable should not be set with `setq'; bind it with a `let' instead. */);
2080 Vprint_continuous_numbering
= Qnil
;
2082 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
2083 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2084 The Lisp printer uses this vector to detect Lisp objects referenced more
2085 than once. When `print-continuous-numbering' is bound to t, you should
2086 probably also bind `print-number-table' to nil. This ensures that the
2087 value of `print-number-table' can be garbage-collected once the printing
2089 Vprint_number_table
= Qnil
;
2091 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2092 staticpro (&Vprin1_to_string_buffer
);
2095 defsubr (&Sprin1_to_string
);
2096 defsubr (&Serror_message_string
);
2100 defsubr (&Swrite_char
);
2101 defsubr (&Sexternal_debugging_output
);
2103 Qexternal_debugging_output
= intern ("external-debugging-output");
2104 staticpro (&Qexternal_debugging_output
);
2106 Qprint_escape_newlines
= intern ("print-escape-newlines");
2107 staticpro (&Qprint_escape_newlines
);
2109 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
2110 staticpro (&Qprint_escape_multibyte
);
2112 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
2113 staticpro (&Qprint_escape_nonascii
);
2115 defsubr (&Swith_output_to_temp_buffer
);