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. */
32 #include "dispextern.h"
33 #include "systty.h" /* For emacs_tty in termchar.h */
35 #include "intervals.h"
37 Lisp_Object Vstandard_output
, Qstandard_output
;
39 Lisp_Object Qtemp_buffer_setup_hook
;
41 /* These are used to print like we read. */
42 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
44 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
46 /* Work around a problem that happens because math.h on hpux 7
47 defines two static variables--which, in Emacs, are not really static,
48 because `static' is defined as nothing. The problem is that they are
49 defined both here and in lread.c.
50 These macros prevent the name conflict. */
51 #if defined (HPUX) && !defined (HPUX8)
52 #define _MAXLDBL print_maxldbl
53 #define _NMAXLDBL print_nmaxldbl
62 /* Default to values appropriate for IEEE floating point. */
67 #define DBL_MANT_DIG 53
73 #define DBL_MIN 2.2250738585072014e-308
76 #ifdef DBL_MIN_REPLACEMENT
78 #define DBL_MIN DBL_MIN_REPLACEMENT
81 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
82 needed to express a float without losing information.
83 The general-case formula is valid for the usual case, IEEE floating point,
84 but many compilers can't optimize the formula to an integer constant,
85 so make a special case for it. */
86 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
87 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
89 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
92 /* Avoid actual stack overflow in print. */
95 /* Nonzero if inside outputting backquote in old style. */
96 int old_backquote_output
;
98 /* Detect most circularities to print finite output. */
99 #define PRINT_CIRCLE 200
100 Lisp_Object being_printed
[PRINT_CIRCLE
];
102 /* When printing into a buffer, first we put the text in this
103 block, then insert it all at once. */
106 /* Size allocated in print_buffer. */
107 int print_buffer_size
;
108 /* Chars stored in print_buffer. */
109 int print_buffer_pos
;
110 /* Bytes stored in print_buffer. */
111 int print_buffer_pos_byte
;
113 /* Maximum length of list to print in full; noninteger means
114 effectively infinity */
116 Lisp_Object Vprint_length
;
118 /* Maximum depth of list to print in full; noninteger means
119 effectively infinity. */
121 Lisp_Object Vprint_level
;
123 /* Nonzero means print newlines in strings as \n. */
125 int print_escape_newlines
;
127 /* Nonzero means to print single-byte non-ascii characters in strings as
130 int print_escape_nonascii
;
132 /* Nonzero means to print multibyte characters in strings as hex escapes. */
134 int print_escape_multibyte
;
136 Lisp_Object Qprint_escape_newlines
;
137 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
139 /* Nonzero means print (quote foo) forms as 'foo, etc. */
143 /* Non-nil means print #: before uninterned symbols. */
145 Lisp_Object Vprint_gensym
;
147 /* Non-nil means print recursive structures using #n= and #n# syntax. */
149 Lisp_Object Vprint_circle
;
151 /* Non-nil means keep continuous number for #n= and #n# syntax
152 between several print functions. */
154 Lisp_Object Vprint_continuous_numbering
;
156 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
157 where OBJn are objects going to be printed, and STATn are their status,
158 which may be different meanings during process. See the comments of
159 the functions print and print_preprocess for details.
160 print_number_index keeps the last position the next object should be added,
161 twice of which is the actual vector position in Vprint_number_table. */
162 int print_number_index
;
163 Lisp_Object Vprint_number_table
;
165 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
166 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
167 See the comment of the variable Vprint_number_table. */
168 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
169 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
171 /* Nonzero means print newline to stdout before next minibuffer message.
172 Defined in xdisp.c */
174 extern int noninteractive_need_newline
;
176 extern int minibuffer_auto_raise
;
178 #ifdef MAX_PRINT_CHARS
179 static int print_chars
;
180 static int max_print
;
181 #endif /* MAX_PRINT_CHARS */
183 void print_interval ();
186 /* Low level output routines for characters and strings */
188 /* Lisp functions to do output using a stream
189 must have the stream in a variable called printcharfun
190 and must start with PRINTPREPARE, end with PRINTFINISH,
191 and use PRINTDECLARE to declare common variables.
192 Use PRINTCHAR to output one character,
193 or call strout to output a block of characters. */
195 #define PRINTDECLARE \
196 struct buffer *old = current_buffer; \
197 int old_point = -1, start_point = -1; \
198 int old_point_byte = -1, start_point_byte = -1; \
199 int specpdl_count = SPECPDL_INDEX (); \
200 int free_print_buffer = 0; \
201 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
204 #define PRINTPREPARE \
205 original = printcharfun; \
206 if (NILP (printcharfun)) printcharfun = Qt; \
207 if (BUFFERP (printcharfun)) \
209 if (XBUFFER (printcharfun) != current_buffer) \
210 Fset_buffer (printcharfun); \
211 printcharfun = Qnil; \
213 if (MARKERP (printcharfun)) \
215 if (!(XMARKER (original)->buffer)) \
216 error ("Marker does not point anywhere"); \
217 if (XMARKER (original)->buffer != current_buffer) \
218 set_buffer_internal (XMARKER (original)->buffer); \
220 old_point_byte = PT_BYTE; \
221 SET_PT_BOTH (marker_position (printcharfun), \
222 marker_byte_position (printcharfun)); \
224 start_point_byte = PT_BYTE; \
225 printcharfun = Qnil; \
227 if (NILP (printcharfun)) \
229 Lisp_Object string; \
230 if (NILP (current_buffer->enable_multibyte_characters) \
231 && ! print_escape_multibyte) \
232 specbind (Qprint_escape_multibyte, Qt); \
233 if (! NILP (current_buffer->enable_multibyte_characters) \
234 && ! print_escape_nonascii) \
235 specbind (Qprint_escape_nonascii, Qt); \
236 if (print_buffer != 0) \
238 string = make_string_from_bytes (print_buffer, \
240 print_buffer_pos_byte); \
241 record_unwind_protect (print_unwind, string); \
245 print_buffer_size = 1000; \
246 print_buffer = (char *) xmalloc (print_buffer_size); \
247 free_print_buffer = 1; \
249 print_buffer_pos = 0; \
250 print_buffer_pos_byte = 0; \
252 if (EQ (printcharfun, Qt) && ! noninteractive) \
253 setup_echo_area_for_printing (multibyte);
255 #define PRINTFINISH \
256 if (NILP (printcharfun)) \
258 if (print_buffer_pos != print_buffer_pos_byte \
259 && NILP (current_buffer->enable_multibyte_characters)) \
261 unsigned char *temp \
262 = (unsigned char *) alloca (print_buffer_pos + 1); \
263 copy_text (print_buffer, temp, print_buffer_pos_byte, \
265 insert_1_both (temp, print_buffer_pos, \
266 print_buffer_pos, 0, 1, 0); \
269 insert_1_both (print_buffer, print_buffer_pos, \
270 print_buffer_pos_byte, 0, 1, 0); \
272 if (free_print_buffer) \
274 xfree (print_buffer); \
277 unbind_to (specpdl_count, Qnil); \
278 if (MARKERP (original)) \
279 set_marker_both (original, Qnil, PT, PT_BYTE); \
280 if (old_point >= 0) \
281 SET_PT_BOTH (old_point + (old_point >= start_point \
282 ? PT - start_point : 0), \
283 old_point_byte + (old_point_byte >= start_point_byte \
284 ? PT_BYTE - start_point_byte : 0)); \
285 if (old != current_buffer) \
286 set_buffer_internal (old);
288 #define PRINTCHAR(ch) printchar (ch, printcharfun)
290 /* This is used to restore the saved contents of print_buffer
291 when there is a recursive call to print. */
294 print_unwind (saved_text
)
295 Lisp_Object saved_text
;
297 bcopy (SDATA (saved_text
), print_buffer
, SCHARS (saved_text
));
302 /* Print character CH using method FUN. FUN nil means print to
303 print_buffer. FUN t means print to echo area or stdout if
304 non-interactive. If FUN is neither nil nor t, call FUN with CH as
312 #ifdef MAX_PRINT_CHARS
315 #endif /* MAX_PRINT_CHARS */
317 if (!NILP (fun
) && !EQ (fun
, Qt
))
318 call1 (fun
, make_number (ch
));
321 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
322 int len
= CHAR_STRING (ch
, str
);
328 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
329 print_buffer
= (char *) xrealloc (print_buffer
,
330 print_buffer_size
*= 2);
331 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
332 print_buffer_pos
+= 1;
333 print_buffer_pos_byte
+= len
;
335 else if (noninteractive
)
337 fwrite (str
, 1, len
, stdout
);
338 noninteractive_need_newline
= 1;
343 = !NILP (current_buffer
->enable_multibyte_characters
);
345 setup_echo_area_for_printing (multibyte_p
);
347 message_dolog (str
, len
, 0, multibyte_p
);
353 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
354 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
355 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
356 print_buffer. PRINTCHARFUN t means output to the echo area or to
357 stdout if non-interactive. If neither nil nor t, call Lisp
358 function PRINTCHARFUN for each character printed. MULTIBYTE
359 non-zero means PTR contains multibyte characters. */
362 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
365 Lisp_Object printcharfun
;
369 size_byte
= size
= strlen (ptr
);
371 if (NILP (printcharfun
))
373 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
375 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
376 print_buffer
= (char *) xrealloc (print_buffer
,
379 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
380 print_buffer_pos
+= size
;
381 print_buffer_pos_byte
+= size_byte
;
383 #ifdef MAX_PRINT_CHARS
386 #endif /* MAX_PRINT_CHARS */
388 else if (noninteractive
&& EQ (printcharfun
, Qt
))
390 fwrite (ptr
, 1, size_byte
, stdout
);
391 noninteractive_need_newline
= 1;
393 else if (EQ (printcharfun
, Qt
))
395 /* Output to echo area. We're trying to avoid a little overhead
396 here, that's the reason we don't call printchar to do the
400 = !NILP (current_buffer
->enable_multibyte_characters
);
402 setup_echo_area_for_printing (multibyte_p
);
403 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
405 if (size
== size_byte
)
407 for (i
= 0; i
< size
; ++i
)
408 insert_char ((unsigned char )*ptr
++);
413 for (i
= 0; i
< size_byte
; i
+= len
)
415 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
420 #ifdef MAX_PRINT_CHARS
423 #endif /* MAX_PRINT_CHARS */
427 /* PRINTCHARFUN is a Lisp function. */
430 if (size
== size_byte
)
432 while (i
< size_byte
)
440 while (i
< size_byte
)
442 /* Here, we must convert each multi-byte form to the
443 corresponding character code before handing it to
446 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
454 /* Print the contents of a string STRING using PRINTCHARFUN.
455 It isn't safe to use strout in many cases,
456 because printing one char can relocate. */
459 print_string (string
, printcharfun
)
461 Lisp_Object printcharfun
;
463 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
467 if (STRING_MULTIBYTE (string
))
468 chars
= SCHARS (string
);
469 else if (EQ (printcharfun
, Qt
)
470 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
471 : ! NILP (current_buffer
->enable_multibyte_characters
))
473 /* If unibyte string STRING contains 8-bit codes, we must
474 convert STRING to a multibyte string containing the same
479 chars
= SBYTES (string
);
480 bytes
= parse_str_to_multibyte (SDATA (string
), chars
);
483 newstr
= make_uninit_multibyte_string (chars
, bytes
);
484 bcopy (SDATA (string
), SDATA (newstr
), chars
);
485 str_to_multibyte (SDATA (newstr
), bytes
, chars
);
490 chars
= SBYTES (string
);
492 /* strout is safe for output to a frame (echo area) or to print_buffer. */
493 strout (SDATA (string
),
494 chars
, SBYTES (string
),
495 printcharfun
, STRING_MULTIBYTE (string
));
499 /* Otherwise, string may be relocated by printing one char.
500 So re-fetch the string address for each character. */
502 int size
= SCHARS (string
);
503 int size_byte
= SBYTES (string
);
506 if (size
== size_byte
)
507 for (i
= 0; i
< size
; i
++)
508 PRINTCHAR (SREF (string
, i
));
510 for (i
= 0; i
< size_byte
; )
512 /* Here, we must convert each multi-byte form to the
513 corresponding character code before handing it to PRINTCHAR. */
515 int ch
= STRING_CHAR_AND_LENGTH (SDATA (string
) + i
,
517 if (!CHAR_VALID_P (ch
, 0))
519 ch
= SREF (string
, i
);
529 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
530 doc
: /* Output character CHARACTER to stream PRINTCHARFUN.
531 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
532 (character
, printcharfun
)
533 Lisp_Object character
, printcharfun
;
537 if (NILP (printcharfun
))
538 printcharfun
= Vstandard_output
;
539 CHECK_NUMBER (character
);
541 PRINTCHAR (XINT (character
));
546 /* Used from outside of print.c to print a block of SIZE
547 single-byte chars at DATA on the default output stream.
548 Do not use this on the contents of a Lisp string. */
551 write_string (data
, size
)
556 Lisp_Object printcharfun
;
558 printcharfun
= Vstandard_output
;
561 strout (data
, size
, size
, printcharfun
, 0);
565 /* Used from outside of print.c to print a block of SIZE
566 single-byte chars at DATA on a specified stream PRINTCHARFUN.
567 Do not use this on the contents of a Lisp string. */
570 write_string_1 (data
, size
, printcharfun
)
573 Lisp_Object printcharfun
;
578 strout (data
, size
, size
, printcharfun
, 0);
584 temp_output_buffer_setup (bufname
)
587 int count
= SPECPDL_INDEX ();
588 register struct buffer
*old
= current_buffer
;
589 register Lisp_Object buf
;
591 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
593 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
595 Fkill_all_local_variables ();
596 delete_all_overlays (current_buffer
);
597 current_buffer
->directory
= old
->directory
;
598 current_buffer
->read_only
= Qnil
;
599 current_buffer
->filename
= Qnil
;
600 current_buffer
->undo_list
= Qt
;
601 eassert (current_buffer
->overlays_before
== NULL
);
602 eassert (current_buffer
->overlays_after
== NULL
);
603 current_buffer
->enable_multibyte_characters
604 = buffer_defaults
.enable_multibyte_characters
;
606 XSETBUFFER (buf
, current_buffer
);
608 Frun_hooks (1, &Qtemp_buffer_setup_hook
);
610 unbind_to (count
, Qnil
);
612 specbind (Qstandard_output
, buf
);
616 internal_with_output_to_temp_buffer (bufname
, function
, args
)
618 Lisp_Object (*function
) P_ ((Lisp_Object
));
621 int count
= SPECPDL_INDEX ();
622 Lisp_Object buf
, val
;
626 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
627 temp_output_buffer_setup (bufname
);
628 buf
= Vstandard_output
;
631 val
= (*function
) (args
);
634 temp_output_buffer_show (buf
);
637 return unbind_to (count
, val
);
640 DEFUN ("with-output-to-temp-buffer",
641 Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
643 doc
: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
644 The buffer is cleared out initially, and marked as unmodified when done.
645 All output done by BODY is inserted in that buffer by default.
646 The buffer is displayed in another window, but not selected.
647 The value of the last form in BODY is returned.
648 If BODY does not finish normally, the buffer BUFNAME is not displayed.
650 The hook `temp-buffer-setup-hook' is run before BODY,
651 with the buffer BUFNAME temporarily current.
652 The hook `temp-buffer-show-hook' is run after the buffer is displayed,
653 with the buffer temporarily current, and the window that was used
654 to display it temporarily selected.
656 If variable `temp-buffer-show-function' is non-nil, call it at the end
657 to get the buffer displayed instead of just displaying the non-selected
658 buffer and calling the hook. It gets one argument, the buffer to display.
660 usage: (with-output-to-temp-buffer BUFFNAME BODY ...) */)
666 int count
= SPECPDL_INDEX ();
667 Lisp_Object buf
, val
;
670 name
= Feval (Fcar (args
));
672 temp_output_buffer_setup (SDATA (name
));
673 buf
= Vstandard_output
;
676 val
= Fprogn (XCDR (args
));
679 temp_output_buffer_show (buf
);
682 return unbind_to (count
, val
);
686 static void print ();
687 static void print_preprocess ();
688 static void print_preprocess_string ();
689 static void print_object ();
691 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
692 doc
: /* Output a newline to stream PRINTCHARFUN.
693 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
695 Lisp_Object printcharfun
;
699 if (NILP (printcharfun
))
700 printcharfun
= Vstandard_output
;
707 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
708 doc
: /* Output the printed representation of OBJECT, any Lisp object.
709 Quoting characters are printed when needed to make output that `read'
710 can handle, whenever this is possible. For complex objects, the behavior
711 is controlled by `print-level' and `print-length', which see.
713 OBJECT is any of the Lisp data types: a number, a string, a symbol,
714 a list, a buffer, a window, a frame, etc.
716 A printed representation of an object is text which describes that object.
718 Optional argument PRINTCHARFUN is the output stream, which can be one
721 - a buffer, in which case output is inserted into that buffer at point;
722 - a marker, in which case output is inserted at marker's position;
723 - a function, in which case that function is called once for each
724 character of OBJECT's printed representation;
725 - a symbol, in which case that symbol's function definition is called; or
726 - t, in which case the output is displayed in the echo area.
728 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
730 (object
, printcharfun
)
731 Lisp_Object object
, printcharfun
;
735 #ifdef MAX_PRINT_CHARS
737 #endif /* MAX_PRINT_CHARS */
738 if (NILP (printcharfun
))
739 printcharfun
= Vstandard_output
;
741 print (object
, printcharfun
, 1);
746 /* a buffer which is used to hold output being built by prin1-to-string */
747 Lisp_Object Vprin1_to_string_buffer
;
749 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
750 doc
: /* Return a string containing the printed representation of OBJECT.
751 OBJECT can be any Lisp object. This function outputs quoting characters
752 when necessary to make output that `read' can handle, whenever possible,
753 unless the optional second argument NOESCAPE is non-nil.
755 OBJECT is any of the Lisp data types: a number, a string, a symbol,
756 a list, a buffer, a window, a frame, etc.
758 A printed representation of an object is text which describes that object. */)
760 Lisp_Object object
, noescape
;
762 Lisp_Object printcharfun
;
763 /* struct gcpro gcpro1, gcpro2; */
764 Lisp_Object save_deactivate_mark
;
765 int count
= specpdl_ptr
- specpdl
;
766 struct buffer
*previous
;
768 specbind (Qinhibit_modification_hooks
, Qt
);
773 /* Save and restore this--we are altering a buffer
774 but we don't want to deactivate the mark just for that.
775 No need for specbind, since errors deactivate the mark. */
776 save_deactivate_mark
= Vdeactivate_mark
;
777 /* GCPRO2 (object, save_deactivate_mark); */
780 printcharfun
= Vprin1_to_string_buffer
;
782 print (object
, printcharfun
, NILP (noescape
));
783 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
787 previous
= current_buffer
;
788 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
789 object
= Fbuffer_string ();
790 if (SBYTES (object
) == SCHARS (object
))
791 STRING_SET_UNIBYTE (object
);
793 /* Note that this won't make prepare_to_modify_buffer call
794 ask-user-about-supersession-threat because this buffer
795 does not visit a file. */
797 set_buffer_internal (previous
);
799 Vdeactivate_mark
= save_deactivate_mark
;
803 return unbind_to (count
, object
);
806 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
807 doc
: /* Output the printed representation of OBJECT, any Lisp object.
808 No quoting characters are used; no delimiters are printed around
809 the contents of strings.
811 OBJECT is any of the Lisp data types: a number, a string, a symbol,
812 a list, a buffer, a window, a frame, etc.
814 A printed representation of an object is text which describes that object.
816 Optional argument PRINTCHARFUN is the output stream, which can be one
819 - a buffer, in which case output is inserted into that buffer at point;
820 - a marker, in which case output is inserted at marker's position;
821 - a function, in which case that function is called once for each
822 character of OBJECT's printed representation;
823 - a symbol, in which case that symbol's function definition is called; or
824 - t, in which case the output is displayed in the echo area.
826 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
828 (object
, printcharfun
)
829 Lisp_Object object
, printcharfun
;
833 if (NILP (printcharfun
))
834 printcharfun
= Vstandard_output
;
836 print (object
, printcharfun
, 0);
841 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
842 doc
: /* Output the printed representation of OBJECT, with newlines around it.
843 Quoting characters are printed when needed to make output that `read'
844 can handle, whenever this is possible. For complex objects, the behavior
845 is controlled by `print-level' and `print-length', which see.
847 OBJECT is any of the Lisp data types: a number, a string, a symbol,
848 a list, a buffer, a window, a frame, etc.
850 A printed representation of an object is text which describes that object.
852 Optional argument PRINTCHARFUN is the output stream, which can be one
855 - a buffer, in which case output is inserted into that buffer at point;
856 - a marker, in which case output is inserted at marker's position;
857 - a function, in which case that function is called once for each
858 character of OBJECT's printed representation;
859 - a symbol, in which case that symbol's function definition is called; or
860 - t, in which case the output is displayed in the echo area.
862 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
864 (object
, printcharfun
)
865 Lisp_Object object
, printcharfun
;
870 #ifdef MAX_PRINT_CHARS
872 max_print
= MAX_PRINT_CHARS
;
873 #endif /* MAX_PRINT_CHARS */
874 if (NILP (printcharfun
))
875 printcharfun
= Vstandard_output
;
879 print (object
, printcharfun
, 1);
882 #ifdef MAX_PRINT_CHARS
885 #endif /* MAX_PRINT_CHARS */
890 /* The subroutine object for external-debugging-output is kept here
891 for the convenience of the debugger. */
892 Lisp_Object Qexternal_debugging_output
;
894 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
895 doc
: /* Write CHARACTER to stderr.
896 You can call print while debugging emacs, and pass it this function
897 to make it write to the debugging output. */)
899 Lisp_Object character
;
901 CHECK_NUMBER (character
);
902 putc (XINT (character
), stderr
);
905 /* Send the output to a debugger (nothing happens if there isn't one). */
907 char buf
[2] = {(char) XINT (character
), '\0'};
908 OutputDebugString (buf
);
916 #if defined(GNU_LINUX)
918 /* This functionality is not vitally important in general, so we rely on
919 non-portable ability to use stderr as lvalue. */
921 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
923 FILE *initial_stderr_stream
= NULL
;
925 DEFUN ("redirect-debugging-output", Fredirect_debugging_output
, Sredirect_debugging_output
,
927 "FDebug output file: \nP",
928 doc
: /* Redirect debugging output (stderr stream) to file FILE.
929 If FILE is nil, reset target to the initial stderr stream.
930 Optional arg APPEND non-nil (interactively, with prefix arg) means
931 append to existing target file. */)
933 Lisp_Object file
, append
;
935 if (initial_stderr_stream
!= NULL
)
937 stderr
= initial_stderr_stream
;
938 initial_stderr_stream
= NULL
;
942 file
= Fexpand_file_name (file
, Qnil
);
943 initial_stderr_stream
= stderr
;
944 stderr
= fopen(SDATA (file
), NILP (append
) ? "w" : "a");
947 stderr
= initial_stderr_stream
;
948 initial_stderr_stream
= NULL
;
949 report_file_error ("Cannot open debugging output stream",
955 #endif /* GNU_LINUX */
958 /* This is the interface for debugging printing. */
964 Fprin1 (arg
, Qexternal_debugging_output
);
965 fprintf (stderr
, "\r\n");
968 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
970 doc
: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message. */)
974 struct buffer
*old
= current_buffer
;
978 /* If OBJ is (error STRING), just return STRING.
979 That is not only faster, it also avoids the need to allocate
980 space here when the error is due to memory full. */
981 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
982 && CONSP (XCDR (obj
))
983 && STRINGP (XCAR (XCDR (obj
)))
984 && NILP (XCDR (XCDR (obj
))))
985 return XCAR (XCDR (obj
));
987 print_error_message (obj
, Vprin1_to_string_buffer
, 0, Qnil
);
989 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
990 value
= Fbuffer_string ();
994 set_buffer_internal (old
);
1000 /* Print an error message for the error DATA onto Lisp output stream
1001 STREAM (suitable for the print functions). */
1004 print_error_message (data
, stream
, context
, caller
)
1005 Lisp_Object data
, stream
;
1009 Lisp_Object errname
, errmsg
, file_error
, tail
;
1010 struct gcpro gcpro1
;
1014 write_string_1 (context
, -1, stream
);
1016 /* If we know from where the error was signaled, show it in
1018 if (!NILP (caller
) && SYMBOLP (caller
))
1020 const char *name
= SDATA (SYMBOL_NAME (caller
));
1021 message_dolog (name
, strlen (name
), 0, 0);
1022 message_dolog (": ", 2, 0, 0);
1025 errname
= Fcar (data
);
1027 if (EQ (errname
, Qerror
))
1032 errmsg
= Fcar (data
);
1037 Lisp_Object error_conditions
;
1038 errmsg
= Fget (errname
, Qerror_message
);
1039 error_conditions
= Fget (errname
, Qerror_conditions
);
1040 file_error
= Fmemq (Qfile_error
, error_conditions
);
1043 /* Print an error message including the data items. */
1045 tail
= Fcdr_safe (data
);
1048 /* For file-error, make error message by concatenating
1049 all the data items. They are all strings. */
1050 if (!NILP (file_error
) && CONSP (tail
))
1051 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
1053 if (STRINGP (errmsg
))
1054 Fprinc (errmsg
, stream
);
1056 write_string_1 ("peculiar error", -1, stream
);
1058 for (i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
1062 write_string_1 (i
? ", " : ": ", 2, stream
);
1064 if (!NILP (file_error
) || EQ (errname
, Qend_of_file
))
1065 Fprinc (obj
, stream
);
1067 Fprin1 (obj
, stream
);
1076 * The buffer should be at least as large as the max string size of the
1077 * largest float, printed in the biggest notation. This is undoubtedly
1078 * 20d float_output_format, with the negative of the C-constant "HUGE"
1081 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1083 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1084 * case of -1e307 in 20d float_output_format. What is one to do (short of
1085 * re-writing _doprnt to be more sane)?
1090 float_to_string (buf
, data
)
1097 /* Check for plus infinity in a way that won't lose
1098 if there is no plus infinity. */
1099 if (data
== data
/ 2 && data
> 1.0)
1101 strcpy (buf
, "1.0e+INF");
1104 /* Likewise for minus infinity. */
1105 if (data
== data
/ 2 && data
< -1.0)
1107 strcpy (buf
, "-1.0e+INF");
1110 /* Check for NaN in a way that won't fail if there are no NaNs. */
1111 if (! (data
* 0.0 >= 0.0))
1113 /* Prepend "-" if the NaN's sign bit is negative.
1114 The sign bit of a double is the bit that is 1 in -0.0. */
1116 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
1118 u_minus_zero
.d
= - 0.0;
1119 for (i
= 0; i
< sizeof (double); i
++)
1120 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
1126 strcpy (buf
, "0.0e+NaN");
1130 if (NILP (Vfloat_output_format
)
1131 || !STRINGP (Vfloat_output_format
))
1134 /* Generate the fewest number of digits that represent the
1135 floating point value without losing information.
1136 The following method is simple but a bit slow.
1137 For ideas about speeding things up, please see:
1139 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1140 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1142 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1143 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1145 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
1147 sprintf (buf
, "%.*g", width
, data
);
1148 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
1150 else /* oink oink */
1152 /* Check that the spec we have is fully valid.
1153 This means not only valid for printf,
1154 but meant for floats, and reasonable. */
1155 cp
= SDATA (Vfloat_output_format
);
1164 /* Check the width specification. */
1166 if ('0' <= *cp
&& *cp
<= '9')
1170 width
= (width
* 10) + (*cp
++ - '0');
1171 while (*cp
>= '0' && *cp
<= '9');
1173 /* A precision of zero is valid only for %f. */
1175 || (width
== 0 && *cp
!= 'f'))
1179 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1185 sprintf (buf
, SDATA (Vfloat_output_format
), data
);
1188 /* Make sure there is a decimal point with digit after, or an
1189 exponent, so that the value is readable as a float. But don't do
1190 this with "%.0f"; it's valid for that not to produce a decimal
1191 point. Note that width can be 0 only for %.0f. */
1194 for (cp
= buf
; *cp
; cp
++)
1195 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1198 if (*cp
== '.' && cp
[1] == 0)
1215 print (obj
, printcharfun
, escapeflag
)
1217 register Lisp_Object printcharfun
;
1221 old_backquote_output
= 0;
1223 /* Reset print_number_index and Vprint_number_table only when
1224 the variable Vprint_continuous_numbering is nil. Otherwise,
1225 the values of these variables will be kept between several
1227 if (NILP (Vprint_continuous_numbering
))
1229 print_number_index
= 0;
1230 Vprint_number_table
= Qnil
;
1233 /* Construct Vprint_number_table for print-gensym and print-circle. */
1234 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1236 int i
, start
, index
;
1237 start
= index
= print_number_index
;
1238 /* Construct Vprint_number_table.
1239 This increments print_number_index for the objects added. */
1240 print_preprocess (obj
);
1242 /* Remove unnecessary objects, which appear only once in OBJ;
1243 that is, whose status is Qnil. Compactify the necessary objects. */
1244 for (i
= start
; i
< print_number_index
; i
++)
1245 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1247 PRINT_NUMBER_OBJECT (Vprint_number_table
, index
)
1248 = PRINT_NUMBER_OBJECT (Vprint_number_table
, i
);
1252 /* Clear out objects outside the active part of the table. */
1253 for (i
= index
; i
< print_number_index
; i
++)
1254 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
) = Qnil
;
1256 /* Reset the status field for the next print step. Now this
1257 field means whether the object has already been printed. */
1258 for (i
= start
; i
< print_number_index
; i
++)
1259 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qnil
;
1261 print_number_index
= index
;
1264 print_object (obj
, printcharfun
, escapeflag
);
1267 /* Construct Vprint_number_table according to the structure of OBJ.
1268 OBJ itself and all its elements will be added to Vprint_number_table
1269 recursively if it is a list, vector, compiled function, char-table,
1270 string (its text properties will be traced), or a symbol that has
1271 no obarray (this is for the print-gensym feature).
1272 The status fields of Vprint_number_table mean whether each object appears
1273 more than once in OBJ: Qnil at the first time, and Qt after that . */
1275 print_preprocess (obj
)
1281 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1282 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1283 || (! NILP (Vprint_gensym
)
1285 && !SYMBOL_INTERNED_P (obj
)))
1287 /* In case print-circle is nil and print-gensym is t,
1288 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1289 if (! NILP (Vprint_circle
) || SYMBOLP (obj
))
1291 for (i
= 0; i
< print_number_index
; i
++)
1292 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1294 /* OBJ appears more than once. Let's remember that. */
1295 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1299 /* OBJ is not yet recorded. Let's add to the table. */
1300 if (print_number_index
== 0)
1302 /* Initialize the table. */
1303 Vprint_number_table
= Fmake_vector (make_number (40), Qnil
);
1305 else if (XVECTOR (Vprint_number_table
)->size
== print_number_index
* 2)
1307 /* Reallocate the table. */
1308 int i
= print_number_index
* 4;
1309 Lisp_Object old_table
= Vprint_number_table
;
1310 Vprint_number_table
= Fmake_vector (make_number (i
), Qnil
);
1311 for (i
= 0; i
< print_number_index
; i
++)
1313 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
)
1314 = PRINT_NUMBER_OBJECT (old_table
, i
);
1315 PRINT_NUMBER_STATUS (Vprint_number_table
, i
)
1316 = PRINT_NUMBER_STATUS (old_table
, i
);
1319 PRINT_NUMBER_OBJECT (Vprint_number_table
, print_number_index
) = obj
;
1320 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1321 always print the gensym with a number. This is a special for
1322 the lisp function byte-compile-output-docform. */
1323 if (!NILP (Vprint_continuous_numbering
)
1325 && !SYMBOL_INTERNED_P (obj
))
1326 PRINT_NUMBER_STATUS (Vprint_number_table
, print_number_index
) = Qt
;
1327 print_number_index
++;
1330 switch (XGCTYPE (obj
))
1333 /* A string may have text properties, which can be circular. */
1334 traverse_intervals_noorder (STRING_INTERVALS (obj
),
1335 print_preprocess_string
, Qnil
);
1339 print_preprocess (XCAR (obj
));
1343 case Lisp_Vectorlike
:
1344 size
= XVECTOR (obj
)->size
& PSEUDOVECTOR_SIZE_MASK
;
1345 for (i
= 0; i
< size
; i
++)
1346 print_preprocess (XVECTOR (obj
)->contents
[i
]);
1356 print_preprocess_string (interval
, arg
)
1360 print_preprocess (interval
->plist
);
1364 print_object (obj
, printcharfun
, escapeflag
)
1366 register Lisp_Object printcharfun
;
1373 /* Detect circularities and truncate them. */
1374 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1375 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1376 || (! NILP (Vprint_gensym
)
1378 && !SYMBOL_INTERNED_P (obj
)))
1380 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1382 /* Simple but incomplete way. */
1384 for (i
= 0; i
< print_depth
; i
++)
1385 if (EQ (obj
, being_printed
[i
]))
1387 sprintf (buf
, "#%d", i
);
1388 strout (buf
, -1, -1, printcharfun
, 0);
1391 being_printed
[print_depth
] = obj
;
1395 /* With the print-circle feature. */
1397 for (i
= 0; i
< print_number_index
; i
++)
1398 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
), obj
))
1400 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1402 /* Add a prefix #n= if OBJ has not yet been printed;
1403 that is, its status field is nil. */
1404 sprintf (buf
, "#%d=", i
+ 1);
1405 strout (buf
, -1, -1, printcharfun
, 0);
1406 /* OBJ is going to be printed. Set the status to t. */
1407 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1412 /* Just print #n# if OBJ has already been printed. */
1413 sprintf (buf
, "#%d#", i
+ 1);
1414 strout (buf
, -1, -1, printcharfun
, 0);
1423 if (print_depth
> PRINT_CIRCLE
)
1424 error ("Apparently circular structure being printed");
1425 #ifdef MAX_PRINT_CHARS
1426 if (max_print
&& print_chars
> max_print
)
1431 #endif /* MAX_PRINT_CHARS */
1433 switch (XGCTYPE (obj
))
1436 if (sizeof (int) == sizeof (EMACS_INT
))
1437 sprintf (buf
, "%d", XINT (obj
));
1438 else if (sizeof (long) == sizeof (EMACS_INT
))
1439 sprintf (buf
, "%ld", (long) XINT (obj
));
1442 strout (buf
, -1, -1, printcharfun
, 0);
1447 char pigbuf
[350]; /* see comments in float_to_string */
1449 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1450 strout (pigbuf
, -1, -1, printcharfun
, 0);
1456 print_string (obj
, printcharfun
);
1459 register int i
, i_byte
;
1460 struct gcpro gcpro1
;
1463 /* 1 means we must ensure that the next character we output
1464 cannot be taken as part of a hex character escape. */
1465 int need_nonhex
= 0;
1466 int multibyte
= STRING_MULTIBYTE (obj
);
1470 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1478 size_byte
= SBYTES (obj
);
1480 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1482 /* Here, we must convert each multi-byte form to the
1483 corresponding character code before handing it to PRINTCHAR. */
1489 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
,
1490 size_byte
- i_byte
, len
);
1491 if (CHAR_VALID_P (c
, 0))
1501 if (c
== '\n' && print_escape_newlines
)
1506 else if (c
== '\f' && print_escape_newlines
)
1512 && ! ASCII_BYTE_P (c
)
1513 && (SINGLE_BYTE_CHAR_P (c
) || print_escape_multibyte
))
1515 /* When multibyte is disabled,
1516 print multibyte string chars using hex escapes.
1517 For a char code that could be in a unibyte string,
1518 when found in a multibyte string, always use a hex escape
1519 so it reads back as multibyte. */
1520 unsigned char outbuf
[50];
1521 sprintf (outbuf
, "\\x%x", c
);
1522 strout (outbuf
, -1, -1, printcharfun
, 0);
1525 else if (! multibyte
1526 && SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1527 && print_escape_nonascii
)
1529 /* When printing in a multibyte buffer
1530 or when explicitly requested,
1531 print single-byte non-ASCII string chars
1532 using octal escapes. */
1533 unsigned char outbuf
[5];
1534 sprintf (outbuf
, "\\%03o", c
);
1535 strout (outbuf
, -1, -1, printcharfun
, 0);
1539 /* If we just had a hex escape, and this character
1540 could be taken as part of it,
1541 output `\ ' to prevent that. */
1545 if ((c
>= 'a' && c
<= 'f')
1546 || (c
>= 'A' && c
<= 'F')
1547 || (c
>= '0' && c
<= '9'))
1548 strout ("\\ ", -1, -1, printcharfun
, 0);
1551 if (c
== '\"' || c
== '\\')
1558 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj
)))
1560 traverse_intervals (STRING_INTERVALS (obj
),
1561 0, print_interval
, printcharfun
);
1571 register int confusing
;
1572 register unsigned char *p
= SDATA (SYMBOL_NAME (obj
));
1573 register unsigned char *end
= p
+ SBYTES (SYMBOL_NAME (obj
));
1575 int i
, i_byte
, size_byte
;
1578 name
= SYMBOL_NAME (obj
);
1580 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1583 /* If symbol name begins with a digit, and ends with a digit,
1584 and contains nothing but digits and `e', it could be treated
1585 as a number. So set CONFUSING.
1587 Symbols that contain periods could also be taken as numbers,
1588 but periods are always escaped, so we don't have to worry
1590 else if (*p
>= '0' && *p
<= '9'
1591 && end
[-1] >= '0' && end
[-1] <= '9')
1593 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1594 /* Needed for \2e10. */
1597 confusing
= (end
== p
);
1602 if (! NILP (Vprint_gensym
) && !SYMBOL_INTERNED_P (obj
))
1608 size_byte
= SBYTES (name
);
1610 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1612 /* Here, we must convert each multi-byte form to the
1613 corresponding character code before handing it to PRINTCHAR. */
1614 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1619 if (c
== '\"' || c
== '\\' || c
== '\''
1620 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1621 || c
== ',' || c
=='.' || c
== '`'
1622 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1624 PRINTCHAR ('\\'), confusing
= 0;
1632 /* If deeper than spec'd depth, print placeholder. */
1633 if (INTEGERP (Vprint_level
)
1634 && print_depth
> XINT (Vprint_level
))
1635 strout ("...", -1, -1, printcharfun
, 0);
1636 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1637 && (EQ (XCAR (obj
), Qquote
)))
1640 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1642 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1643 && (EQ (XCAR (obj
), Qfunction
)))
1647 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1649 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1650 && ! old_backquote_output
1651 && ((EQ (XCAR (obj
), Qbackquote
)
1652 || EQ (XCAR (obj
), Qcomma
)
1653 || EQ (XCAR (obj
), Qcomma_at
)
1654 || EQ (XCAR (obj
), Qcomma_dot
))))
1656 print_object (XCAR (obj
), printcharfun
, 0);
1657 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1663 /* If the first element is a backquote form,
1664 print it old-style so it won't be misunderstood. */
1665 if (print_quoted
&& CONSP (XCAR (obj
))
1666 && CONSP (XCDR (XCAR (obj
)))
1667 && NILP (XCDR (XCDR (XCAR (obj
))))
1668 && EQ (XCAR (XCAR (obj
)), Qbackquote
))
1674 print_object (Qbackquote
, printcharfun
, 0);
1677 ++old_backquote_output
;
1678 print_object (XCAR (XCDR (tem
)), printcharfun
, 0);
1679 --old_backquote_output
;
1686 int print_length
, i
;
1687 Lisp_Object halftail
= obj
;
1689 /* Negative values of print-length are invalid in CL.
1690 Treat them like nil, as CMUCL does. */
1691 if (NATNUMP (Vprint_length
))
1692 print_length
= XFASTINT (Vprint_length
);
1699 /* Detect circular list. */
1700 if (NILP (Vprint_circle
))
1702 /* Simple but imcomplete way. */
1703 if (i
!= 0 && EQ (obj
, halftail
))
1705 sprintf (buf
, " . #%d", i
/ 2);
1706 strout (buf
, -1, -1, printcharfun
, 0);
1712 /* With the print-circle feature. */
1716 for (i
= 0; i
< print_number_index
; i
++)
1717 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
),
1720 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1722 strout (" . ", 3, 3, printcharfun
, 0);
1723 print_object (obj
, printcharfun
, escapeflag
);
1727 sprintf (buf
, " . #%d#", i
+ 1);
1728 strout (buf
, -1, -1, printcharfun
, 0);
1738 if (print_length
&& i
> print_length
)
1740 strout ("...", 3, 3, printcharfun
, 0);
1744 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1748 halftail
= XCDR (halftail
);
1752 /* OBJ non-nil here means it's the end of a dotted list. */
1755 strout (" . ", 3, 3, printcharfun
, 0);
1756 print_object (obj
, printcharfun
, escapeflag
);
1764 case Lisp_Vectorlike
:
1769 strout ("#<process ", -1, -1, printcharfun
, 0);
1770 print_string (XPROCESS (obj
)->name
, printcharfun
);
1774 print_string (XPROCESS (obj
)->name
, printcharfun
);
1776 else if (BOOL_VECTOR_P (obj
))
1779 register unsigned char c
;
1780 struct gcpro gcpro1
;
1782 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1788 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1789 strout (buf
, -1, -1, printcharfun
, 0);
1792 /* Don't print more characters than the specified maximum.
1793 Negative values of print-length are invalid. Treat them
1794 like a print-length of nil. */
1795 if (NATNUMP (Vprint_length
)
1796 && XFASTINT (Vprint_length
) < size_in_chars
)
1797 size_in_chars
= XFASTINT (Vprint_length
);
1799 for (i
= 0; i
< size_in_chars
; i
++)
1802 c
= XBOOL_VECTOR (obj
)->data
[i
];
1803 if (c
== '\n' && print_escape_newlines
)
1808 else if (c
== '\f' && print_escape_newlines
)
1815 if (c
== '\"' || c
== '\\')
1824 else if (SUBRP (obj
))
1826 strout ("#<subr ", -1, -1, printcharfun
, 0);
1827 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1830 else if (WINDOWP (obj
))
1832 strout ("#<window ", -1, -1, printcharfun
, 0);
1833 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1834 strout (buf
, -1, -1, printcharfun
, 0);
1835 if (!NILP (XWINDOW (obj
)->buffer
))
1837 strout (" on ", -1, -1, printcharfun
, 0);
1838 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1842 else if (HASH_TABLE_P (obj
))
1844 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1845 strout ("#<hash-table", -1, -1, printcharfun
, 0);
1846 if (SYMBOLP (h
->test
))
1850 strout (SDATA (SYMBOL_NAME (h
->test
)), -1, -1, printcharfun
, 0);
1852 strout (SDATA (SYMBOL_NAME (h
->weak
)), -1, -1, printcharfun
, 0);
1854 sprintf (buf
, "%d/%d", XFASTINT (h
->count
),
1855 XVECTOR (h
->next
)->size
);
1856 strout (buf
, -1, -1, printcharfun
, 0);
1858 sprintf (buf
, " 0x%lx", (unsigned long) h
);
1859 strout (buf
, -1, -1, printcharfun
, 0);
1862 else if (BUFFERP (obj
))
1864 if (NILP (XBUFFER (obj
)->name
))
1865 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1866 else if (escapeflag
)
1868 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1869 print_string (XBUFFER (obj
)->name
, printcharfun
);
1873 print_string (XBUFFER (obj
)->name
, printcharfun
);
1875 else if (WINDOW_CONFIGURATIONP (obj
))
1877 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1879 else if (FRAMEP (obj
))
1881 strout ((FRAME_LIVE_P (XFRAME (obj
))
1882 ? "#<frame " : "#<dead frame "),
1883 -1, -1, printcharfun
, 0);
1884 print_string (XFRAME (obj
)->name
, printcharfun
);
1885 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
1886 strout (buf
, -1, -1, printcharfun
, 0);
1891 int size
= XVECTOR (obj
)->size
;
1892 if (COMPILEDP (obj
))
1895 size
&= PSEUDOVECTOR_SIZE_MASK
;
1897 if (CHAR_TABLE_P (obj
))
1899 /* We print a char-table as if it were a vector,
1900 lumping the parent and default slots in with the
1901 character slots. But we add #^ as a prefix. */
1904 if (SUB_CHAR_TABLE_P (obj
))
1906 size
&= PSEUDOVECTOR_SIZE_MASK
;
1908 if (size
& PSEUDOVECTOR_FLAG
)
1914 register Lisp_Object tem
;
1915 int real_size
= size
;
1917 /* Don't print more elements than the specified maximum. */
1918 if (NATNUMP (Vprint_length
)
1919 && XFASTINT (Vprint_length
) < size
)
1920 size
= XFASTINT (Vprint_length
);
1922 for (i
= 0; i
< size
; i
++)
1924 if (i
) PRINTCHAR (' ');
1925 tem
= XVECTOR (obj
)->contents
[i
];
1926 print_object (tem
, printcharfun
, escapeflag
);
1928 if (size
< real_size
)
1929 strout (" ...", 4, 4, printcharfun
, 0);
1936 switch (XMISCTYPE (obj
))
1938 case Lisp_Misc_Marker
:
1939 strout ("#<marker ", -1, -1, printcharfun
, 0);
1940 /* Do you think this is necessary? */
1941 if (XMARKER (obj
)->insertion_type
!= 0)
1942 strout ("(moves after insertion) ", -1, -1, printcharfun
, 0);
1943 if (!(XMARKER (obj
)->buffer
))
1944 strout ("in no buffer", -1, -1, printcharfun
, 0);
1947 sprintf (buf
, "at %d", marker_position (obj
));
1948 strout (buf
, -1, -1, printcharfun
, 0);
1949 strout (" in ", -1, -1, printcharfun
, 0);
1950 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1955 case Lisp_Misc_Overlay
:
1956 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1957 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1958 strout ("in no buffer", -1, -1, printcharfun
, 0);
1961 sprintf (buf
, "from %d to %d in ",
1962 marker_position (OVERLAY_START (obj
)),
1963 marker_position (OVERLAY_END (obj
)));
1964 strout (buf
, -1, -1, printcharfun
, 0);
1965 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1971 /* Remaining cases shouldn't happen in normal usage, but let's print
1972 them anyway for the benefit of the debugger. */
1973 case Lisp_Misc_Free
:
1974 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1977 case Lisp_Misc_Intfwd
:
1978 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1979 strout (buf
, -1, -1, printcharfun
, 0);
1982 case Lisp_Misc_Boolfwd
:
1983 sprintf (buf
, "#<boolfwd to %s>",
1984 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1985 strout (buf
, -1, -1, printcharfun
, 0);
1988 case Lisp_Misc_Objfwd
:
1989 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
1990 print_object (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1994 case Lisp_Misc_Buffer_Objfwd
:
1995 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
1996 print_object (PER_BUFFER_VALUE (current_buffer
,
1997 XBUFFER_OBJFWD (obj
)->offset
),
1998 printcharfun
, escapeflag
);
2002 case Lisp_Misc_Kboard_Objfwd
:
2003 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
2004 print_object (*(Lisp_Object
*)((char *) current_kboard
2005 + XKBOARD_OBJFWD (obj
)->offset
),
2006 printcharfun
, escapeflag
);
2010 case Lisp_Misc_Buffer_Local_Value
:
2011 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
2012 goto do_buffer_local
;
2013 case Lisp_Misc_Some_Buffer_Local_Value
:
2014 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
2016 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
2017 print_object (XBUFFER_LOCAL_VALUE (obj
)->realvalue
,
2018 printcharfun
, escapeflag
);
2019 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
2020 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
2022 strout ("[buffer] ", -1, -1, printcharfun
, 0);
2023 print_object (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
2024 printcharfun
, escapeflag
);
2025 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
2027 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
2028 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
2030 strout ("[frame] ", -1, -1, printcharfun
, 0);
2031 print_object (XBUFFER_LOCAL_VALUE (obj
)->frame
,
2032 printcharfun
, escapeflag
);
2034 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
2035 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2036 printcharfun
, escapeflag
);
2037 strout ("[default-value] ", -1, -1, printcharfun
, 0);
2038 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
2039 printcharfun
, escapeflag
);
2051 /* We're in trouble if this happens!
2052 Probably should just abort () */
2053 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
2055 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
2056 else if (VECTORLIKEP (obj
))
2057 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
2059 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
2060 strout (buf
, -1, -1, printcharfun
, 0);
2061 strout (" Save your buffers immediately and please report this bug>",
2062 -1, -1, printcharfun
, 0);
2070 /* Print a description of INTERVAL using PRINTCHARFUN.
2071 This is part of printing a string that has text properties. */
2074 print_interval (interval
, printcharfun
)
2076 Lisp_Object printcharfun
;
2079 print_object (make_number (interval
->position
), printcharfun
, 1);
2081 print_object (make_number (interval
->position
+ LENGTH (interval
)),
2084 print_object (interval
->plist
, printcharfun
, 1);
2091 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
2092 staticpro (&Qtemp_buffer_setup_hook
);
2094 DEFVAR_LISP ("standard-output", &Vstandard_output
,
2095 doc
: /* Output stream `print' uses by default for outputting a character.
2096 This may be any function of one argument.
2097 It may also be a buffer (output is inserted before point)
2098 or a marker (output is inserted and the marker is advanced)
2099 or the symbol t (output appears in the echo area). */);
2100 Vstandard_output
= Qt
;
2101 Qstandard_output
= intern ("standard-output");
2102 staticpro (&Qstandard_output
);
2104 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
2105 doc
: /* The format descriptor string used to print floats.
2106 This is a %-spec like those accepted by `printf' in C,
2107 but with some restrictions. It must start with the two characters `%.'.
2108 After that comes an integer precision specification,
2109 and then a letter which controls the format.
2110 The letters allowed are `e', `f' and `g'.
2111 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2112 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2113 Use `g' to choose the shorter of those two formats for the number at hand.
2114 The precision in any of these cases is the number of digits following
2115 the decimal point. With `f', a precision of 0 means to omit the
2116 decimal point. 0 is not allowed with `e' or `g'.
2118 A value of nil means to use the shortest notation
2119 that represents the number without losing information. */);
2120 Vfloat_output_format
= Qnil
;
2121 Qfloat_output_format
= intern ("float-output-format");
2122 staticpro (&Qfloat_output_format
);
2124 DEFVAR_LISP ("print-length", &Vprint_length
,
2125 doc
: /* Maximum length of list to print before abbreviating.
2126 A value of nil means no limit. See also `eval-expression-print-length'. */);
2127 Vprint_length
= Qnil
;
2129 DEFVAR_LISP ("print-level", &Vprint_level
,
2130 doc
: /* Maximum depth of list nesting to print before abbreviating.
2131 A value of nil means no limit. See also `eval-expression-print-level'. */);
2132 Vprint_level
= Qnil
;
2134 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
2135 doc
: /* Non-nil means print newlines in strings as `\\n'.
2136 Also print formfeeds as `\\f'. */);
2137 print_escape_newlines
= 0;
2139 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
2140 doc
: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2141 \(OOO is the octal representation of the character code.)
2142 Only single-byte characters are affected, and only in `prin1'.
2143 When the output goes in a multibyte buffer, this feature is
2144 enabled regardless of the value of the variable. */);
2145 print_escape_nonascii
= 0;
2147 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
2148 doc
: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2149 \(XXXX is the hex representation of the character code.)
2150 This affects only `prin1'. */);
2151 print_escape_multibyte
= 0;
2153 DEFVAR_BOOL ("print-quoted", &print_quoted
,
2154 doc
: /* Non-nil means print quoted forms with reader syntax.
2155 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2156 forms print as in the new syntax. */);
2159 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
2160 doc
: /* Non-nil means print uninterned symbols so they will read as uninterned.
2161 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2162 When the uninterned symbol appears within a recursive data structure,
2163 and the symbol appears more than once, in addition use the #N# and #N=
2164 constructs as needed, so that multiple references to the same symbol are
2165 shared once again when the text is read back. */);
2166 Vprint_gensym
= Qnil
;
2168 DEFVAR_LISP ("print-circle", &Vprint_circle
,
2169 doc
: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2170 If nil, printing proceeds recursively and may lead to
2171 `max-lisp-eval-depth' being exceeded or an error may occur:
2172 \"Apparently circular structure being printed.\" Also see
2173 `print-length' and `print-level'.
2174 If non-nil, shared substructures anywhere in the structure are printed
2175 with `#N=' before the first occurrence (in the order of the print
2176 representation) and `#N#' in place of each subsequent occurrence,
2177 where N is a positive decimal integer. */);
2178 Vprint_circle
= Qnil
;
2180 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
2181 doc
: /* *Non-nil means number continuously across print calls.
2182 This affects the numbers printed for #N= labels and #M# references.
2183 See also `print-circle', `print-gensym', and `print-number-table'.
2184 This variable should not be set with `setq'; bind it with a `let' instead. */);
2185 Vprint_continuous_numbering
= Qnil
;
2187 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
2188 doc
: /* A vector used internally to produce `#N=' labels and `#N#' references.
2189 The Lisp printer uses this vector to detect Lisp objects referenced more
2192 When you bind `print-continuous-numbering' to t, you should probably
2193 also bind `print-number-table' to nil. This ensures that the value of
2194 `print-number-table' can be garbage-collected once the printing is
2195 done. If all elements of `print-number-table' are nil, it means that
2196 the printing done so far has not found any shared structure or objects
2197 that need to be recorded in the table. */);
2198 Vprint_number_table
= Qnil
;
2200 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2201 staticpro (&Vprin1_to_string_buffer
);
2204 defsubr (&Sprin1_to_string
);
2205 defsubr (&Serror_message_string
);
2209 defsubr (&Swrite_char
);
2210 defsubr (&Sexternal_debugging_output
);
2211 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2212 defsubr (&Sredirect_debugging_output
);
2215 Qexternal_debugging_output
= intern ("external-debugging-output");
2216 staticpro (&Qexternal_debugging_output
);
2218 Qprint_escape_newlines
= intern ("print-escape-newlines");
2219 staticpro (&Qprint_escape_newlines
);
2221 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
2222 staticpro (&Qprint_escape_multibyte
);
2224 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
2225 staticpro (&Qprint_escape_nonascii
);
2227 defsubr (&Swith_output_to_temp_buffer
);
2230 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2231 (do not change this comment) */