1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 01, 2003
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. */
27 #include "character.h"
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 /* Nonzero if inside outputting backquote in old style. */
95 int old_backquote_output
;
97 /* Detect most circularities to print finite output. */
98 #define PRINT_CIRCLE 200
99 Lisp_Object being_printed
[PRINT_CIRCLE
];
101 /* When printing into a buffer, first we put the text in this
102 block, then insert it all at once. */
105 /* Size allocated in print_buffer. */
106 int print_buffer_size
;
107 /* Chars stored in print_buffer. */
108 int print_buffer_pos
;
109 /* Bytes stored in print_buffer. */
110 int print_buffer_pos_byte
;
112 /* Maximum length of list to print in full; noninteger means
113 effectively infinity */
115 Lisp_Object Vprint_length
;
117 /* Maximum depth of list to print in full; noninteger means
118 effectively infinity. */
120 Lisp_Object Vprint_level
;
122 /* Nonzero means print newlines in strings as \n. */
124 int print_escape_newlines
;
126 /* Nonzero means to print single-byte non-ascii characters in strings as
129 int print_escape_nonascii
;
131 /* Nonzero means to print multibyte characters in strings as hex escapes. */
133 int print_escape_multibyte
;
135 Lisp_Object Qprint_escape_newlines
;
136 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
138 /* Nonzero means print (quote foo) forms as 'foo, etc. */
142 /* Non-nil means print #: before uninterned symbols. */
144 Lisp_Object Vprint_gensym
;
146 /* Non-nil means print recursive structures using #n= and #n# syntax. */
148 Lisp_Object Vprint_circle
;
150 /* Non-nil means keep continuous number for #n= and #n# syntax
151 between several print functions. */
153 Lisp_Object Vprint_continuous_numbering
;
155 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
156 where OBJn are objects going to be printed, and STATn are their status,
157 which may be different meanings during process. See the comments of
158 the functions print and print_preprocess for details.
159 print_number_index keeps the last position the next object should be added,
160 twice of which is the actual vector position in Vprint_number_table. */
161 int print_number_index
;
162 Lisp_Object Vprint_number_table
;
164 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
165 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
166 See the comment of the variable Vprint_number_table. */
167 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
168 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
170 /* Nonzero means print newline to stdout before next minibuffer message.
171 Defined in xdisp.c */
173 extern int noninteractive_need_newline
;
175 extern int minibuffer_auto_raise
;
177 #ifdef MAX_PRINT_CHARS
178 static int print_chars
;
179 static int max_print
;
180 #endif /* MAX_PRINT_CHARS */
182 void print_interval ();
185 /* Low level output routines for characters and strings */
187 /* Lisp functions to do output using a stream
188 must have the stream in a variable called printcharfun
189 and must start with PRINTPREPARE, end with PRINTFINISH,
190 and use PRINTDECLARE to declare common variables.
191 Use PRINTCHAR to output one character,
192 or call strout to output a block of characters. */
194 #define PRINTDECLARE \
195 struct buffer *old = current_buffer; \
196 int old_point = -1, start_point = -1; \
197 int old_point_byte = -1, start_point_byte = -1; \
198 int specpdl_count = SPECPDL_INDEX (); \
199 int free_print_buffer = 0; \
200 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
203 #define PRINTPREPARE \
204 original = printcharfun; \
205 if (NILP (printcharfun)) printcharfun = Qt; \
206 if (BUFFERP (printcharfun)) \
208 if (XBUFFER (printcharfun) != current_buffer) \
209 Fset_buffer (printcharfun); \
210 printcharfun = Qnil; \
212 if (MARKERP (printcharfun)) \
214 if (!(XMARKER (original)->buffer)) \
215 error ("Marker does not point anywhere"); \
216 if (XMARKER (original)->buffer != current_buffer) \
217 set_buffer_internal (XMARKER (original)->buffer); \
219 old_point_byte = PT_BYTE; \
220 SET_PT_BOTH (marker_position (printcharfun), \
221 marker_byte_position (printcharfun)); \
223 start_point_byte = PT_BYTE; \
224 printcharfun = Qnil; \
226 if (NILP (printcharfun)) \
228 Lisp_Object string; \
229 if (NILP (current_buffer->enable_multibyte_characters) \
230 && ! print_escape_multibyte) \
231 specbind (Qprint_escape_multibyte, Qt); \
232 if (! NILP (current_buffer->enable_multibyte_characters) \
233 && ! print_escape_nonascii) \
234 specbind (Qprint_escape_nonascii, Qt); \
235 if (print_buffer != 0) \
237 string = make_string_from_bytes (print_buffer, \
239 print_buffer_pos_byte); \
240 record_unwind_protect (print_unwind, string); \
244 print_buffer_size = 1000; \
245 print_buffer = (char *) xmalloc (print_buffer_size); \
246 free_print_buffer = 1; \
248 print_buffer_pos = 0; \
249 print_buffer_pos_byte = 0; \
251 if (EQ (printcharfun, Qt) && ! noninteractive) \
252 setup_echo_area_for_printing (multibyte);
254 #define PRINTFINISH \
255 if (NILP (printcharfun)) \
257 if (print_buffer_pos != print_buffer_pos_byte \
258 && NILP (current_buffer->enable_multibyte_characters)) \
260 unsigned char *temp \
261 = (unsigned char *) alloca (print_buffer_pos + 1); \
262 copy_text (print_buffer, temp, print_buffer_pos_byte, \
264 insert_1_both (temp, print_buffer_pos, \
265 print_buffer_pos, 0, 1, 0); \
268 insert_1_both (print_buffer, print_buffer_pos, \
269 print_buffer_pos_byte, 0, 1, 0); \
271 if (free_print_buffer) \
273 xfree (print_buffer); \
276 unbind_to (specpdl_count, Qnil); \
277 if (MARKERP (original)) \
278 set_marker_both (original, Qnil, PT, PT_BYTE); \
279 if (old_point >= 0) \
280 SET_PT_BOTH (old_point + (old_point >= start_point \
281 ? PT - start_point : 0), \
282 old_point_byte + (old_point_byte >= start_point_byte \
283 ? PT_BYTE - start_point_byte : 0)); \
284 if (old != current_buffer) \
285 set_buffer_internal (old);
287 #define PRINTCHAR(ch) printchar (ch, printcharfun)
289 /* This is used to restore the saved contents of print_buffer
290 when there is a recursive call to print. */
293 print_unwind (saved_text
)
294 Lisp_Object saved_text
;
296 bcopy (SDATA (saved_text
), print_buffer
, SCHARS (saved_text
));
301 /* Print character CH using method FUN. FUN nil means print to
302 print_buffer. FUN t means print to echo area or stdout if
303 non-interactive. If FUN is neither nil nor t, call FUN with CH as
311 #ifdef MAX_PRINT_CHARS
314 #endif /* MAX_PRINT_CHARS */
316 if (!NILP (fun
) && !EQ (fun
, Qt
))
317 call1 (fun
, make_number (ch
));
320 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
321 int len
= CHAR_STRING (ch
, str
);
327 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
328 print_buffer
= (char *) xrealloc (print_buffer
,
329 print_buffer_size
*= 2);
330 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
331 print_buffer_pos
+= 1;
332 print_buffer_pos_byte
+= len
;
334 else if (noninteractive
)
336 fwrite (str
, 1, len
, stdout
);
337 noninteractive_need_newline
= 1;
342 = !NILP (current_buffer
->enable_multibyte_characters
);
344 setup_echo_area_for_printing (multibyte_p
);
346 message_dolog (str
, len
, 0, multibyte_p
);
352 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
353 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
354 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
355 print_buffer. PRINTCHARFUN t means output to the echo area or to
356 stdout if non-interactive. If neither nil nor t, call Lisp
357 function PRINTCHARFUN for each character printed. MULTIBYTE
358 non-zero means PTR contains multibyte characters. */
361 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
364 Lisp_Object printcharfun
;
368 size_byte
= size
= strlen (ptr
);
370 if (NILP (printcharfun
))
372 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
374 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
375 print_buffer
= (char *) xrealloc (print_buffer
,
378 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
379 print_buffer_pos
+= size
;
380 print_buffer_pos_byte
+= size_byte
;
382 #ifdef MAX_PRINT_CHARS
385 #endif /* MAX_PRINT_CHARS */
387 else if (noninteractive
&& EQ (printcharfun
, Qt
))
389 fwrite (ptr
, 1, size_byte
, stdout
);
390 noninteractive_need_newline
= 1;
392 else if (EQ (printcharfun
, Qt
))
394 /* Output to echo area. We're trying to avoid a little overhead
395 here, that's the reason we don't call printchar to do the
399 = !NILP (current_buffer
->enable_multibyte_characters
);
401 setup_echo_area_for_printing (multibyte_p
);
402 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
404 if (size
== size_byte
)
406 for (i
= 0; i
< size
; ++i
)
407 insert_char ((unsigned char )*ptr
++);
412 for (i
= 0; i
< size_byte
; i
+= len
)
414 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
419 #ifdef MAX_PRINT_CHARS
422 #endif /* MAX_PRINT_CHARS */
426 /* PRINTCHARFUN is a Lisp function. */
429 if (size
== size_byte
)
431 while (i
< size_byte
)
439 while (i
< size_byte
)
441 /* Here, we must convert each multi-byte form to the
442 corresponding character code before handing it to
445 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
453 /* Print the contents of a string STRING using PRINTCHARFUN.
454 It isn't safe to use strout in many cases,
455 because printing one char can relocate. */
458 print_string (string
, printcharfun
)
460 Lisp_Object printcharfun
;
462 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
466 if (print_escape_nonascii
)
467 string
= string_escape_byte8 (string
);
469 if (STRING_MULTIBYTE (string
))
470 chars
= SCHARS (string
);
471 else if (! print_escape_nonascii
472 && (EQ (printcharfun
, Qt
)
473 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
474 : ! NILP (current_buffer
->enable_multibyte_characters
)))
476 /* If unibyte string STRING contains 8-bit codes, we must
477 convert STRING to a multibyte string containing the same
482 chars
= SBYTES (string
);
483 bytes
= parse_str_to_multibyte (SDATA (string
), chars
);
486 newstr
= make_uninit_multibyte_string (chars
, bytes
);
487 bcopy (SDATA (string
), SDATA (newstr
), chars
);
488 str_to_multibyte (SDATA (newstr
), bytes
, chars
);
493 chars
= SBYTES (string
);
495 /* strout is safe for output to a frame (echo area) or to print_buffer. */
496 strout (SDATA (string
),
497 chars
, SBYTES (string
),
498 printcharfun
, STRING_MULTIBYTE (string
));
502 /* Otherwise, string may be relocated by printing one char.
503 So re-fetch the string address for each character. */
505 int size
= SCHARS (string
);
506 int size_byte
= SBYTES (string
);
509 if (size
== size_byte
)
510 for (i
= 0; i
< size
; i
++)
511 PRINTCHAR (SREF (string
, i
));
513 for (i
= 0; i
< size_byte
; i
++)
515 /* Here, we must convert each multi-byte form to the
516 corresponding character code before handing it to PRINTCHAR. */
518 int ch
= STRING_CHAR_AND_LENGTH (SDATA (string
) + i
,
527 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
528 doc
: /* Output character CHARACTER to stream PRINTCHARFUN.
529 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
530 (character
, printcharfun
)
531 Lisp_Object character
, printcharfun
;
535 if (NILP (printcharfun
))
536 printcharfun
= Vstandard_output
;
537 CHECK_NUMBER (character
);
539 PRINTCHAR (XINT (character
));
544 /* Used from outside of print.c to print a block of SIZE
545 single-byte chars at DATA on the default output stream.
546 Do not use this on the contents of a Lisp string. */
549 write_string (data
, size
)
554 Lisp_Object printcharfun
;
556 printcharfun
= Vstandard_output
;
559 strout (data
, size
, size
, printcharfun
, 0);
563 /* Used from outside of print.c to print a block of SIZE
564 single-byte chars at DATA on a specified stream PRINTCHARFUN.
565 Do not use this on the contents of a Lisp string. */
568 write_string_1 (data
, size
, printcharfun
)
571 Lisp_Object printcharfun
;
576 strout (data
, size
, size
, printcharfun
, 0);
582 temp_output_buffer_setup (bufname
)
585 int count
= SPECPDL_INDEX ();
586 register struct buffer
*old
= current_buffer
;
587 register Lisp_Object buf
;
589 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
591 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
593 Fkill_all_local_variables ();
594 delete_all_overlays (current_buffer
);
595 current_buffer
->directory
= old
->directory
;
596 current_buffer
->read_only
= Qnil
;
597 current_buffer
->filename
= Qnil
;
598 current_buffer
->undo_list
= Qt
;
599 eassert (current_buffer
->overlays_before
== NULL
);
600 eassert (current_buffer
->overlays_after
== NULL
);
601 current_buffer
->enable_multibyte_characters
602 = buffer_defaults
.enable_multibyte_characters
;
604 XSETBUFFER (buf
, current_buffer
);
606 Frun_hooks (1, &Qtemp_buffer_setup_hook
);
608 unbind_to (count
, Qnil
);
610 specbind (Qstandard_output
, buf
);
614 internal_with_output_to_temp_buffer (bufname
, function
, args
)
616 Lisp_Object (*function
) P_ ((Lisp_Object
));
619 int count
= SPECPDL_INDEX ();
620 Lisp_Object buf
, val
;
624 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
625 temp_output_buffer_setup (bufname
);
626 buf
= Vstandard_output
;
629 val
= (*function
) (args
);
632 temp_output_buffer_show (buf
);
635 return unbind_to (count
, val
);
638 DEFUN ("with-output-to-temp-buffer",
639 Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
641 doc
: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
642 The buffer is cleared out initially, and marked as unmodified when done.
643 All output done by BODY is inserted in that buffer by default.
644 The buffer is displayed in another window, but not selected.
645 The value of the last form in BODY is returned.
646 If BODY does not finish normally, the buffer BUFNAME is not displayed.
648 The hook `temp-buffer-setup-hook' is run before BODY,
649 with the buffer BUFNAME temporarily current.
650 The hook `temp-buffer-show-hook' is run after the buffer is displayed,
651 with the buffer temporarily current, and the window that was used
652 to display it temporarily selected.
654 If variable `temp-buffer-show-function' is non-nil, call it at the end
655 to get the buffer displayed instead of just displaying the non-selected
656 buffer and calling the hook. It gets one argument, the buffer to display.
658 usage: (with-output-to-temp-buffer BUFFNAME BODY ...) */)
664 int count
= SPECPDL_INDEX ();
665 Lisp_Object buf
, val
;
668 name
= Feval (Fcar (args
));
670 temp_output_buffer_setup (SDATA (name
));
671 buf
= Vstandard_output
;
674 val
= Fprogn (XCDR (args
));
677 temp_output_buffer_show (buf
);
680 return unbind_to (count
, val
);
684 static void print ();
685 static void print_preprocess ();
686 static void print_preprocess_string ();
687 static void print_object ();
689 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
690 doc
: /* Output a newline to stream PRINTCHARFUN.
691 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
693 Lisp_Object printcharfun
;
697 if (NILP (printcharfun
))
698 printcharfun
= Vstandard_output
;
705 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
706 doc
: /* Output the printed representation of OBJECT, any Lisp object.
707 Quoting characters are printed when needed to make output that `read'
708 can handle, whenever this is possible. For complex objects, the behavior
709 is controlled by `print-level' and `print-length', which see.
711 OBJECT is any of the Lisp data types: a number, a string, a symbol,
712 a list, a buffer, a window, a frame, etc.
714 A printed representation of an object is text which describes that object.
716 Optional argument PRINTCHARFUN is the output stream, which can be one
719 - a buffer, in which case output is inserted into that buffer at point;
720 - a marker, in which case output is inserted at marker's position;
721 - a function, in which case that function is called once for each
722 character of OBJECT's printed representation;
723 - a symbol, in which case that symbol's function definition is called; or
724 - t, in which case the output is displayed in the echo area.
726 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
728 (object
, printcharfun
)
729 Lisp_Object object
, printcharfun
;
733 #ifdef MAX_PRINT_CHARS
735 #endif /* MAX_PRINT_CHARS */
736 if (NILP (printcharfun
))
737 printcharfun
= Vstandard_output
;
739 print (object
, printcharfun
, 1);
744 /* a buffer which is used to hold output being built by prin1-to-string */
745 Lisp_Object Vprin1_to_string_buffer
;
747 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
748 doc
: /* Return a string containing the printed representation of OBJECT.
749 OBJECT can be any Lisp object. This function outputs quoting characters
750 when necessary to make output that `read' can handle, whenever possible,
751 unless the optional second argument NOESCAPE is non-nil.
753 OBJECT is any of the Lisp data types: a number, a string, a symbol,
754 a list, a buffer, a window, a frame, etc.
756 A printed representation of an object is text which describes that object. */)
758 Lisp_Object object
, noescape
;
761 Lisp_Object printcharfun
;
762 /* struct gcpro gcpro1, gcpro2; */
763 Lisp_Object save_deactivate_mark
;
764 int count
= specpdl_ptr
- specpdl
;
766 specbind (Qinhibit_modification_hooks
, Qt
);
768 /* Save and restore this--we are altering a buffer
769 but we don't want to deactivate the mark just for that.
770 No need for specbind, since errors deactivate the mark. */
771 save_deactivate_mark
= Vdeactivate_mark
;
772 /* GCPRO2 (object, save_deactivate_mark); */
775 printcharfun
= Vprin1_to_string_buffer
;
777 print (object
, printcharfun
, NILP (noescape
));
778 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
780 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
781 object
= Fbuffer_string ();
782 if (SBYTES (object
) == SCHARS (object
))
783 STRING_SET_UNIBYTE (object
);
786 set_buffer_internal (old
);
788 Vdeactivate_mark
= save_deactivate_mark
;
792 return unbind_to (count
, object
);
795 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
796 doc
: /* Output the printed representation of OBJECT, any Lisp object.
797 No quoting characters are used; no delimiters are printed around
798 the contents of strings.
800 OBJECT is any of the Lisp data types: a number, a string, a symbol,
801 a list, a buffer, a window, a frame, etc.
803 A printed representation of an object is text which describes that object.
805 Optional argument PRINTCHARFUN is the output stream, which can be one
808 - a buffer, in which case output is inserted into that buffer at point;
809 - a marker, in which case output is inserted at marker's position;
810 - a function, in which case that function is called once for each
811 character of OBJECT's printed representation;
812 - a symbol, in which case that symbol's function definition is called; or
813 - t, in which case the output is displayed in the echo area.
815 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
817 (object
, printcharfun
)
818 Lisp_Object object
, printcharfun
;
822 if (NILP (printcharfun
))
823 printcharfun
= Vstandard_output
;
825 print (object
, printcharfun
, 0);
830 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
831 doc
: /* Output the printed representation of OBJECT, with newlines around it.
832 Quoting characters are printed when needed to make output that `read'
833 can handle, whenever this is possible. For complex objects, the behavior
834 is controlled by `print-level' and `print-length', which see.
836 OBJECT is any of the Lisp data types: a number, a string, a symbol,
837 a list, a buffer, a window, a frame, etc.
839 A printed representation of an object is text which describes that object.
841 Optional argument PRINTCHARFUN is the output stream, which can be one
844 - a buffer, in which case output is inserted into that buffer at point;
845 - a marker, in which case output is inserted at marker's position;
846 - a function, in which case that function is called once for each
847 character of OBJECT's printed representation;
848 - a symbol, in which case that symbol's function definition is called; or
849 - t, in which case the output is displayed in the echo area.
851 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
853 (object
, printcharfun
)
854 Lisp_Object object
, printcharfun
;
859 #ifdef MAX_PRINT_CHARS
861 max_print
= MAX_PRINT_CHARS
;
862 #endif /* MAX_PRINT_CHARS */
863 if (NILP (printcharfun
))
864 printcharfun
= Vstandard_output
;
868 print (object
, printcharfun
, 1);
871 #ifdef MAX_PRINT_CHARS
874 #endif /* MAX_PRINT_CHARS */
879 /* The subroutine object for external-debugging-output is kept here
880 for the convenience of the debugger. */
881 Lisp_Object Qexternal_debugging_output
;
883 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
884 doc
: /* Write CHARACTER to stderr.
885 You can call print while debugging emacs, and pass it this function
886 to make it write to the debugging output. */)
888 Lisp_Object character
;
890 CHECK_NUMBER (character
);
891 putc (XINT (character
), stderr
);
894 /* Send the output to a debugger (nothing happens if there isn't one). */
896 char buf
[2] = {(char) XINT (character
), '\0'};
897 OutputDebugString (buf
);
904 /* This is the interface for debugging printing. */
910 Fprin1 (arg
, Qexternal_debugging_output
);
911 fprintf (stderr
, "\r\n");
914 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
916 doc
: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message. */)
920 struct buffer
*old
= current_buffer
;
924 /* If OBJ is (error STRING), just return STRING.
925 That is not only faster, it also avoids the need to allocate
926 space here when the error is due to memory full. */
927 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
928 && CONSP (XCDR (obj
))
929 && STRINGP (XCAR (XCDR (obj
)))
930 && NILP (XCDR (XCDR (obj
))))
931 return XCAR (XCDR (obj
));
933 print_error_message (obj
, Vprin1_to_string_buffer
, 0, Qnil
);
935 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
936 value
= Fbuffer_string ();
940 set_buffer_internal (old
);
946 /* Print an error message for the error DATA onto Lisp output stream
947 STREAM (suitable for the print functions). */
950 print_error_message (data
, stream
, context
, caller
)
951 Lisp_Object data
, stream
;
955 Lisp_Object errname
, errmsg
, file_error
, tail
;
960 write_string_1 (context
, -1, stream
);
962 /* If we know from where the error was signaled, show it in
964 if (!NILP (caller
) && SYMBOLP (caller
))
966 const char *name
= SDATA (SYMBOL_NAME (caller
));
967 message_dolog (name
, strlen (name
), 0, 0);
968 message_dolog (": ", 2, 0, 0);
971 errname
= Fcar (data
);
973 if (EQ (errname
, Qerror
))
978 errmsg
= Fcar (data
);
983 Lisp_Object error_conditions
;
984 errmsg
= Fget (errname
, Qerror_message
);
985 error_conditions
= Fget (errname
, Qerror_conditions
);
986 file_error
= Fmemq (Qfile_error
, error_conditions
);
989 /* Print an error message including the data items. */
991 tail
= Fcdr_safe (data
);
994 /* For file-error, make error message by concatenating
995 all the data items. They are all strings. */
996 if (!NILP (file_error
) && CONSP (tail
))
997 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
999 if (STRINGP (errmsg
))
1000 Fprinc (errmsg
, stream
);
1002 write_string_1 ("peculiar error", -1, stream
);
1004 for (i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
1008 write_string_1 (i
? ", " : ": ", 2, stream
);
1010 if (!NILP (file_error
) || EQ (errname
, Qend_of_file
))
1011 Fprinc (obj
, stream
);
1013 Fprin1 (obj
, stream
);
1022 * The buffer should be at least as large as the max string size of the
1023 * largest float, printed in the biggest notation. This is undoubtedly
1024 * 20d float_output_format, with the negative of the C-constant "HUGE"
1027 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1029 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1030 * case of -1e307 in 20d float_output_format. What is one to do (short of
1031 * re-writing _doprnt to be more sane)?
1036 float_to_string (buf
, data
)
1043 /* Check for plus infinity in a way that won't lose
1044 if there is no plus infinity. */
1045 if (data
== data
/ 2 && data
> 1.0)
1047 strcpy (buf
, "1.0e+INF");
1050 /* Likewise for minus infinity. */
1051 if (data
== data
/ 2 && data
< -1.0)
1053 strcpy (buf
, "-1.0e+INF");
1056 /* Check for NaN in a way that won't fail if there are no NaNs. */
1057 if (! (data
* 0.0 >= 0.0))
1059 /* Prepend "-" if the NaN's sign bit is negative.
1060 The sign bit of a double is the bit that is 1 in -0.0. */
1062 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
1064 u_minus_zero
.d
= - 0.0;
1065 for (i
= 0; i
< sizeof (double); i
++)
1066 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1072 strcpy (buf
, "0.0e+NaN");
1076 if (NILP (Vfloat_output_format
)
1077 || !STRINGP (Vfloat_output_format
))
1080 /* Generate the fewest number of digits that represent the
1081 floating point value without losing information.
1082 The following method is simple but a bit slow.
1083 For ideas about speeding things up, please see:
1085 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1086 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1088 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1089 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1091 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1093 sprintf (buf
, "%.*g", width
, data
);
1094 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1096 else /* oink oink */
1098 /* Check that the spec we have is fully valid.
1099 This means not only valid for printf,
1100 but meant for floats, and reasonable. */
1101 cp
= SDATA (Vfloat_output_format
);
1110 /* Check the width specification. */
1112 if ('0' <= *cp
&& *cp
<= '9')
1116 width
= (width
* 10) + (*cp
++ - '0');
1117 while (*cp
>= '0' && *cp
<= '9');
1119 /* A precision of zero is valid only for %f. */
1121 || (width
== 0 && *cp
!= 'f'))
1125 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1131 sprintf (buf
, SDATA (Vfloat_output_format
), data
);
1134 /* Make sure there is a decimal point with digit after, or an
1135 exponent, so that the value is readable as a float. But don't do
1136 this with "%.0f"; it's valid for that not to produce a decimal
1137 point. Note that width can be 0 only for %.0f. */
1140 for (cp
= buf
; *cp
; cp
++)
1141 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1144 if (*cp
== '.' && cp
[1] == 0)
1161 print (obj
, printcharfun
, escapeflag
)
1163 register Lisp_Object printcharfun
;
1167 old_backquote_output
= 0;
1169 /* Reset print_number_index and Vprint_number_table only when
1170 the variable Vprint_continuous_numbering is nil. Otherwise,
1171 the values of these variables will be kept between several
1173 if (NILP (Vprint_continuous_numbering
))
1175 print_number_index
= 0;
1176 Vprint_number_table
= Qnil
;
1179 /* Construct Vprint_number_table for print-gensym and print-circle. */
1180 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1182 int i
, start
, index
;
1183 start
= index
= print_number_index
;
1184 /* Construct Vprint_number_table.
1185 This increments print_number_index for the objects added. */
1186 print_preprocess (obj
);
1188 /* Remove unnecessary objects, which appear only once in OBJ;
1189 that is, whose status is Qnil. Compactify the necessary objects. */
1190 for (i
= start
; i
< print_number_index
; i
++)
1191 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1193 PRINT_NUMBER_OBJECT (Vprint_number_table
, index
)
1194 = PRINT_NUMBER_OBJECT (Vprint_number_table
, i
);
1198 /* Clear out objects outside the active part of the table. */
1199 for (i
= index
; i
< print_number_index
; i
++)
1200 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
) = Qnil
;
1202 /* Reset the status field for the next print step. Now this
1203 field means whether the object has already been printed. */
1204 for (i
= start
; i
< print_number_index
; i
++)
1205 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qnil
;
1207 print_number_index
= index
;
1210 print_object (obj
, printcharfun
, escapeflag
);
1213 /* Construct Vprint_number_table according to the structure of OBJ.
1214 OBJ itself and all its elements will be added to Vprint_number_table
1215 recursively if it is a list, vector, compiled function, char-table,
1216 string (its text properties will be traced), or a symbol that has
1217 no obarray (this is for the print-gensym feature).
1218 The status fields of Vprint_number_table mean whether each object appears
1219 more than once in OBJ: Qnil at the first time, and Qt after that . */
1221 print_preprocess (obj
)
1227 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1228 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1229 || (! NILP (Vprint_gensym
)
1231 && !SYMBOL_INTERNED_P (obj
)))
1233 /* In case print-circle is nil and print-gensym is t,
1234 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1235 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1237 for (i
= 0; i
< print_number_index
; i
++)
1238 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1240 /* OBJ appears more than once. Let's remember that. */
1241 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1245 /* OBJ is not yet recorded. Let's add to the table. */
1246 if (print_number_index
== 0)
1248 /* Initialize the table. */
1249 Vprint_number_table
= Fmake_vector (make_number (40), Qnil
);
1251 else if (XVECTOR (Vprint_number_table
)->size
== print_number_index
* 2)
1253 /* Reallocate the table. */
1254 int i
= print_number_index
* 4;
1255 Lisp_Object old_table
= Vprint_number_table
;
1256 Vprint_number_table
= Fmake_vector (make_number (i
), Qnil
);
1257 for (i
= 0; i
< print_number_index
; i
++)
1259 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
)
1260 = PRINT_NUMBER_OBJECT (old_table
, i
);
1261 PRINT_NUMBER_STATUS (Vprint_number_table
, i
)
1262 = PRINT_NUMBER_STATUS (old_table
, i
);
1265 PRINT_NUMBER_OBJECT (Vprint_number_table
, print_number_index
) = obj
;
1266 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1267 always print the gensym with a number. This is a special for
1268 the lisp function byte-compile-output-docform. */
1269 if (!NILP (Vprint_continuous_numbering
)
1271 && !SYMBOL_INTERNED_P (obj
))
1272 PRINT_NUMBER_STATUS (Vprint_number_table
, print_number_index
) = Qt
;
1273 print_number_index
++;
1276 switch (XGCTYPE (obj
))
1279 /* A string may have text properties, which can be circular. */
1280 traverse_intervals_noorder (STRING_INTERVALS (obj
),
1281 print_preprocess_string
, Qnil
);
1285 print_preprocess (XCAR (obj
));
1289 case Lisp_Vectorlike
:
1290 size
= XVECTOR (obj
)->size
& PSEUDOVECTOR_SIZE_MASK
;
1291 for (i
= 0; i
< size
; i
++)
1292 print_preprocess (XVECTOR (obj
)->contents
[i
]);
1302 print_preprocess_string (interval
, arg
)
1306 print_preprocess (interval
->plist
);
1310 print_object (obj
, printcharfun
, escapeflag
)
1312 register Lisp_Object printcharfun
;
1319 /* Detect circularities and truncate them. */
1320 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1321 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1322 || (! NILP (Vprint_gensym
)
1324 && !SYMBOL_INTERNED_P (obj
)))
1326 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1328 /* Simple but incomplete way. */
1330 for (i
= 0; i
< print_depth
; i
++)
1331 if (EQ (obj
, being_printed
[i
]))
1333 sprintf (buf
, "#%d", i
);
1334 strout (buf
, -1, -1, printcharfun
, 0);
1337 being_printed
[print_depth
] = obj
;
1341 /* With the print-circle feature. */
1343 for (i
= 0; i
< print_number_index
; i
++)
1344 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1346 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1348 /* Add a prefix #n= if OBJ has not yet been printed;
1349 that is, its status field is nil. */
1350 sprintf (buf
, "#%d=", i
+ 1);
1351 strout (buf
, -1, -1, printcharfun
, 0);
1352 /* OBJ is going to be printed. Set the status to t. */
1353 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1358 /* Just print #n# if OBJ has already been printed. */
1359 sprintf (buf
, "#%d#", i
+ 1);
1360 strout (buf
, -1, -1, printcharfun
, 0);
1369 if (print_depth
> PRINT_CIRCLE
)
1370 error ("Apparently circular structure being printed");
1371 #ifdef MAX_PRINT_CHARS
1372 if (max_print
&& print_chars
> max_print
)
1377 #endif /* MAX_PRINT_CHARS */
1379 switch (XGCTYPE (obj
))
1382 if (sizeof (int) == sizeof (EMACS_INT
))
1383 sprintf (buf
, "%d", XINT (obj
));
1384 else if (sizeof (long) == sizeof (EMACS_INT
))
1385 sprintf (buf
, "%ld", (long) XINT (obj
));
1388 strout (buf
, -1, -1, printcharfun
, 0);
1393 char pigbuf
[350]; /* see comments in float_to_string */
1395 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1396 strout (pigbuf
, -1, -1, printcharfun
, 0);
1402 print_string (obj
, printcharfun
);
1405 register int i
, i_byte
;
1406 struct gcpro gcpro1
;
1409 /* 1 means we must ensure that the next character we output
1410 cannot be taken as part of a hex character escape. */
1411 int need_nonhex
= 0;
1412 int multibyte
= STRING_MULTIBYTE (obj
);
1416 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1424 size_byte
= SBYTES (obj
);
1426 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1428 /* Here, we must convert each multi-byte form to the
1429 corresponding character code before handing it to PRINTCHAR. */
1435 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
,
1436 size_byte
- i_byte
, len
);
1444 if (c
== '\n' && print_escape_newlines
)
1449 else if (c
== '\f' && print_escape_newlines
)
1455 && (CHAR_BYTE8_P (c
) || print_escape_multibyte
))
1457 /* When multibyte is disabled,
1458 print multibyte string chars using hex escapes.
1459 For a char code that could be in a unibyte string,
1460 when found in a multibyte string, always use a hex escape
1461 so it reads back as multibyte. */
1462 unsigned char outbuf
[50];
1464 if (CHAR_BYTE8_P (c
))
1465 sprintf (outbuf
, "\\%03o", CHAR_TO_BYTE8 (c
));
1468 sprintf (outbuf
, "\\x%04x", c
);
1471 strout (outbuf
, -1, -1, printcharfun
, 0);
1473 else if (! multibyte
1474 && SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1475 && print_escape_nonascii
)
1477 /* When printing in a multibyte buffer
1478 or when explicitly requested,
1479 print single-byte non-ASCII string chars
1480 using octal escapes. */
1481 unsigned char outbuf
[5];
1482 sprintf (outbuf
, "\\%03o", c
);
1483 strout (outbuf
, -1, -1, printcharfun
, 0);
1487 /* If we just had a hex escape, and this character
1488 could be taken as part of it,
1489 output `\ ' to prevent that. */
1493 if ((c
>= 'a' && c
<= 'f')
1494 || (c
>= 'A' && c
<= 'F')
1495 || (c
>= '0' && c
<= '9'))
1496 strout ("\\ ", -1, -1, printcharfun
, 0);
1499 if (c
== '\"' || c
== '\\')
1506 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1508 traverse_intervals (STRING_INTERVALS (obj
),
1509 0, print_interval
, printcharfun
);
1519 register int confusing
;
1520 register unsigned char *p
= SDATA (SYMBOL_NAME (obj
));
1521 register unsigned char *end
= p
+ SBYTES (SYMBOL_NAME (obj
));
1523 int i
, i_byte
, size_byte
;
1526 name
= SYMBOL_NAME (obj
);
1528 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1531 /* If symbol name begins with a digit, and ends with a digit,
1532 and contains nothing but digits and `e', it could be treated
1533 as a number. So set CONFUSING.
1535 Symbols that contain periods could also be taken as numbers,
1536 but periods are always escaped, so we don't have to worry
1538 else if (*p
>= '0' && *p
<= '9'
1539 && end
[-1] >= '0' && end
[-1] <= '9')
1541 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1542 /* Needed for \2e10. */
1545 confusing
= (end
== p
);
1550 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1556 size_byte
= SBYTES (name
);
1558 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1560 /* Here, we must convert each multi-byte form to the
1561 corresponding character code before handing it to PRINTCHAR. */
1562 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1567 if (c
== '\"' || c
== '\\' || c
== '\''
1568 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1569 || c
== ',' || c
=='.' || c
== '`'
1570 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1572 PRINTCHAR ('\\'), confusing
= 0;
1580 /* If deeper than spec'd depth, print placeholder. */
1581 if (INTEGERP (Vprint_level
)
1582 && print_depth
> XINT (Vprint_level
))
1583 strout ("...", -1, -1, printcharfun
, 0);
1584 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1585 && (EQ (XCAR (obj
), Qquote
)))
1588 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1590 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1591 && (EQ (XCAR (obj
), Qfunction
)))
1595 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1597 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1598 && ! old_backquote_output
1599 && ((EQ (XCAR (obj
), Qbackquote
)
1600 || EQ (XCAR (obj
), Qcomma
)
1601 || EQ (XCAR (obj
), Qcomma_at
)
1602 || EQ (XCAR (obj
), Qcomma_dot
))))
1604 print_object (XCAR (obj
), printcharfun
, 0);
1605 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1611 /* If the first element is a backquote form,
1612 print it old-style so it won't be misunderstood. */
1613 if (print_quoted
&& CONSP (XCAR (obj
))
1614 && CONSP (XCDR (XCAR (obj
)))
1615 && NILP (XCDR (XCDR (XCAR (obj
))))
1616 && EQ (XCAR (XCAR (obj
)), Qbackquote
))
1622 print_object (Qbackquote
, printcharfun
, 0);
1625 ++old_backquote_output
;
1626 print_object (XCAR (XCDR (tem
)), printcharfun
, 0);
1627 --old_backquote_output
;
1634 int print_length
, i
;
1635 Lisp_Object halftail
= obj
;
1637 /* Negative values of print-length are invalid in CL.
1638 Treat them like nil, as CMUCL does. */
1639 if (NATNUMP (Vprint_length
))
1640 print_length
= XFASTINT (Vprint_length
);
1647 /* Detect circular list. */
1648 if (NILP (Vprint_circle
))
1650 /* Simple but imcomplete way. */
1651 if (i
!= 0 && EQ (obj
, halftail
))
1653 sprintf (buf
, " . #%d", i
/ 2);
1654 strout (buf
, -1, -1, printcharfun
, 0);
1660 /* With the print-circle feature. */
1664 for (i
= 0; i
< print_number_index
; i
++)
1665 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
),
1668 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1670 strout (" . ", 3, 3, printcharfun
, 0);
1671 print_object (obj
, printcharfun
, escapeflag
);
1675 sprintf (buf
, " . #%d#", i
+ 1);
1676 strout (buf
, -1, -1, printcharfun
, 0);
1686 if (print_length
&& i
> print_length
)
1688 strout ("...", 3, 3, printcharfun
, 0);
1692 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1696 halftail
= XCDR (halftail
);
1700 /* OBJ non-nil here means it's the end of a dotted list. */
1703 strout (" . ", 3, 3, printcharfun
, 0);
1704 print_object (obj
, printcharfun
, escapeflag
);
1712 case Lisp_Vectorlike
:
1717 strout ("#<process ", -1, -1, printcharfun
, 0);
1718 print_string (XPROCESS (obj
)->name
, printcharfun
);
1722 print_string (XPROCESS (obj
)->name
, printcharfun
);
1724 else if (BOOL_VECTOR_P (obj
))
1727 register unsigned char c
;
1728 struct gcpro gcpro1
;
1730 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1736 if (sizeof (int) == sizeof (EMACS_INT
))
1737 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1738 else if (sizeof (long) == sizeof (EMACS_INT
))
1739 sprintf (buf
, "%ld", XBOOL_VECTOR (obj
)->size
);
1742 strout (buf
, -1, -1, printcharfun
, 0);
1745 /* Don't print more characters than the specified maximum.
1746 Negative values of print-length are invalid. Treat them
1747 like a print-length of nil. */
1748 if (NATNUMP (Vprint_length
)
1749 && XFASTINT (Vprint_length
) < size_in_chars
)
1750 size_in_chars
= XFASTINT (Vprint_length
);
1752 for (i
= 0; i
< size_in_chars
; i
++)
1755 c
= XBOOL_VECTOR (obj
)->data
[i
];
1756 if (! ASCII_BYTE_P (c
))
1758 sprintf (buf
, "\\%03o", c
);
1759 strout (buf
, -1, -1, printcharfun
, 0);
1761 else if (c
== '\n' && print_escape_newlines
)
1766 else if (c
== '\f' && print_escape_newlines
)
1773 if (c
== '\"' || c
== '\\')
1782 else if (SUBRP (obj
))
1784 strout ("#<subr ", -1, -1, printcharfun
, 0);
1785 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1788 else if (WINDOWP (obj
))
1790 strout ("#<window ", -1, -1, printcharfun
, 0);
1791 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1792 strout (buf
, -1, -1, printcharfun
, 0);
1793 if (!NILP (XWINDOW (obj
)->buffer
))
1795 strout (" on ", -1, -1, printcharfun
, 0);
1796 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1800 else if (HASH_TABLE_P (obj
))
1802 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1803 strout ("#<hash-table", -1, -1, printcharfun
, 0);
1804 if (SYMBOLP (h
->test
))
1808 strout (SDATA (SYMBOL_NAME (h
->test
)), -1, -1, printcharfun
, 0);
1810 strout (SDATA (SYMBOL_NAME (h
->weak
)), -1, -1, printcharfun
, 0);
1812 sprintf (buf
, "%d/%d", XFASTINT (h
->count
),
1813 XVECTOR (h
->next
)->size
);
1814 strout (buf
, -1, -1, printcharfun
, 0);
1816 sprintf (buf
, " 0x%lx", (unsigned long) h
);
1817 strout (buf
, -1, -1, printcharfun
, 0);
1820 else if (BUFFERP (obj
))
1822 if (NILP (XBUFFER (obj
)->name
))
1823 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1824 else if (escapeflag
)
1826 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1827 print_string (XBUFFER (obj
)->name
, printcharfun
);
1831 print_string (XBUFFER (obj
)->name
, printcharfun
);
1833 else if (WINDOW_CONFIGURATIONP (obj
))
1835 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1837 else if (FRAMEP (obj
))
1839 strout ((FRAME_LIVE_P (XFRAME (obj
))
1840 ? "#<frame " : "#<dead frame "),
1841 -1, -1, printcharfun
, 0);
1842 print_string (XFRAME (obj
)->name
, printcharfun
);
1843 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
1844 strout (buf
, -1, -1, printcharfun
, 0);
1849 int size
= XVECTOR (obj
)->size
;
1850 if (COMPILEDP (obj
))
1853 size
&= PSEUDOVECTOR_SIZE_MASK
;
1855 if (CHAR_TABLE_P (obj
) || SUB_CHAR_TABLE_P (obj
))
1857 /* We print a char-table as if it were a vector,
1858 lumping the parent and default slots in with the
1859 character slots. But we add #^ as a prefix. */
1862 if (SUB_CHAR_TABLE_P (obj
))
1864 size
&= PSEUDOVECTOR_SIZE_MASK
;
1866 if (size
& PSEUDOVECTOR_FLAG
)
1872 register Lisp_Object tem
;
1873 int real_size
= size
;
1875 /* Don't print more elements than the specified maximum. */
1876 if (NATNUMP (Vprint_length
)
1877 && XFASTINT (Vprint_length
) < size
)
1878 size
= XFASTINT (Vprint_length
);
1880 for (i
= 0; i
< size
; i
++)
1882 if (i
) PRINTCHAR (' ');
1883 tem
= XVECTOR (obj
)->contents
[i
];
1884 print_object (tem
, printcharfun
, escapeflag
);
1886 if (size
< real_size
)
1887 strout (" ...", 4, 4, printcharfun
, 0);
1894 switch (XMISCTYPE (obj
))
1896 case Lisp_Misc_Marker
:
1897 strout ("#<marker ", -1, -1, printcharfun
, 0);
1898 /* Do you think this is necessary? */
1899 if (XMARKER (obj
)->insertion_type
!= 0)
1900 strout ("(moves after insertion) ", -1, -1, printcharfun
, 0);
1901 if (!(XMARKER (obj
)->buffer
))
1902 strout ("in no buffer", -1, -1, printcharfun
, 0);
1905 sprintf (buf
, "at %d", marker_position (obj
));
1906 strout (buf
, -1, -1, printcharfun
, 0);
1907 strout (" in ", -1, -1, printcharfun
, 0);
1908 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1913 case Lisp_Misc_Overlay
:
1914 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1915 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1916 strout ("in no buffer", -1, -1, printcharfun
, 0);
1919 sprintf (buf
, "from %d to %d in ",
1920 marker_position (OVERLAY_START (obj
)),
1921 marker_position (OVERLAY_END (obj
)));
1922 strout (buf
, -1, -1, printcharfun
, 0);
1923 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1929 /* Remaining cases shouldn't happen in normal usage, but let's print
1930 them anyway for the benefit of the debugger. */
1931 case Lisp_Misc_Free
:
1932 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1935 case Lisp_Misc_Intfwd
:
1936 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1937 strout (buf
, -1, -1, printcharfun
, 0);
1940 case Lisp_Misc_Boolfwd
:
1941 sprintf (buf
, "#<boolfwd to %s>",
1942 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1943 strout (buf
, -1, -1, printcharfun
, 0);
1946 case Lisp_Misc_Objfwd
:
1947 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
1948 print_object (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1952 case Lisp_Misc_Buffer_Objfwd
:
1953 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
1954 print_object (PER_BUFFER_VALUE (current_buffer
,
1955 XBUFFER_OBJFWD (obj
)->offset
),
1956 printcharfun
, escapeflag
);
1960 case Lisp_Misc_Kboard_Objfwd
:
1961 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
1962 print_object (*(Lisp_Object
*)((char *) current_kboard
1963 + XKBOARD_OBJFWD (obj
)->offset
),
1964 printcharfun
, escapeflag
);
1968 case Lisp_Misc_Buffer_Local_Value
:
1969 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
1970 goto do_buffer_local
;
1971 case Lisp_Misc_Some_Buffer_Local_Value
:
1972 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
1974 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
1975 print_object (XBUFFER_LOCAL_VALUE (obj
)->realvalue
,
1976 printcharfun
, escapeflag
);
1977 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
1978 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
1980 strout ("[buffer] ", -1, -1, printcharfun
, 0);
1981 print_object (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
1982 printcharfun
, escapeflag
);
1983 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
1985 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
1986 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
1988 strout ("[frame] ", -1, -1, printcharfun
, 0);
1989 print_object (XBUFFER_LOCAL_VALUE (obj
)->frame
,
1990 printcharfun
, escapeflag
);
1992 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
1993 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
1994 printcharfun
, escapeflag
);
1995 strout ("[default-value] ", -1, -1, printcharfun
, 0);
1996 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
1997 printcharfun
, escapeflag
);
2009 /* We're in trouble if this happens!
2010 Probably should just abort () */
2011 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
2013 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
2014 else if (VECTORLIKEP (obj
))
2015 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
2017 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
2018 strout (buf
, -1, -1, printcharfun
, 0);
2019 strout (" Save your buffers immediately and please report this bug>",
2020 -1, -1, printcharfun
, 0);
2028 /* Print a description of INTERVAL using PRINTCHARFUN.
2029 This is part of printing a string that has text properties. */
2032 print_interval (interval
, printcharfun
)
2034 Lisp_Object printcharfun
;
2037 print_object (make_number (interval
->position
), printcharfun
, 1);
2039 print_object (make_number (interval
->position
+ LENGTH (interval
)),
2042 print_object (interval
->plist
, printcharfun
, 1);
2049 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
2050 staticpro (&Qtemp_buffer_setup_hook
);
2052 DEFVAR_LISP ("standard-output", &Vstandard_output
,
2053 doc
: /* Output stream `print' uses by default for outputting a character.
2054 This may be any function of one argument.
2055 It may also be a buffer (output is inserted before point)
2056 or a marker (output is inserted and the marker is advanced)
2057 or the symbol t (output appears in the echo area). */);
2058 Vstandard_output
= Qt
;
2059 Qstandard_output
= intern ("standard-output");
2060 staticpro (&Qstandard_output
);
2062 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
2063 doc
: /* The format descriptor string used to print floats.
2064 This is a %-spec like those accepted by `printf' in C,
2065 but with some restrictions. It must start with the two characters `%.'.
2066 After that comes an integer precision specification,
2067 and then a letter which controls the format.
2068 The letters allowed are `e', `f' and `g'.
2069 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2070 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2071 Use `g' to choose the shorter of those two formats for the number at hand.
2072 The precision in any of these cases is the number of digits following
2073 the decimal point. With `f', a precision of 0 means to omit the
2074 decimal point. 0 is not allowed with `e' or `g'.
2076 A value of nil means to use the shortest notation
2077 that represents the number without losing information. */);
2078 Vfloat_output_format
= Qnil
;
2079 Qfloat_output_format
= intern ("float-output-format");
2080 staticpro (&Qfloat_output_format
);
2082 DEFVAR_LISP ("print-length", &Vprint_length
,
2083 doc
: /* Maximum length of list to print before abbreviating.
2084 A value of nil means no limit. See also `eval-expression-print-length'. */);
2085 Vprint_length
= Qnil
;
2087 DEFVAR_LISP ("print-level", &Vprint_level
,
2088 doc
: /* Maximum depth of list nesting to print before abbreviating.
2089 A value of nil means no limit. See also `eval-expression-print-level'. */);
2090 Vprint_level
= Qnil
;
2092 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
2093 doc
: /* Non-nil means print newlines in strings as `\\n'.
2094 Also print formfeeds as `\\f'. */);
2095 print_escape_newlines
= 0;
2097 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
2098 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2099 \(OOO is the octal representation of the character code.)
2100 Only single-byte characters are affected, and only in `prin1'.
2101 When the output goes in a multibyte buffer, this feature is
2102 enabled regardless of the value of the variable. */);
2103 print_escape_nonascii
= 0;
2105 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
2106 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2107 \(XXXX is the hex representation of the character code.)
2108 This affects only `prin1'. */);
2109 print_escape_multibyte
= 0;
2111 DEFVAR_BOOL ("print-quoted", &print_quoted
,
2112 doc
: /* Non-nil means print quoted forms with reader syntax.
2113 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2114 forms print as in the new syntax. */);
2117 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
2118 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2119 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2120 When the uninterned symbol appears within a recursive data structure,
2121 and the symbol appears more than once, in addition use the #N# and #N=
2122 constructs as needed, so that multiple references to the same symbol are
2123 shared once again when the text is read back. */);
2124 Vprint_gensym
= Qnil
;
2126 DEFVAR_LISP ("print-circle", &Vprint_circle
,
2127 doc
: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2128 If nil, printing proceeds recursively and may lead to
2129 `max-lisp-eval-depth' being exceeded or an error may occur:
2130 \"Apparently circular structure being printed.\" Also see
2131 `print-length' and `print-level'.
2132 If non-nil, shared substructures anywhere in the structure are printed
2133 with `#N=' before the first occurrence (in the order of the print
2134 representation) and `#N#' in place of each subsequent occurrence,
2135 where N is a positive decimal integer. */);
2136 Vprint_circle
= Qnil
;
2138 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
2139 doc
: /* *Non-nil means number continuously across print calls.
2140 This affects the numbers printed for #N= labels and #M# references.
2141 See also `print-circle', `print-gensym', and `print-number-table'.
2142 This variable should not be set with `setq'; bind it with a `let' instead. */);
2143 Vprint_continuous_numbering
= Qnil
;
2145 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
2146 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2147 The Lisp printer uses this vector to detect Lisp objects referenced more
2150 When you bind `print-continuous-numbering' to t, you should probably
2151 also bind `print-number-table' to nil. This ensures that the value of
2152 `print-number-table' can be garbage-collected once the printing is
2153 done. If all elements of `print-number-table' are nil, it means that
2154 the printing done so far has not found any shared structure or objects
2155 that need to be recorded in the table. */);
2156 Vprint_number_table
= Qnil
;
2158 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2159 staticpro (&Vprin1_to_string_buffer
);
2162 defsubr (&Sprin1_to_string
);
2163 defsubr (&Serror_message_string
);
2167 defsubr (&Swrite_char
);
2168 defsubr (&Sexternal_debugging_output
);
2170 Qexternal_debugging_output
= intern ("external-debugging-output");
2171 staticpro (&Qexternal_debugging_output
);
2173 Qprint_escape_newlines
= intern ("print-escape-newlines");
2174 staticpro (&Qprint_escape_newlines
);
2176 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
2177 staticpro (&Qprint_escape_multibyte
);
2179 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
2180 staticpro (&Qprint_escape_nonascii
);
2182 defsubr (&Swith_output_to_temp_buffer
);