1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 1998
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
31 #include "dispextern.h"
35 #ifdef USE_TEXT_PROPERTIES
36 #include "intervals.h"
39 Lisp_Object Vstandard_output
, Qstandard_output
;
41 Lisp_Object Qtemp_buffer_setup_hook
;
43 /* These are used to print like we read. */
44 extern Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
46 #ifdef LISP_FLOAT_TYPE
47 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
49 /* Work around a problem that happens because math.h on hpux 7
50 defines two static variables--which, in Emacs, are not really static,
51 because `static' is defined as nothing. The problem is that they are
52 defined both here and in lread.c.
53 These macros prevent the name conflict. */
54 #if defined (HPUX) && !defined (HPUX8)
55 #define _MAXLDBL print_maxldbl
56 #define _NMAXLDBL print_nmaxldbl
66 /* Default to values appropriate for IEEE floating point. */
71 #define DBL_MANT_DIG 53
77 #define DBL_MIN 2.2250738585072014e-308
80 #ifdef DBL_MIN_REPLACEMENT
82 #define DBL_MIN DBL_MIN_REPLACEMENT
85 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
86 needed to express a float without losing information.
87 The general-case formula is valid for the usual case, IEEE floating point,
88 but many compilers can't optimize the formula to an integer constant,
89 so make a special case for it. */
90 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
91 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
93 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
96 #endif /* LISP_FLOAT_TYPE */
98 /* Avoid actual stack overflow in print. */
101 /* Detect most circularities to print finite output. */
102 #define PRINT_CIRCLE 200
103 Lisp_Object being_printed
[PRINT_CIRCLE
];
105 /* When printing into a buffer, first we put the text in this
106 block, then insert it all at once. */
109 /* Size allocated in print_buffer. */
110 int print_buffer_size
;
111 /* Chars stored in print_buffer. */
112 int print_buffer_pos
;
113 /* Bytes stored in print_buffer. */
114 int print_buffer_pos_byte
;
116 /* Maximum length of list to print in full; noninteger means
117 effectively infinity */
119 Lisp_Object Vprint_length
;
121 /* Maximum depth of list to print in full; noninteger means
122 effectively infinity. */
124 Lisp_Object Vprint_level
;
126 /* Nonzero means print newlines in strings as \n. */
128 int print_escape_newlines
;
130 /* Nonzero means to print single-byte non-ascii characters in strings as
133 int print_escape_nonascii
;
135 /* Nonzero means to print multibyte characters in strings as hex escapes. */
137 int print_escape_multibyte
;
139 Lisp_Object Qprint_escape_newlines
;
140 Lisp_Object Qprint_escape_multibyte
, Qprint_escape_nonascii
;
142 /* Nonzero means print (quote foo) forms as 'foo, etc. */
146 /* Non-nil means print #: before uninterned symbols. */
148 Lisp_Object Vprint_gensym
;
150 /* Non-nil means print recursive structures using #n= and #n# syntax. */
152 Lisp_Object Vprint_circle
;
154 /* Non-nil means keep continuous number for #n= and #n# syntax
155 between several print functions. */
157 Lisp_Object Vprint_continuous_numbering
;
159 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
160 where OBJn are objects going to be printed, and STATn are their status,
161 which may be different meanings during process. See the comments of
162 the functions print and print_preprocess for details.
163 print_number_index keeps the last position the next object should be added,
164 twice of which is the actual vector position in Vprint_number_table. */
165 int print_number_index
;
166 Lisp_Object Vprint_number_table
;
168 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
169 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
170 See the comment of the variable Vprint_number_table. */
171 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
172 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
174 /* Nonzero means print newline to stdout before next minibuffer message.
175 Defined in xdisp.c */
177 extern int noninteractive_need_newline
;
179 extern int minibuffer_auto_raise
;
181 #ifdef MAX_PRINT_CHARS
182 static int print_chars
;
183 static int max_print
;
184 #endif /* MAX_PRINT_CHARS */
186 void print_interval ();
189 /* Low level output routines for characters and strings */
191 /* Lisp functions to do output using a stream
192 must have the stream in a variable called printcharfun
193 and must start with PRINTPREPARE, end with PRINTFINISH,
194 and use PRINTDECLARE to declare common variables.
195 Use PRINTCHAR to output one character,
196 or call strout to output a block of characters. */
198 #define PRINTDECLARE \
199 struct buffer *old = current_buffer; \
200 int old_point = -1, start_point; \
201 int old_point_byte, start_point_byte; \
202 int specpdl_count = specpdl_ptr - specpdl; \
203 int free_print_buffer = 0; \
204 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
207 #define PRINTPREPARE \
208 original = printcharfun; \
209 if (NILP (printcharfun)) printcharfun = Qt; \
210 if (BUFFERP (printcharfun)) \
212 if (XBUFFER (printcharfun) != current_buffer) \
213 Fset_buffer (printcharfun); \
214 printcharfun = Qnil; \
216 if (MARKERP (printcharfun)) \
218 if (!(XMARKER (original)->buffer)) \
219 error ("Marker does not point anywhere"); \
220 if (XMARKER (original)->buffer != current_buffer) \
221 set_buffer_internal (XMARKER (original)->buffer); \
223 old_point_byte = PT_BYTE; \
224 SET_PT_BOTH (marker_position (printcharfun), \
225 marker_byte_position (printcharfun)); \
227 start_point_byte = PT_BYTE; \
228 printcharfun = Qnil; \
230 if (NILP (printcharfun)) \
232 Lisp_Object string; \
233 if (NILP (current_buffer->enable_multibyte_characters) \
234 && ! print_escape_multibyte) \
235 specbind (Qprint_escape_multibyte, Qt); \
236 if (! NILP (current_buffer->enable_multibyte_characters) \
237 && ! print_escape_nonascii) \
238 specbind (Qprint_escape_nonascii, Qt); \
239 if (print_buffer != 0) \
241 string = make_string_from_bytes (print_buffer, \
243 print_buffer_pos_byte); \
244 record_unwind_protect (print_unwind, string); \
248 print_buffer_size = 1000; \
249 print_buffer = (char *) xmalloc (print_buffer_size); \
250 free_print_buffer = 1; \
252 print_buffer_pos = 0; \
253 print_buffer_pos_byte = 0; \
255 if (EQ (printcharfun, Qt)) \
256 setup_echo_area_for_printing (multibyte);
258 #define PRINTFINISH \
259 if (NILP (printcharfun)) \
261 if (print_buffer_pos != print_buffer_pos_byte \
262 && NILP (current_buffer->enable_multibyte_characters)) \
264 unsigned char *temp \
265 = (unsigned char *) alloca (print_buffer_pos + 1); \
266 copy_text (print_buffer, temp, print_buffer_pos_byte, \
268 insert_1_both (temp, print_buffer_pos, \
269 print_buffer_pos, 0, 1, 0); \
272 insert_1_both (print_buffer, print_buffer_pos, \
273 print_buffer_pos_byte, 0, 1, 0); \
275 if (free_print_buffer) \
277 xfree (print_buffer); \
280 unbind_to (specpdl_count, Qnil); \
281 if (MARKERP (original)) \
282 set_marker_both (original, Qnil, PT, PT_BYTE); \
283 if (old_point >= 0) \
284 SET_PT_BOTH (old_point + (old_point >= start_point \
285 ? PT - start_point : 0), \
286 old_point_byte + (old_point_byte >= start_point_byte \
287 ? PT_BYTE - start_point_byte : 0)); \
288 if (old != current_buffer) \
289 set_buffer_internal (old);
291 #define PRINTCHAR(ch) printchar (ch, printcharfun)
293 /* This is used to restore the saved contents of print_buffer
294 when there is a recursive call to print. */
297 print_unwind (saved_text
)
298 Lisp_Object saved_text
;
300 bcopy (XSTRING (saved_text
)->data
, print_buffer
, XSTRING (saved_text
)->size
);
304 /* Print character CH using method FUN. FUN nil means print to
305 print_buffer. FUN t means print to echo area or stdout if
306 non-interactive. If FUN is neither nil nor t, call FUN with CH as
314 #ifdef MAX_PRINT_CHARS
317 #endif /* MAX_PRINT_CHARS */
319 if (!NILP (fun
) && !EQ (fun
, Qt
))
320 call1 (fun
, make_number (ch
));
323 unsigned char work
[4], *str
;
324 int len
= CHAR_STRING (ch
, work
, str
);
330 if (print_buffer_pos_byte
+ len
>= print_buffer_size
)
331 print_buffer
= (char *) xrealloc (print_buffer
,
332 print_buffer_size
*= 2);
333 bcopy (str
, print_buffer
+ print_buffer_pos_byte
, len
);
334 print_buffer_pos
+= 1;
335 print_buffer_pos_byte
+= len
;
337 else if (noninteractive
)
339 fwrite (str
, 1, len
, stdout
);
340 noninteractive_need_newline
= 1;
345 = !NILP (current_buffer
->enable_multibyte_characters
);
347 if (!message_buf_print
)
348 setup_echo_area_for_printing (multibyte_p
);
351 message_dolog (str
, len
, 0, multibyte_p
);
357 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
358 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
359 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
360 print_buffer. PRINTCHARFUN t means output to the echo area or to
361 stdout if non-interactive. If neither nil nor t, call Lisp
362 function PRINTCHARFUN for each character printed. MULTIBYTE
363 non-zero means PTR contains multibyte characters. */
366 strout (ptr
, size
, size_byte
, printcharfun
, multibyte
)
369 Lisp_Object printcharfun
;
373 size_byte
= size
= strlen (ptr
);
375 if (NILP (printcharfun
))
377 if (print_buffer_pos_byte
+ size_byte
> print_buffer_size
)
379 print_buffer_size
= print_buffer_size
* 2 + size_byte
;
380 print_buffer
= (char *) xrealloc (print_buffer
,
383 bcopy (ptr
, print_buffer
+ print_buffer_pos_byte
, size_byte
);
384 print_buffer_pos
+= size
;
385 print_buffer_pos_byte
+= size_byte
;
387 #ifdef MAX_PRINT_CHARS
390 #endif /* MAX_PRINT_CHARS */
392 else if (noninteractive
)
394 fwrite (ptr
, 1, size_byte
, stdout
);
395 noninteractive_need_newline
= 1;
397 else if (EQ (printcharfun
, Qt
))
399 /* Output to echo area. We're trying to avoid a little overhead
400 here, that's the reason we don't call printchar to do the
404 = !NILP (current_buffer
->enable_multibyte_characters
);
406 if (!message_buf_print
)
407 setup_echo_area_for_printing (multibyte_p
);
409 message_dolog (ptr
, size_byte
, 0, multibyte_p
);
411 if (size
== size_byte
)
413 for (i
= 0; i
< size
; ++i
)
414 insert_char (*ptr
++);
419 for (i
= 0; i
< size_byte
; i
+= len
)
421 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
426 #ifdef MAX_PRINT_CHARS
429 #endif /* MAX_PRINT_CHARS */
433 /* PRINTCHARFUN is a Lisp function. */
436 if (size
== size_byte
)
438 while (i
< size_byte
)
446 while (i
< size_byte
)
448 /* Here, we must convert each multi-byte form to the
449 corresponding character code before handing it to
452 int ch
= STRING_CHAR_AND_LENGTH (ptr
+ i
, size_byte
- i
, len
);
460 /* Print the contents of a string STRING using PRINTCHARFUN.
461 It isn't safe to use strout in many cases,
462 because printing one char can relocate. */
465 print_string (string
, printcharfun
)
467 Lisp_Object printcharfun
;
469 if (EQ (printcharfun
, Qt
) || NILP (printcharfun
))
473 if (STRING_MULTIBYTE (string
))
474 chars
= XSTRING (string
)->size
;
475 else if (EQ (printcharfun
, Qt
)
476 ? ! NILP (buffer_defaults
.enable_multibyte_characters
)
477 : ! NILP (current_buffer
->enable_multibyte_characters
))
478 chars
= multibyte_chars_in_text (XSTRING (string
)->data
,
479 STRING_BYTES (XSTRING (string
)));
481 chars
= STRING_BYTES (XSTRING (string
));
483 /* strout is safe for output to a frame (echo area) or to print_buffer. */
484 strout (XSTRING (string
)->data
,
485 chars
, STRING_BYTES (XSTRING (string
)),
486 printcharfun
, STRING_MULTIBYTE (string
));
490 /* Otherwise, string may be relocated by printing one char.
491 So re-fetch the string address for each character. */
493 int size
= XSTRING (string
)->size
;
494 int size_byte
= STRING_BYTES (XSTRING (string
));
497 if (size
== size_byte
)
498 for (i
= 0; i
< size
; i
++)
499 PRINTCHAR (XSTRING (string
)->data
[i
]);
501 for (i
= 0; i
< size_byte
; i
++)
503 /* Here, we must convert each multi-byte form to the
504 corresponding character code before handing it to PRINTCHAR. */
506 int ch
= STRING_CHAR_AND_LENGTH (XSTRING (string
)->data
+ i
,
508 if (!CHAR_VALID_P (ch
, 0))
510 ch
= XSTRING (string
)->data
[i
];
520 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
521 "Output character CHARACTER to stream PRINTCHARFUN.\n\
522 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
523 (character
, printcharfun
)
524 Lisp_Object character
, printcharfun
;
528 if (NILP (printcharfun
))
529 printcharfun
= Vstandard_output
;
530 CHECK_NUMBER (character
, 0);
532 PRINTCHAR (XINT (character
));
537 /* Used from outside of print.c to print a block of SIZE
538 single-byte chars at DATA on the default output stream.
539 Do not use this on the contents of a Lisp string. */
542 write_string (data
, size
)
547 Lisp_Object printcharfun
;
549 printcharfun
= Vstandard_output
;
552 strout (data
, size
, size
, printcharfun
, 0);
556 /* Used from outside of print.c to print a block of SIZE
557 single-byte chars at DATA on a specified stream PRINTCHARFUN.
558 Do not use this on the contents of a Lisp string. */
561 write_string_1 (data
, size
, printcharfun
)
564 Lisp_Object printcharfun
;
569 strout (data
, size
, size
, printcharfun
, 0);
575 temp_output_buffer_setup (bufname
)
578 int count
= specpdl_ptr
- specpdl
;
579 register struct buffer
*old
= current_buffer
;
580 register Lisp_Object buf
;
582 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
584 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
586 current_buffer
->directory
= old
->directory
;
587 current_buffer
->read_only
= Qnil
;
588 current_buffer
->filename
= Qnil
;
589 current_buffer
->undo_list
= Qt
;
590 current_buffer
->overlays_before
= Qnil
;
591 current_buffer
->overlays_after
= Qnil
;
592 current_buffer
->enable_multibyte_characters
593 = buffer_defaults
.enable_multibyte_characters
;
595 XSETBUFFER (buf
, current_buffer
);
597 call1 (Vrun_hooks
, Qtemp_buffer_setup_hook
);
599 unbind_to (count
, Qnil
);
601 specbind (Qstandard_output
, buf
);
605 internal_with_output_to_temp_buffer (bufname
, function
, args
)
607 Lisp_Object (*function
) P_ ((Lisp_Object
));
610 int count
= specpdl_ptr
- specpdl
;
611 Lisp_Object buf
, val
;
615 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
616 temp_output_buffer_setup (bufname
);
617 buf
= Vstandard_output
;
620 val
= (*function
) (args
);
623 temp_output_buffer_show (buf
);
626 return unbind_to (count
, val
);
629 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
631 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
632 The buffer is cleared out initially, and marked as unmodified when done.\n\
633 All output done by BODY is inserted in that buffer by default.\n\
634 The buffer is displayed in another window, but not selected.\n\
635 The value of the last form in BODY is returned.\n\
636 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\
638 The hook `temp-buffer-setup-hook' is run before BODY,\n\
639 with the buffer BUFNAME temporarily current.\n\
640 The hook `temp-buffer-show-hook' is run after the buffer is displayed,\n\
641 with the buffer temporarily current, and the window that was used\n\
642 to display it temporarily selected.\n\
644 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
645 to get the buffer displayed instead of just displaying the non-selected\n\
646 buffer and calling the hook. It gets one argument, the buffer to display.")
652 int count
= specpdl_ptr
- specpdl
;
653 Lisp_Object buf
, val
;
656 name
= Feval (Fcar (args
));
659 CHECK_STRING (name
, 0);
660 temp_output_buffer_setup (XSTRING (name
)->data
);
661 buf
= Vstandard_output
;
663 val
= Fprogn (Fcdr (args
));
665 temp_output_buffer_show (buf
);
667 return unbind_to (count
, val
);
671 static void print ();
672 static void print_preprocess ();
673 #ifdef USE_TEXT_PROPERTIES
674 static void print_preprocess_string ();
675 #endif /* USE_TEXT_PROPERTIES */
676 static void print_object ();
678 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
679 "Output a newline to stream PRINTCHARFUN.\n\
680 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
682 Lisp_Object printcharfun
;
686 if (NILP (printcharfun
))
687 printcharfun
= Vstandard_output
;
694 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
695 "Output the printed representation of OBJECT, any Lisp object.\n\
696 Quoting characters are printed when needed to make output that `read'\n\
697 can handle, whenever this is possible.\n\
698 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
699 (object
, printcharfun
)
700 Lisp_Object object
, printcharfun
;
704 #ifdef MAX_PRINT_CHARS
706 #endif /* MAX_PRINT_CHARS */
707 if (NILP (printcharfun
))
708 printcharfun
= Vstandard_output
;
710 print (object
, printcharfun
, 1);
715 /* a buffer which is used to hold output being built by prin1-to-string */
716 Lisp_Object Vprin1_to_string_buffer
;
718 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
719 "Return a string containing the printed representation of OBJECT,\n\
720 any Lisp object. Quoting characters are used when needed to make output\n\
721 that `read' can handle, whenever this is possible, unless the optional\n\
722 second argument NOESCAPE is non-nil.")
724 Lisp_Object object
, noescape
;
727 Lisp_Object printcharfun
;
728 struct gcpro gcpro1
, gcpro2
;
731 /* Save and restore this--we are altering a buffer
732 but we don't want to deactivate the mark just for that.
733 No need for specbind, since errors deactivate the mark. */
734 tem
= Vdeactivate_mark
;
735 GCPRO2 (object
, tem
);
737 printcharfun
= Vprin1_to_string_buffer
;
739 print (object
, printcharfun
, NILP (noescape
));
740 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
742 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
743 object
= Fbuffer_string ();
746 set_buffer_internal (old
);
748 Vdeactivate_mark
= tem
;
754 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
755 "Output the printed representation of OBJECT, any Lisp object.\n\
756 No quoting characters are used; no delimiters are printed around\n\
757 the contents of strings.\n\
758 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
759 (object
, printcharfun
)
760 Lisp_Object object
, printcharfun
;
764 if (NILP (printcharfun
))
765 printcharfun
= Vstandard_output
;
767 print (object
, printcharfun
, 0);
772 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
773 "Output the printed representation of OBJECT, with newlines around it.\n\
774 Quoting characters are printed when needed to make output that `read'\n\
775 can handle, whenever this is possible.\n\
776 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
777 (object
, printcharfun
)
778 Lisp_Object object
, printcharfun
;
783 #ifdef MAX_PRINT_CHARS
785 max_print
= MAX_PRINT_CHARS
;
786 #endif /* MAX_PRINT_CHARS */
787 if (NILP (printcharfun
))
788 printcharfun
= Vstandard_output
;
792 print (object
, printcharfun
, 1);
795 #ifdef MAX_PRINT_CHARS
798 #endif /* MAX_PRINT_CHARS */
803 /* The subroutine object for external-debugging-output is kept here
804 for the convenience of the debugger. */
805 Lisp_Object Qexternal_debugging_output
;
807 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
808 "Write CHARACTER to stderr.\n\
809 You can call print while debugging emacs, and pass it this function\n\
810 to make it write to the debugging output.\n")
812 Lisp_Object character
;
814 CHECK_NUMBER (character
, 0);
815 putc (XINT (character
), stderr
);
818 /* Send the output to a debugger (nothing happens if there isn't one). */
820 char buf
[2] = {(char) XINT (character
), '\0'};
821 OutputDebugString (buf
);
828 /* This is the interface for debugging printing. */
834 Fprin1 (arg
, Qexternal_debugging_output
);
835 fprintf (stderr
, "\r\n");
838 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
840 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
844 struct buffer
*old
= current_buffer
;
848 /* If OBJ is (error STRING), just return STRING.
849 That is not only faster, it also avoids the need to allocate
850 space here when the error is due to memory full. */
851 if (CONSP (obj
) && EQ (XCAR (obj
), Qerror
)
852 && CONSP (XCDR (obj
))
853 && STRINGP (XCAR (XCDR (obj
)))
854 && NILP (XCDR (XCDR (obj
))))
855 return XCAR (XCDR (obj
));
857 print_error_message (obj
, Vprin1_to_string_buffer
);
859 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
860 value
= Fbuffer_string ();
864 set_buffer_internal (old
);
870 /* Print an error message for the error DATA
871 onto Lisp output stream STREAM (suitable for the print functions). */
874 print_error_message (data
, stream
)
875 Lisp_Object data
, stream
;
877 Lisp_Object errname
, errmsg
, file_error
, tail
;
881 errname
= Fcar (data
);
883 if (EQ (errname
, Qerror
))
886 if (!CONSP (data
)) data
= Qnil
;
887 errmsg
= Fcar (data
);
892 errmsg
= Fget (errname
, Qerror_message
);
893 file_error
= Fmemq (Qfile_error
,
894 Fget (errname
, Qerror_conditions
));
897 /* Print an error message including the data items. */
899 tail
= Fcdr_safe (data
);
902 /* For file-error, make error message by concatenating
903 all the data items. They are all strings. */
904 if (!NILP (file_error
) && CONSP (tail
))
905 errmsg
= XCAR (tail
), tail
= XCDR (tail
);
907 if (STRINGP (errmsg
))
908 Fprinc (errmsg
, stream
);
910 write_string_1 ("peculiar error", -1, stream
);
912 for (i
= 0; CONSP (tail
); tail
= Fcdr (tail
), i
++)
914 write_string_1 (i
? ", " : ": ", 2, stream
);
915 if (!NILP (file_error
))
916 Fprinc (Fcar (tail
), stream
);
918 Fprin1 (Fcar (tail
), stream
);
923 #ifdef LISP_FLOAT_TYPE
926 * The buffer should be at least as large as the max string size of the
927 * largest float, printed in the biggest notation. This is undoubtedly
928 * 20d float_output_format, with the negative of the C-constant "HUGE"
931 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
933 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
934 * case of -1e307 in 20d float_output_format. What is one to do (short of
935 * re-writing _doprnt to be more sane)?
940 float_to_string (buf
, data
)
947 /* Check for plus infinity in a way that won't lose
948 if there is no plus infinity. */
949 if (data
== data
/ 2 && data
> 1.0)
951 strcpy (buf
, "1.0e+INF");
954 /* Likewise for minus infinity. */
955 if (data
== data
/ 2 && data
< -1.0)
957 strcpy (buf
, "-1.0e+INF");
960 /* Check for NaN in a way that won't fail if there are no NaNs. */
961 if (! (data
* 0.0 >= 0.0))
963 strcpy (buf
, "0.0e+NaN");
967 if (NILP (Vfloat_output_format
)
968 || !STRINGP (Vfloat_output_format
))
971 /* Generate the fewest number of digits that represent the
972 floating point value without losing information.
973 The following method is simple but a bit slow.
974 For ideas about speeding things up, please see:
976 Guy L Steele Jr & Jon L White, How to print floating-point numbers
977 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
979 Robert G Burger & R Kent Dybvig, Printing floating point numbers
980 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
982 width
= fabs (data
) < DBL_MIN
? 1 : DBL_DIG
;
984 sprintf (buf
, "%.*g", width
, data
);
985 while (width
++ < DOUBLE_DIGITS_BOUND
&& atof (buf
) != data
);
989 /* Check that the spec we have is fully valid.
990 This means not only valid for printf,
991 but meant for floats, and reasonable. */
992 cp
= XSTRING (Vfloat_output_format
)->data
;
1001 /* Check the width specification. */
1003 if ('0' <= *cp
&& *cp
<= '9')
1007 width
= (width
* 10) + (*cp
++ - '0');
1008 while (*cp
>= '0' && *cp
<= '9');
1010 /* A precision of zero is valid only for %f. */
1012 || (width
== 0 && *cp
!= 'f'))
1016 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
1022 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
1025 /* Make sure there is a decimal point with digit after, or an
1026 exponent, so that the value is readable as a float. But don't do
1027 this with "%.0f"; it's valid for that not to produce a decimal
1028 point. Note that width can be 0 only for %.0f. */
1031 for (cp
= buf
; *cp
; cp
++)
1032 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
1035 if (*cp
== '.' && cp
[1] == 0)
1049 #endif /* LISP_FLOAT_TYPE */
1052 print (obj
, printcharfun
, escapeflag
)
1054 register Lisp_Object printcharfun
;
1059 /* Reset print_number_index and Vprint_number_table only when
1060 the variable Vprint_continuous_numbering is nil. Otherwise,
1061 the values of these variables will be kept between several
1063 if (NILP (Vprint_continuous_numbering
))
1065 print_number_index
= 0;
1066 Vprint_number_table
= Qnil
;
1069 /* Construct Vprint_number_table for print-gensym and print-circle. */
1070 if (!NILP (Vprint_gensym
) || !NILP (Vprint_circle
))
1073 /* Construct Vprint_number_table. */
1074 print_preprocess (obj
);
1075 /* Remove unnecessary objects, which appear only once in OBJ;
1076 that is, whose status is Qnil. */
1077 for (i
= 0; i
< print_number_index
; i
++)
1078 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1080 PRINT_NUMBER_OBJECT (Vprint_number_table
, index
)
1081 = PRINT_NUMBER_OBJECT (Vprint_number_table
, i
);
1082 /* Reset the status field for the next print step. Now this
1083 field means whether the object has already been printed. */
1084 PRINT_NUMBER_STATUS (Vprint_number_table
, index
) = Qnil
;
1087 print_number_index
= index
;
1090 print_object (obj
, printcharfun
, escapeflag
);
1093 /* Construct Vprint_number_table according to the structure of OBJ.
1094 OBJ itself and all its elements will be added to Vprint_number_table
1095 recursively if it is a list, vector, compiled function, char-table,
1096 string (its text properties will be traced), or a symbol that has
1097 no obarray (this is for the print-gensym feature).
1098 The status fields of Vprint_number_table mean whether each object appears
1099 more than once in OBJ: Qnil at the first time, and Qt after that . */
1101 print_preprocess (obj
)
1107 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1108 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1109 || (! NILP (Vprint_gensym
)
1110 && SYMBOLP (obj
) && NILP (XSYMBOL (obj
)->obarray
)))
1112 for (i
= 0; i
< print_number_index
; i
++)
1113 if (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
) == obj
)
1115 /* OBJ appears more than once. Let's remember that. */
1116 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1120 /* OBJ is not yet recorded. Let's add to the table. */
1121 if (print_number_index
== 0)
1123 /* Initialize the table. */
1124 Vprint_number_table
= Fmake_vector (make_number (40), Qnil
);
1126 else if (XVECTOR (Vprint_number_table
)->size
== print_number_index
* 2)
1128 /* Reallocate the table. */
1129 int i
= print_number_index
* 4;
1130 Lisp_Object old_table
= Vprint_number_table
;
1131 Vprint_number_table
= Fmake_vector (make_number (i
), Qnil
);
1132 for (i
= 0; i
< print_number_index
; i
++)
1134 PRINT_NUMBER_OBJECT (Vprint_number_table
, i
)
1135 = PRINT_NUMBER_OBJECT (old_table
, i
);
1136 PRINT_NUMBER_STATUS (Vprint_number_table
, i
)
1137 = PRINT_NUMBER_STATUS (old_table
, i
);
1140 PRINT_NUMBER_OBJECT (Vprint_number_table
, print_number_index
) = obj
;
1141 print_number_index
++;
1143 switch (XGCTYPE (obj
))
1146 #ifdef USE_TEXT_PROPERTIES
1147 /* A string may have text properties, which can be circular. */
1148 traverse_intervals (XSTRING (obj
)->intervals
, 0, 0,
1149 print_preprocess_string
, Qnil
);
1150 #endif /* USE_TEXT_PROPERTIES */
1154 print_preprocess (XCAR (obj
));
1158 case Lisp_Vectorlike
:
1159 size
= XVECTOR (obj
)->size
& PSEUDOVECTOR_SIZE_MASK
;
1160 for (i
= 0; i
< size
; i
++)
1161 print_preprocess (XVECTOR (obj
)->contents
[i
]);
1166 #ifdef USE_TEXT_PROPERTIES
1168 print_preprocess_string (interval
, arg
)
1172 print_preprocess (interval
->plist
);
1174 #endif /* USE_TEXT_PROPERTIES */
1177 print_object (obj
, printcharfun
, escapeflag
)
1179 register Lisp_Object printcharfun
;
1186 /* Detect circularities and truncate them. */
1187 if (STRINGP (obj
) || CONSP (obj
) || VECTORP (obj
)
1188 || COMPILEDP (obj
) || CHAR_TABLE_P (obj
)
1189 || (! NILP (Vprint_gensym
)
1190 && SYMBOLP (obj
) && NILP (XSYMBOL (obj
)->obarray
)))
1192 if (NILP (Vprint_circle
) && NILP (Vprint_gensym
))
1194 /* Simple but incomplete way. */
1196 for (i
= 0; i
< print_depth
; i
++)
1197 if (EQ (obj
, being_printed
[i
]))
1199 sprintf (buf
, "#%d", i
);
1200 strout (buf
, -1, -1, printcharfun
, 0);
1203 being_printed
[print_depth
] = obj
;
1207 /* With the print-circle feature. */
1209 for (i
= 0; i
< print_number_index
; i
++)
1210 if (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
) == obj
)
1212 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1214 /* Add a prefix #n= if OBJ has not yet been printed;
1215 that is, its status field is nil. */
1216 sprintf (buf
, "#%d=", i
+ 1);
1217 strout (buf
, -1, -1, printcharfun
, 0);
1218 /* OBJ is going to be printed. Set the status to t. */
1219 PRINT_NUMBER_STATUS (Vprint_number_table
, i
) = Qt
;
1224 /* Just print #n# if OBJ has already been printed. */
1225 sprintf (buf
, "#%d#", i
+ 1);
1226 strout (buf
, -1, -1, printcharfun
, 0);
1235 if (print_depth
> PRINT_CIRCLE
)
1236 error ("Apparently circular structure being printed");
1237 #ifdef MAX_PRINT_CHARS
1238 if (max_print
&& print_chars
> max_print
)
1243 #endif /* MAX_PRINT_CHARS */
1245 switch (XGCTYPE (obj
))
1248 if (sizeof (int) == sizeof (EMACS_INT
))
1249 sprintf (buf
, "%d", XINT (obj
));
1250 else if (sizeof (long) == sizeof (EMACS_INT
))
1251 sprintf (buf
, "%ld", (long) XINT (obj
));
1254 strout (buf
, -1, -1, printcharfun
, 0);
1257 #ifdef LISP_FLOAT_TYPE
1260 char pigbuf
[350]; /* see comments in float_to_string */
1262 float_to_string (pigbuf
, XFLOAT_DATA (obj
));
1263 strout (pigbuf
, -1, -1, printcharfun
, 0);
1270 print_string (obj
, printcharfun
);
1273 register int i
, i_byte
;
1274 struct gcpro gcpro1
;
1277 /* 1 means we must ensure that the next character we output
1278 cannot be taken as part of a hex character escape. */
1279 int need_nonhex
= 0;
1283 #ifdef USE_TEXT_PROPERTIES
1284 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1292 str
= XSTRING (obj
)->data
;
1293 size_byte
= STRING_BYTES (XSTRING (obj
));
1295 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1297 /* Here, we must convert each multi-byte form to the
1298 corresponding character code before handing it to PRINTCHAR. */
1302 if (STRING_MULTIBYTE (obj
))
1304 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
,
1305 size_byte
- i_byte
, len
);
1306 if (CHAR_VALID_P (c
, 0))
1316 if (c
== '\n' && print_escape_newlines
)
1321 else if (c
== '\f' && print_escape_newlines
)
1326 else if (! SINGLE_BYTE_CHAR_P (c
) && print_escape_multibyte
)
1328 /* When multibyte is disabled,
1329 print multibyte string chars using hex escapes. */
1330 unsigned char outbuf
[50];
1331 sprintf (outbuf
, "\\x%x", c
);
1332 strout (outbuf
, -1, -1, printcharfun
, 0);
1335 else if (SINGLE_BYTE_CHAR_P (c
) && ! ASCII_BYTE_P (c
)
1336 && print_escape_nonascii
)
1338 /* When printing in a multibyte buffer
1339 or when explicitly requested,
1340 print single-byte non-ASCII string chars
1341 using octal escapes. */
1342 unsigned char outbuf
[5];
1343 sprintf (outbuf
, "\\%03o", c
);
1344 strout (outbuf
, -1, -1, printcharfun
, 0);
1348 /* If we just had a hex escape, and this character
1349 could be taken as part of it,
1350 output `\ ' to prevent that. */
1354 if ((c
>= 'a' && c
<= 'f')
1355 || (c
>= 'A' && c
<= 'F')
1356 || (c
>= '0' && c
<= '9'))
1357 strout ("\\ ", -1, -1, printcharfun
, 0);
1360 if (c
== '\"' || c
== '\\')
1367 #ifdef USE_TEXT_PROPERTIES
1368 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
1370 traverse_intervals (XSTRING (obj
)->intervals
,
1371 0, 0, print_interval
, printcharfun
);
1382 register int confusing
;
1383 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
1384 register unsigned char *end
= p
+ STRING_BYTES (XSYMBOL (obj
)->name
);
1386 int i
, i_byte
, size_byte
;
1389 XSETSTRING (name
, XSYMBOL (obj
)->name
);
1391 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
1394 /* If symbol name begins with a digit, and ends with a digit,
1395 and contains nothing but digits and `e', it could be treated
1396 as a number. So set CONFUSING.
1398 Symbols that contain periods could also be taken as numbers,
1399 but periods are always escaped, so we don't have to worry
1401 else if (*p
>= '0' && *p
<= '9'
1402 && end
[-1] >= '0' && end
[-1] <= '9')
1404 while (p
!= end
&& ((*p
>= '0' && *p
<= '9')
1405 /* Needed for \2e10. */
1408 confusing
= (end
== p
);
1413 if (! NILP (Vprint_gensym
) && NILP (XSYMBOL (obj
)->obarray
))
1419 size_byte
= STRING_BYTES (XSTRING (name
));
1421 for (i
= 0, i_byte
= 0; i_byte
< size_byte
;)
1423 /* Here, we must convert each multi-byte form to the
1424 corresponding character code before handing it to PRINTCHAR. */
1426 if (STRING_MULTIBYTE (name
))
1427 FETCH_STRING_CHAR_ADVANCE (c
, name
, i
, i_byte
);
1429 c
= XSTRING (name
)->data
[i_byte
++];
1435 if (c
== '\"' || c
== '\\' || c
== '\''
1436 || c
== ';' || c
== '#' || c
== '(' || c
== ')'
1437 || c
== ',' || c
=='.' || c
== '`'
1438 || c
== '[' || c
== ']' || c
== '?' || c
<= 040
1440 PRINTCHAR ('\\'), confusing
= 0;
1448 /* If deeper than spec'd depth, print placeholder. */
1449 if (INTEGERP (Vprint_level
)
1450 && print_depth
> XINT (Vprint_level
))
1451 strout ("...", -1, -1, printcharfun
, 0);
1452 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1453 && (EQ (XCAR (obj
), Qquote
)))
1456 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1458 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1459 && (EQ (XCAR (obj
), Qfunction
)))
1463 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1465 else if (print_quoted
&& CONSP (XCDR (obj
)) && NILP (XCDR (XCDR (obj
)))
1466 && ((EQ (XCAR (obj
), Qbackquote
)
1467 || EQ (XCAR (obj
), Qcomma
)
1468 || EQ (XCAR (obj
), Qcomma_at
)
1469 || EQ (XCAR (obj
), Qcomma_dot
))))
1471 print_object (XCAR (obj
), printcharfun
, 0);
1472 print_object (XCAR (XCDR (obj
)), printcharfun
, escapeflag
);
1479 register int print_length
= 0;
1480 Lisp_Object halftail
= obj
;
1482 if (INTEGERP (Vprint_length
))
1483 print_length
= XINT (Vprint_length
);
1486 /* Detect circular list. */
1487 if (NILP (Vprint_circle
))
1489 /* Simple but imcomplete way. */
1490 if (i
!= 0 && EQ (obj
, halftail
))
1492 sprintf (buf
, " . #%d", i
/ 2);
1493 strout (buf
, -1, -1, printcharfun
, 0);
1499 /* With the print-circle feature. */
1503 for (i
= 0; i
< print_number_index
; i
++)
1504 if (PRINT_NUMBER_OBJECT (Vprint_number_table
, i
) == obj
)
1506 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table
, i
)))
1508 strout (" . ", 3, 3, printcharfun
, 0);
1509 print_object (obj
, printcharfun
, escapeflag
);
1513 sprintf (buf
, " . #%d#", i
+ 1);
1514 strout (buf
, -1, -1, printcharfun
, 0);
1522 if (print_length
&& i
> print_length
)
1524 strout ("...", 3, 3, printcharfun
, 0);
1527 print_object (XCAR (obj
), printcharfun
, escapeflag
);
1530 halftail
= XCDR (halftail
);
1535 strout (" . ", 3, 3, printcharfun
, 0);
1536 print_object (obj
, printcharfun
, escapeflag
);
1543 case Lisp_Vectorlike
:
1548 strout ("#<process ", -1, -1, printcharfun
, 0);
1549 print_string (XPROCESS (obj
)->name
, printcharfun
);
1553 print_string (XPROCESS (obj
)->name
, printcharfun
);
1555 else if (BOOL_VECTOR_P (obj
))
1558 register unsigned char c
;
1559 struct gcpro gcpro1
;
1561 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1567 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1568 strout (buf
, -1, -1, printcharfun
, 0);
1571 /* Don't print more characters than the specified maximum. */
1572 if (INTEGERP (Vprint_length
)
1573 && XINT (Vprint_length
) < size_in_chars
)
1574 size_in_chars
= XINT (Vprint_length
);
1576 for (i
= 0; i
< size_in_chars
; i
++)
1579 c
= XBOOL_VECTOR (obj
)->data
[i
];
1580 if (c
== '\n' && print_escape_newlines
)
1585 else if (c
== '\f' && print_escape_newlines
)
1592 if (c
== '\"' || c
== '\\')
1601 else if (SUBRP (obj
))
1603 strout ("#<subr ", -1, -1, printcharfun
, 0);
1604 strout (XSUBR (obj
)->symbol_name
, -1, -1, printcharfun
, 0);
1607 else if (WINDOWP (obj
))
1609 strout ("#<window ", -1, -1, printcharfun
, 0);
1610 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1611 strout (buf
, -1, -1, printcharfun
, 0);
1612 if (!NILP (XWINDOW (obj
)->buffer
))
1614 strout (" on ", -1, -1, printcharfun
, 0);
1615 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1619 else if (HASH_TABLE_P (obj
))
1621 struct Lisp_Hash_Table
*h
= XHASH_TABLE (obj
);
1622 strout ("#<hash-table", -1, -1, printcharfun
, 0);
1623 if (SYMBOLP (h
->test
))
1627 strout (XSYMBOL (h
->test
)->name
->data
, -1, -1, printcharfun
, 0);
1629 strout (XSYMBOL (h
->weak
)->name
->data
, -1, -1, printcharfun
, 0);
1631 sprintf (buf
, "%d/%d", XFASTINT (h
->count
),
1632 XVECTOR (h
->next
)->size
);
1633 strout (buf
, -1, -1, printcharfun
, 0);
1635 sprintf (buf
, " 0x%lx", (unsigned long) h
);
1636 strout (buf
, -1, -1, printcharfun
, 0);
1639 else if (BUFFERP (obj
))
1641 if (NILP (XBUFFER (obj
)->name
))
1642 strout ("#<killed buffer>", -1, -1, printcharfun
, 0);
1643 else if (escapeflag
)
1645 strout ("#<buffer ", -1, -1, printcharfun
, 0);
1646 print_string (XBUFFER (obj
)->name
, printcharfun
);
1650 print_string (XBUFFER (obj
)->name
, printcharfun
);
1652 else if (WINDOW_CONFIGURATIONP (obj
))
1654 strout ("#<window-configuration>", -1, -1, printcharfun
, 0);
1656 else if (FRAMEP (obj
))
1658 strout ((FRAME_LIVE_P (XFRAME (obj
))
1659 ? "#<frame " : "#<dead frame "),
1660 -1, -1, printcharfun
, 0);
1661 print_string (XFRAME (obj
)->name
, printcharfun
);
1662 sprintf (buf
, " 0x%lx\\ ", (unsigned long) (XFRAME (obj
)));
1663 strout (buf
, -1, -1, printcharfun
, 0);
1668 int size
= XVECTOR (obj
)->size
;
1669 if (COMPILEDP (obj
))
1672 size
&= PSEUDOVECTOR_SIZE_MASK
;
1674 if (CHAR_TABLE_P (obj
))
1676 /* We print a char-table as if it were a vector,
1677 lumping the parent and default slots in with the
1678 character slots. But we add #^ as a prefix. */
1681 if (SUB_CHAR_TABLE_P (obj
))
1683 size
&= PSEUDOVECTOR_SIZE_MASK
;
1685 if (size
& PSEUDOVECTOR_FLAG
)
1691 register Lisp_Object tem
;
1693 /* Don't print more elements than the specified maximum. */
1694 if (INTEGERP (Vprint_length
)
1695 && XINT (Vprint_length
) < size
)
1696 size
= XINT (Vprint_length
);
1698 for (i
= 0; i
< size
; i
++)
1700 if (i
) PRINTCHAR (' ');
1701 tem
= XVECTOR (obj
)->contents
[i
];
1702 print_object (tem
, printcharfun
, escapeflag
);
1710 switch (XMISCTYPE (obj
))
1712 case Lisp_Misc_Marker
:
1713 strout ("#<marker ", -1, -1, printcharfun
, 0);
1714 /* Do you think this is necessary? */
1715 if (XMARKER (obj
)->insertion_type
!= 0)
1716 strout ("(before-insertion) ", -1, -1, printcharfun
, 0);
1717 if (!(XMARKER (obj
)->buffer
))
1718 strout ("in no buffer", -1, -1, printcharfun
, 0);
1721 sprintf (buf
, "at %d", marker_position (obj
));
1722 strout (buf
, -1, -1, printcharfun
, 0);
1723 strout (" in ", -1, -1, printcharfun
, 0);
1724 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1729 case Lisp_Misc_Overlay
:
1730 strout ("#<overlay ", -1, -1, printcharfun
, 0);
1731 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1732 strout ("in no buffer", -1, -1, printcharfun
, 0);
1735 sprintf (buf
, "from %d to %d in ",
1736 marker_position (OVERLAY_START (obj
)),
1737 marker_position (OVERLAY_END (obj
)));
1738 strout (buf
, -1, -1, printcharfun
, 0);
1739 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1745 /* Remaining cases shouldn't happen in normal usage, but let's print
1746 them anyway for the benefit of the debugger. */
1747 case Lisp_Misc_Free
:
1748 strout ("#<misc free cell>", -1, -1, printcharfun
, 0);
1751 case Lisp_Misc_Intfwd
:
1752 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1753 strout (buf
, -1, -1, printcharfun
, 0);
1756 case Lisp_Misc_Boolfwd
:
1757 sprintf (buf
, "#<boolfwd to %s>",
1758 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1759 strout (buf
, -1, -1, printcharfun
, 0);
1762 case Lisp_Misc_Objfwd
:
1763 strout ("#<objfwd to ", -1, -1, printcharfun
, 0);
1764 print_object (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1768 case Lisp_Misc_Buffer_Objfwd
:
1769 strout ("#<buffer_objfwd to ", -1, -1, printcharfun
, 0);
1770 print_object (*(Lisp_Object
*)((char *)current_buffer
1771 + XBUFFER_OBJFWD (obj
)->offset
),
1772 printcharfun
, escapeflag
);
1776 case Lisp_Misc_Kboard_Objfwd
:
1777 strout ("#<kboard_objfwd to ", -1, -1, printcharfun
, 0);
1778 print_object (*(Lisp_Object
*)((char *) current_kboard
1779 + XKBOARD_OBJFWD (obj
)->offset
),
1780 printcharfun
, escapeflag
);
1784 case Lisp_Misc_Buffer_Local_Value
:
1785 strout ("#<buffer_local_value ", -1, -1, printcharfun
, 0);
1786 goto do_buffer_local
;
1787 case Lisp_Misc_Some_Buffer_Local_Value
:
1788 strout ("#<some_buffer_local_value ", -1, -1, printcharfun
, 0);
1790 strout ("[realvalue] ", -1, -1, printcharfun
, 0);
1791 print_object (XBUFFER_LOCAL_VALUE (obj
)->realvalue
,
1792 printcharfun
, escapeflag
);
1793 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_buffer
)
1794 strout ("[local in buffer] ", -1, -1, printcharfun
, 0);
1796 strout ("[buffer] ", -1, -1, printcharfun
, 0);
1797 print_object (XBUFFER_LOCAL_VALUE (obj
)->buffer
,
1798 printcharfun
, escapeflag
);
1799 if (XBUFFER_LOCAL_VALUE (obj
)->check_frame
)
1801 if (XBUFFER_LOCAL_VALUE (obj
)->found_for_frame
)
1802 strout ("[local in frame] ", -1, -1, printcharfun
, 0);
1804 strout ("[frame] ", -1, -1, printcharfun
, 0);
1805 print_object (XBUFFER_LOCAL_VALUE (obj
)->frame
,
1806 printcharfun
, escapeflag
);
1808 strout ("[alist-elt] ", -1, -1, printcharfun
, 0);
1809 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
1810 printcharfun
, escapeflag
);
1811 strout ("[default-value] ", -1, -1, printcharfun
, 0);
1812 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj
)->cdr
),
1813 printcharfun
, escapeflag
);
1825 /* We're in trouble if this happens!
1826 Probably should just abort () */
1827 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun
, 0);
1829 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1830 else if (VECTORLIKEP (obj
))
1831 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1833 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1834 strout (buf
, -1, -1, printcharfun
, 0);
1835 strout (" Save your buffers immediately and please report this bug>",
1836 -1, -1, printcharfun
, 0);
1843 #ifdef USE_TEXT_PROPERTIES
1845 /* Print a description of INTERVAL using PRINTCHARFUN.
1846 This is part of printing a string that has text properties. */
1849 print_interval (interval
, printcharfun
)
1851 Lisp_Object printcharfun
;
1854 print_object (make_number (interval
->position
), printcharfun
, 1);
1856 print_object (make_number (interval
->position
+ LENGTH (interval
)),
1859 print_object (interval
->plist
, printcharfun
, 1);
1862 #endif /* USE_TEXT_PROPERTIES */
1867 Qtemp_buffer_setup_hook
= intern ("temp-buffer-setup-hook");
1868 staticpro (&Qtemp_buffer_setup_hook
);
1870 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1871 "Output stream `print' uses by default for outputting a character.\n\
1872 This may be any function of one argument.\n\
1873 It may also be a buffer (output is inserted before point)\n\
1874 or a marker (output is inserted and the marker is advanced)\n\
1875 or the symbol t (output appears in the echo area).");
1876 Vstandard_output
= Qt
;
1877 Qstandard_output
= intern ("standard-output");
1878 staticpro (&Qstandard_output
);
1880 #ifdef LISP_FLOAT_TYPE
1881 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1882 "The format descriptor string used to print floats.\n\
1883 This is a %-spec like those accepted by `printf' in C,\n\
1884 but with some restrictions. It must start with the two characters `%.'.\n\
1885 After that comes an integer precision specification,\n\
1886 and then a letter which controls the format.\n\
1887 The letters allowed are `e', `f' and `g'.\n\
1888 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1889 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1890 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1891 The precision in any of these cases is the number of digits following\n\
1892 the decimal point. With `f', a precision of 0 means to omit the\n\
1893 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1894 A value of nil means to use the shortest notation\n\
1895 that represents the number without losing information.");
1896 Vfloat_output_format
= Qnil
;
1897 Qfloat_output_format
= intern ("float-output-format");
1898 staticpro (&Qfloat_output_format
);
1899 #endif /* LISP_FLOAT_TYPE */
1901 DEFVAR_LISP ("print-length", &Vprint_length
,
1902 "Maximum length of list to print before abbreviating.\n\
1903 A value of nil means no limit.");
1904 Vprint_length
= Qnil
;
1906 DEFVAR_LISP ("print-level", &Vprint_level
,
1907 "Maximum depth of list nesting to print before abbreviating.\n\
1908 A value of nil means no limit.");
1909 Vprint_level
= Qnil
;
1911 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1912 "Non-nil means print newlines in strings as backslash-n.\n\
1913 Also print formfeeds as backslash-f.");
1914 print_escape_newlines
= 0;
1916 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii
,
1917 "Non-nil means print unibyte non-ASCII chars in strings as \\OOO.\n\
1918 \(OOO is the octal representation of the character code.)\n\
1919 Only single-byte characters are affected, and only in `prin1'.");
1920 print_escape_nonascii
= 0;
1922 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte
,
1923 "Non-nil means print multibyte characters in strings as \\xXXXX.\n\
1924 \(XXX is the hex representation of the character code.)\n\
1925 This affects only `prin1'.");
1926 print_escape_multibyte
= 0;
1928 DEFVAR_BOOL ("print-quoted", &print_quoted
,
1929 "Non-nil means print quoted forms with reader syntax.\n\
1930 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\
1931 forms print in the new syntax.");
1934 DEFVAR_LISP ("print-gensym", &Vprint_gensym
,
1935 "Non-nil means print uninterned symbols so they will read as uninterned.\n\
1936 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\
1937 When the uninterned symbol appears within a recursive data structure\n\
1938 and the symbol appears more than once, in addition use the #N# and #N=\n\
1939 constructs as needed, so that multiple references to the same symbol are\n\
1940 shared once again when the text is read back.");
1941 Vprint_gensym
= Qnil
;
1943 DEFVAR_LISP ("print-circle", &Vprint_circle
,
1944 "*Non-nil means print recursive structures using #N= and #N# syntax.\n\
1945 If nil, printing proceeds recursively and may lead to\n\
1946 `max-lisp-eval-depth' being exceeded or an error may occur:\n\
1947 \"Apparently circular structure being printed.\" Also see\n\
1948 `print-length' and `print-level'.\n\
1949 If non-nil, shared substructures anywhere in the structure are printed\n\
1950 with `#N=' before the first occurrence (in the order of the print\n\
1951 representation) and `#N#' in place of each subsequent occurrence,\n\
1952 where N is a positive decimal integer.");
1953 Vprint_circle
= Qnil
;
1955 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering
,
1956 "*Non-nil means keep numbering between several print functions.\n\
1957 See `print-gensym' nad `print-circle'. See also `print-number-table'.");
1958 Vprint_continuous_numbering
= Qnil
;
1960 DEFVAR_LISP ("print-number-table", &Vprint_number_table
,
1961 "A vector keeping the information of the current printed object.\n\
1962 This variable shouldn't be modified in Lisp level, but should be binded\n\
1963 with nil using let at the same position with `print-continuous-numbering',\n\
1964 so that the value of this variable can be freed after printing.");
1965 Vprint_number_table
= Qnil
;
1967 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1968 staticpro (&Vprin1_to_string_buffer
);
1971 defsubr (&Sprin1_to_string
);
1972 defsubr (&Serror_message_string
);
1976 defsubr (&Swrite_char
);
1977 defsubr (&Sexternal_debugging_output
);
1979 Qexternal_debugging_output
= intern ("external-debugging-output");
1980 staticpro (&Qexternal_debugging_output
);
1982 Qprint_escape_newlines
= intern ("print-escape-newlines");
1983 staticpro (&Qprint_escape_newlines
);
1985 Qprint_escape_multibyte
= intern ("print-escape-multibyte");
1986 staticpro (&Qprint_escape_multibyte
);
1988 Qprint_escape_nonascii
= intern ("print-escape-nonascii");
1989 staticpro (&Qprint_escape_nonascii
);
1991 defsubr (&Swith_output_to_temp_buffer
);