Remove * in defcustom docstrings.
[emacs.git] / src / print.c
blobe56c231d30a2eaa4a3c29b8686c06e54437a6e03
1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997,
3 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
11 any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
24 #include <config.h>
25 #include <stdio.h>
26 #include "lisp.h"
27 #include "buffer.h"
28 #include "charset.h"
29 #include "keyboard.h"
30 #include "frame.h"
31 #include "window.h"
32 #include "process.h"
33 #include "dispextern.h"
34 #include "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
54 #endif
56 #include <math.h>
58 #if STDC_HEADERS
59 #include <float.h>
60 #endif
62 /* Default to values appropriate for IEEE floating point. */
63 #ifndef FLT_RADIX
64 #define FLT_RADIX 2
65 #endif
66 #ifndef DBL_MANT_DIG
67 #define DBL_MANT_DIG 53
68 #endif
69 #ifndef DBL_DIG
70 #define DBL_DIG 15
71 #endif
72 #ifndef DBL_MIN
73 #define DBL_MIN 2.2250738585072014e-308
74 #endif
76 #ifdef DBL_MIN_REPLACEMENT
77 #undef DBL_MIN
78 #define DBL_MIN DBL_MIN_REPLACEMENT
79 #endif
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 */
88 #else
89 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
90 #endif
92 /* Avoid actual stack overflow in print. */
93 int print_depth;
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. */
104 char *print_buffer;
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
128 octal escapes. */
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. */
141 int print_quoted;
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 ();
185 /* GDB resets this to zero on W32 to disable OutputDebugString calls. */
186 int print_output_debug_flag = 1;
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 = -1; \
201 int old_point_byte = -1, start_point_byte = -1; \
202 int specpdl_count = SPECPDL_INDEX (); \
203 int free_print_buffer = 0; \
204 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
205 Lisp_Object original
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 EMACS_INT marker_pos; \
219 if (!(XMARKER (printcharfun)->buffer)) \
220 error ("Marker does not point anywhere"); \
221 if (XMARKER (printcharfun)->buffer != current_buffer) \
222 set_buffer_internal (XMARKER (printcharfun)->buffer); \
223 marker_pos = marker_position (printcharfun); \
224 if (marker_pos < BEGV || marker_pos > ZV) \
225 error ("Marker is outside the accessible part of the buffer"); \
226 old_point = PT; \
227 old_point_byte = PT_BYTE; \
228 SET_PT_BOTH (marker_pos, \
229 marker_byte_position (printcharfun)); \
230 start_point = PT; \
231 start_point_byte = PT_BYTE; \
232 printcharfun = Qnil; \
234 if (NILP (printcharfun)) \
236 Lisp_Object string; \
237 if (NILP (current_buffer->enable_multibyte_characters) \
238 && ! print_escape_multibyte) \
239 specbind (Qprint_escape_multibyte, Qt); \
240 if (! NILP (current_buffer->enable_multibyte_characters) \
241 && ! print_escape_nonascii) \
242 specbind (Qprint_escape_nonascii, Qt); \
243 if (print_buffer != 0) \
245 string = make_string_from_bytes (print_buffer, \
246 print_buffer_pos, \
247 print_buffer_pos_byte); \
248 record_unwind_protect (print_unwind, string); \
250 else \
252 print_buffer_size = 1000; \
253 print_buffer = (char *) xmalloc (print_buffer_size); \
254 free_print_buffer = 1; \
256 print_buffer_pos = 0; \
257 print_buffer_pos_byte = 0; \
259 if (EQ (printcharfun, Qt) && ! noninteractive) \
260 setup_echo_area_for_printing (multibyte);
262 #define PRINTFINISH \
263 if (NILP (printcharfun)) \
265 if (print_buffer_pos != print_buffer_pos_byte \
266 && NILP (current_buffer->enable_multibyte_characters)) \
268 unsigned char *temp \
269 = (unsigned char *) alloca (print_buffer_pos + 1); \
270 copy_text (print_buffer, temp, print_buffer_pos_byte, \
271 1, 0); \
272 insert_1_both (temp, print_buffer_pos, \
273 print_buffer_pos, 0, 1, 0); \
275 else \
276 insert_1_both (print_buffer, print_buffer_pos, \
277 print_buffer_pos_byte, 0, 1, 0); \
278 signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
280 if (free_print_buffer) \
282 xfree (print_buffer); \
283 print_buffer = 0; \
285 unbind_to (specpdl_count, Qnil); \
286 if (MARKERP (original)) \
287 set_marker_both (original, Qnil, PT, PT_BYTE); \
288 if (old_point >= 0) \
289 SET_PT_BOTH (old_point + (old_point >= start_point \
290 ? PT - start_point : 0), \
291 old_point_byte + (old_point_byte >= start_point_byte \
292 ? PT_BYTE - start_point_byte : 0)); \
293 if (old != current_buffer) \
294 set_buffer_internal (old);
296 #define PRINTCHAR(ch) printchar (ch, printcharfun)
298 /* This is used to restore the saved contents of print_buffer
299 when there is a recursive call to print. */
301 static Lisp_Object
302 print_unwind (saved_text)
303 Lisp_Object saved_text;
305 bcopy (SDATA (saved_text), print_buffer, SCHARS (saved_text));
306 return Qnil;
310 /* Print character CH using method FUN. FUN nil means print to
311 print_buffer. FUN t means print to echo area or stdout if
312 non-interactive. If FUN is neither nil nor t, call FUN with CH as
313 argument. */
315 static void
316 printchar (ch, fun)
317 unsigned int ch;
318 Lisp_Object fun;
320 #ifdef MAX_PRINT_CHARS
321 if (max_print)
322 print_chars++;
323 #endif /* MAX_PRINT_CHARS */
325 if (!NILP (fun) && !EQ (fun, Qt))
326 call1 (fun, make_number (ch));
327 else
329 unsigned char str[MAX_MULTIBYTE_LENGTH];
330 int len = CHAR_STRING (ch, str);
332 QUIT;
334 if (NILP (fun))
336 if (print_buffer_pos_byte + len >= print_buffer_size)
337 print_buffer = (char *) xrealloc (print_buffer,
338 print_buffer_size *= 2);
339 bcopy (str, print_buffer + print_buffer_pos_byte, len);
340 print_buffer_pos += 1;
341 print_buffer_pos_byte += len;
343 else if (noninteractive)
345 fwrite (str, 1, len, stdout);
346 noninteractive_need_newline = 1;
348 else
350 int multibyte_p
351 = !NILP (current_buffer->enable_multibyte_characters);
353 setup_echo_area_for_printing (multibyte_p);
354 insert_char (ch);
355 message_dolog (str, len, 0, multibyte_p);
361 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
362 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
363 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
364 print_buffer. PRINTCHARFUN t means output to the echo area or to
365 stdout if non-interactive. If neither nil nor t, call Lisp
366 function PRINTCHARFUN for each character printed. MULTIBYTE
367 non-zero means PTR contains multibyte characters. */
369 static void
370 strout (ptr, size, size_byte, printcharfun, multibyte)
371 char *ptr;
372 int size, size_byte;
373 Lisp_Object printcharfun;
374 int multibyte;
376 if (size < 0)
377 size_byte = size = strlen (ptr);
379 if (NILP (printcharfun))
381 if (print_buffer_pos_byte + size_byte > print_buffer_size)
383 print_buffer_size = print_buffer_size * 2 + size_byte;
384 print_buffer = (char *) xrealloc (print_buffer,
385 print_buffer_size);
387 bcopy (ptr, print_buffer + print_buffer_pos_byte, size_byte);
388 print_buffer_pos += size;
389 print_buffer_pos_byte += size_byte;
391 #ifdef MAX_PRINT_CHARS
392 if (max_print)
393 print_chars += size;
394 #endif /* MAX_PRINT_CHARS */
396 else if (noninteractive && EQ (printcharfun, Qt))
398 fwrite (ptr, 1, size_byte, stdout);
399 noninteractive_need_newline = 1;
401 else if (EQ (printcharfun, Qt))
403 /* Output to echo area. We're trying to avoid a little overhead
404 here, that's the reason we don't call printchar to do the
405 job. */
406 int i;
407 int multibyte_p
408 = !NILP (current_buffer->enable_multibyte_characters);
410 setup_echo_area_for_printing (multibyte_p);
411 message_dolog (ptr, size_byte, 0, multibyte_p);
413 if (size == size_byte)
415 for (i = 0; i < size; ++i)
416 insert_char ((unsigned char )*ptr++);
418 else
420 int len;
421 for (i = 0; i < size_byte; i += len)
423 int ch = STRING_CHAR_AND_LENGTH (ptr + i, size_byte - i, len);
424 insert_char (ch);
428 #ifdef MAX_PRINT_CHARS
429 if (max_print)
430 print_chars += size;
431 #endif /* MAX_PRINT_CHARS */
433 else
435 /* PRINTCHARFUN is a Lisp function. */
436 int i = 0;
438 if (size == size_byte)
440 while (i < size_byte)
442 int ch = ptr[i++];
443 PRINTCHAR (ch);
446 else
448 while (i < size_byte)
450 /* Here, we must convert each multi-byte form to the
451 corresponding character code before handing it to
452 PRINTCHAR. */
453 int len;
454 int ch = STRING_CHAR_AND_LENGTH (ptr + i, size_byte - i, len);
455 PRINTCHAR (ch);
456 i += len;
462 /* Print the contents of a string STRING using PRINTCHARFUN.
463 It isn't safe to use strout in many cases,
464 because printing one char can relocate. */
466 static void
467 print_string (string, printcharfun)
468 Lisp_Object string;
469 Lisp_Object printcharfun;
471 if (EQ (printcharfun, Qt) || NILP (printcharfun))
473 int chars;
475 if (STRING_MULTIBYTE (string))
476 chars = SCHARS (string);
477 else if (EQ (printcharfun, Qt)
478 ? ! NILP (buffer_defaults.enable_multibyte_characters)
479 : ! NILP (current_buffer->enable_multibyte_characters))
481 /* If unibyte string STRING contains 8-bit codes, we must
482 convert STRING to a multibyte string containing the same
483 character codes. */
484 Lisp_Object newstr;
485 int bytes;
487 chars = SBYTES (string);
488 bytes = parse_str_to_multibyte (SDATA (string), chars);
489 if (chars < bytes)
491 newstr = make_uninit_multibyte_string (chars, bytes);
492 bcopy (SDATA (string), SDATA (newstr), chars);
493 str_to_multibyte (SDATA (newstr), bytes, chars);
494 string = newstr;
497 else
498 chars = SBYTES (string);
500 /* strout is safe for output to a frame (echo area) or to print_buffer. */
501 strout (SDATA (string),
502 chars, SBYTES (string),
503 printcharfun, STRING_MULTIBYTE (string));
505 else
507 /* Otherwise, string may be relocated by printing one char.
508 So re-fetch the string address for each character. */
509 int i;
510 int size = SCHARS (string);
511 int size_byte = SBYTES (string);
512 struct gcpro gcpro1;
513 GCPRO1 (string);
514 if (size == size_byte)
515 for (i = 0; i < size; i++)
516 PRINTCHAR (SREF (string, i));
517 else
518 for (i = 0; i < size_byte; )
520 /* Here, we must convert each multi-byte form to the
521 corresponding character code before handing it to PRINTCHAR. */
522 int len;
523 int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i,
524 size_byte - i, len);
525 if (!CHAR_VALID_P (ch, 0))
527 ch = SREF (string, i);
528 len = 1;
530 PRINTCHAR (ch);
531 i += len;
533 UNGCPRO;
537 DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
538 doc: /* Output character CHARACTER to stream PRINTCHARFUN.
539 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
540 (character, printcharfun)
541 Lisp_Object character, printcharfun;
543 PRINTDECLARE;
545 if (NILP (printcharfun))
546 printcharfun = Vstandard_output;
547 CHECK_NUMBER (character);
548 PRINTPREPARE;
549 PRINTCHAR (XINT (character));
550 PRINTFINISH;
551 return character;
554 /* Used from outside of print.c to print a block of SIZE
555 single-byte chars at DATA on the default output stream.
556 Do not use this on the contents of a Lisp string. */
558 void
559 write_string (data, size)
560 char *data;
561 int size;
563 PRINTDECLARE;
564 Lisp_Object printcharfun;
566 printcharfun = Vstandard_output;
568 PRINTPREPARE;
569 strout (data, size, size, printcharfun, 0);
570 PRINTFINISH;
573 /* Used from outside of print.c to print a block of SIZE
574 single-byte chars at DATA on a specified stream PRINTCHARFUN.
575 Do not use this on the contents of a Lisp string. */
577 void
578 write_string_1 (data, size, printcharfun)
579 char *data;
580 int size;
581 Lisp_Object printcharfun;
583 PRINTDECLARE;
585 PRINTPREPARE;
586 strout (data, size, size, printcharfun, 0);
587 PRINTFINISH;
591 void
592 temp_output_buffer_setup (bufname)
593 const char *bufname;
595 int count = SPECPDL_INDEX ();
596 register struct buffer *old = current_buffer;
597 register Lisp_Object buf;
599 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
601 Fset_buffer (Fget_buffer_create (build_string (bufname)));
603 Fkill_all_local_variables ();
604 delete_all_overlays (current_buffer);
605 current_buffer->directory = old->directory;
606 current_buffer->read_only = Qnil;
607 current_buffer->filename = Qnil;
608 current_buffer->undo_list = Qt;
609 eassert (current_buffer->overlays_before == NULL);
610 eassert (current_buffer->overlays_after == NULL);
611 current_buffer->enable_multibyte_characters
612 = buffer_defaults.enable_multibyte_characters;
613 specbind (Qinhibit_read_only, Qt);
614 specbind (Qinhibit_modification_hooks, Qt);
615 Ferase_buffer ();
616 XSETBUFFER (buf, current_buffer);
618 Frun_hooks (1, &Qtemp_buffer_setup_hook);
620 unbind_to (count, Qnil);
622 specbind (Qstandard_output, buf);
625 Lisp_Object
626 internal_with_output_to_temp_buffer (bufname, function, args)
627 const char *bufname;
628 Lisp_Object (*function) P_ ((Lisp_Object));
629 Lisp_Object args;
631 int count = SPECPDL_INDEX ();
632 Lisp_Object buf, val;
633 struct gcpro gcpro1;
635 GCPRO1 (args);
636 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
637 temp_output_buffer_setup (bufname);
638 buf = Vstandard_output;
639 UNGCPRO;
641 val = (*function) (args);
643 GCPRO1 (val);
644 temp_output_buffer_show (buf);
645 UNGCPRO;
647 return unbind_to (count, val);
650 DEFUN ("with-output-to-temp-buffer",
651 Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
652 1, UNEVALLED, 0,
653 doc: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
654 The buffer is cleared out initially, and marked as unmodified when done.
655 All output done by BODY is inserted in that buffer by default.
656 The buffer is displayed in another window, but not selected.
657 The value of the last form in BODY is returned.
658 If BODY does not finish normally, the buffer BUFNAME is not displayed.
660 The hook `temp-buffer-setup-hook' is run before BODY,
661 with the buffer BUFNAME temporarily current.
662 The hook `temp-buffer-show-hook' is run after the buffer is displayed,
663 with the buffer temporarily current, and the window that was used
664 to display it temporarily selected.
666 If variable `temp-buffer-show-function' is non-nil, call it at the end
667 to get the buffer displayed instead of just displaying the non-selected
668 buffer and calling the hook. It gets one argument, the buffer to display.
670 usage: (with-output-to-temp-buffer BUFNAME BODY ...) */)
671 (args)
672 Lisp_Object args;
674 struct gcpro gcpro1;
675 Lisp_Object name;
676 int count = SPECPDL_INDEX ();
677 Lisp_Object buf, val;
679 GCPRO1(args);
680 name = Feval (Fcar (args));
681 CHECK_STRING (name);
682 temp_output_buffer_setup (SDATA (name));
683 buf = Vstandard_output;
684 UNGCPRO;
686 val = Fprogn (XCDR (args));
688 GCPRO1 (val);
689 temp_output_buffer_show (buf);
690 UNGCPRO;
692 return unbind_to (count, val);
696 static void print ();
697 static void print_preprocess ();
698 static void print_preprocess_string ();
699 static void print_object ();
701 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
702 doc: /* Output a newline to stream PRINTCHARFUN.
703 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
704 (printcharfun)
705 Lisp_Object printcharfun;
707 PRINTDECLARE;
709 if (NILP (printcharfun))
710 printcharfun = Vstandard_output;
711 PRINTPREPARE;
712 PRINTCHAR ('\n');
713 PRINTFINISH;
714 return Qt;
717 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
718 doc: /* Output the printed representation of OBJECT, any Lisp object.
719 Quoting characters are printed when needed to make output that `read'
720 can handle, whenever this is possible. For complex objects, the behavior
721 is controlled by `print-level' and `print-length', which see.
723 OBJECT is any of the Lisp data types: a number, a string, a symbol,
724 a list, a buffer, a window, a frame, etc.
726 A printed representation of an object is text which describes that object.
728 Optional argument PRINTCHARFUN is the output stream, which can be one
729 of these:
731 - a buffer, in which case output is inserted into that buffer at point;
732 - a marker, in which case output is inserted at marker's position;
733 - a function, in which case that function is called once for each
734 character of OBJECT's printed representation;
735 - a symbol, in which case that symbol's function definition is called; or
736 - t, in which case the output is displayed in the echo area.
738 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
739 is used instead. */)
740 (object, printcharfun)
741 Lisp_Object object, printcharfun;
743 PRINTDECLARE;
745 #ifdef MAX_PRINT_CHARS
746 max_print = 0;
747 #endif /* MAX_PRINT_CHARS */
748 if (NILP (printcharfun))
749 printcharfun = Vstandard_output;
750 PRINTPREPARE;
751 print (object, printcharfun, 1);
752 PRINTFINISH;
753 return object;
756 /* a buffer which is used to hold output being built by prin1-to-string */
757 Lisp_Object Vprin1_to_string_buffer;
759 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
760 doc: /* Return a string containing the printed representation of OBJECT.
761 OBJECT can be any Lisp object. This function outputs quoting characters
762 when necessary to make output that `read' can handle, whenever possible,
763 unless the optional second argument NOESCAPE is non-nil. For complex objects,
764 the behavior is controlled by `print-level' and `print-length', which see.
766 OBJECT is any of the Lisp data types: a number, a string, a symbol,
767 a list, a buffer, a window, a frame, etc.
769 A printed representation of an object is text which describes that object. */)
770 (object, noescape)
771 Lisp_Object object, noescape;
773 Lisp_Object printcharfun;
774 /* struct gcpro gcpro1, gcpro2; */
775 Lisp_Object save_deactivate_mark;
776 int count = specpdl_ptr - specpdl;
777 struct buffer *previous;
779 specbind (Qinhibit_modification_hooks, Qt);
782 PRINTDECLARE;
784 /* Save and restore this--we are altering a buffer
785 but we don't want to deactivate the mark just for that.
786 No need for specbind, since errors deactivate the mark. */
787 save_deactivate_mark = Vdeactivate_mark;
788 /* GCPRO2 (object, save_deactivate_mark); */
789 abort_on_gc++;
791 printcharfun = Vprin1_to_string_buffer;
792 PRINTPREPARE;
793 print (object, printcharfun, NILP (noescape));
794 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
795 PRINTFINISH;
798 previous = current_buffer;
799 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
800 object = Fbuffer_string ();
801 if (SBYTES (object) == SCHARS (object))
802 STRING_SET_UNIBYTE (object);
804 /* Note that this won't make prepare_to_modify_buffer call
805 ask-user-about-supersession-threat because this buffer
806 does not visit a file. */
807 Ferase_buffer ();
808 set_buffer_internal (previous);
810 Vdeactivate_mark = save_deactivate_mark;
811 /* UNGCPRO; */
813 abort_on_gc--;
814 return unbind_to (count, object);
817 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
818 doc: /* Output the printed representation of OBJECT, any Lisp object.
819 No quoting characters are used; no delimiters are printed around
820 the contents of strings.
822 OBJECT is any of the Lisp data types: a number, a string, a symbol,
823 a list, a buffer, a window, a frame, etc.
825 A printed representation of an object is text which describes that object.
827 Optional argument PRINTCHARFUN is the output stream, which can be one
828 of these:
830 - a buffer, in which case output is inserted into that buffer at point;
831 - a marker, in which case output is inserted at marker's position;
832 - a function, in which case that function is called once for each
833 character of OBJECT's printed representation;
834 - a symbol, in which case that symbol's function definition is called; or
835 - t, in which case the output is displayed in the echo area.
837 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
838 is used instead. */)
839 (object, printcharfun)
840 Lisp_Object object, printcharfun;
842 PRINTDECLARE;
844 if (NILP (printcharfun))
845 printcharfun = Vstandard_output;
846 PRINTPREPARE;
847 print (object, printcharfun, 0);
848 PRINTFINISH;
849 return object;
852 DEFUN ("print", Fprint, Sprint, 1, 2, 0,
853 doc: /* Output the printed representation of OBJECT, with newlines around it.
854 Quoting characters are printed when needed to make output that `read'
855 can handle, whenever this is possible. For complex objects, the behavior
856 is controlled by `print-level' and `print-length', which see.
858 OBJECT is any of the Lisp data types: a number, a string, a symbol,
859 a list, a buffer, a window, a frame, etc.
861 A printed representation of an object is text which describes that object.
863 Optional argument PRINTCHARFUN is the output stream, which can be one
864 of these:
866 - a buffer, in which case output is inserted into that buffer at point;
867 - a marker, in which case output is inserted at marker's position;
868 - a function, in which case that function is called once for each
869 character of OBJECT's printed representation;
870 - a symbol, in which case that symbol's function definition is called; or
871 - t, in which case the output is displayed in the echo area.
873 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
874 is used instead. */)
875 (object, printcharfun)
876 Lisp_Object object, printcharfun;
878 PRINTDECLARE;
879 struct gcpro gcpro1;
881 #ifdef MAX_PRINT_CHARS
882 print_chars = 0;
883 max_print = MAX_PRINT_CHARS;
884 #endif /* MAX_PRINT_CHARS */
885 if (NILP (printcharfun))
886 printcharfun = Vstandard_output;
887 GCPRO1 (object);
888 PRINTPREPARE;
889 PRINTCHAR ('\n');
890 print (object, printcharfun, 1);
891 PRINTCHAR ('\n');
892 PRINTFINISH;
893 #ifdef MAX_PRINT_CHARS
894 max_print = 0;
895 print_chars = 0;
896 #endif /* MAX_PRINT_CHARS */
897 UNGCPRO;
898 return object;
901 /* The subroutine object for external-debugging-output is kept here
902 for the convenience of the debugger. */
903 Lisp_Object Qexternal_debugging_output;
905 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
906 doc: /* Write CHARACTER to stderr.
907 You can call print while debugging emacs, and pass it this function
908 to make it write to the debugging output. */)
909 (character)
910 Lisp_Object character;
912 CHECK_NUMBER (character);
913 putc (XINT (character), stderr);
915 #ifdef WINDOWSNT
916 /* Send the output to a debugger (nothing happens if there isn't one). */
917 if (print_output_debug_flag)
919 char buf[2] = {(char) XINT (character), '\0'};
920 OutputDebugString (buf);
922 #endif
924 return character;
927 /* This function is never called. Its purpose is to prevent
928 print_output_debug_flag from being optimized away. */
930 void
931 debug_output_compilation_hack (x)
932 int x;
934 print_output_debug_flag = x;
937 #if defined(GNU_LINUX)
939 /* This functionality is not vitally important in general, so we rely on
940 non-portable ability to use stderr as lvalue. */
942 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
944 FILE *initial_stderr_stream = NULL;
946 DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output,
947 1, 2,
948 "FDebug output file: \nP",
949 doc: /* Redirect debugging output (stderr stream) to file FILE.
950 If FILE is nil, reset target to the initial stderr stream.
951 Optional arg APPEND non-nil (interactively, with prefix arg) means
952 append to existing target file. */)
953 (file, append)
954 Lisp_Object file, append;
956 if (initial_stderr_stream != NULL)
957 fclose(stderr);
958 stderr = initial_stderr_stream;
959 initial_stderr_stream = NULL;
961 if (STRINGP (file))
963 file = Fexpand_file_name (file, Qnil);
964 initial_stderr_stream = stderr;
965 stderr = fopen(SDATA (file), NILP (append) ? "w" : "a");
966 if (stderr == NULL)
968 stderr = initial_stderr_stream;
969 initial_stderr_stream = NULL;
970 report_file_error ("Cannot open debugging output stream",
971 Fcons (file, Qnil));
974 return Qnil;
976 #endif /* GNU_LINUX */
979 /* This is the interface for debugging printing. */
981 void
982 debug_print (arg)
983 Lisp_Object arg;
985 Fprin1 (arg, Qexternal_debugging_output);
986 fprintf (stderr, "\r\n");
989 void
990 safe_debug_print (arg)
991 Lisp_Object arg;
993 int valid = valid_lisp_object_p (arg);
995 if (valid > 0)
996 debug_print (arg);
997 else
998 fprintf (stderr, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
999 !valid ? "INVALID" : "SOME",
1000 #ifdef NO_UNION_TYPE
1001 (unsigned long) arg
1002 #else
1003 (unsigned long) arg.i
1004 #endif
1009 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
1010 1, 1, 0,
1011 doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
1012 See Info anchor `(elisp)Definition of signal' for some details on how this
1013 error message is constructed. */)
1014 (obj)
1015 Lisp_Object obj;
1017 struct buffer *old = current_buffer;
1018 Lisp_Object value;
1019 struct gcpro gcpro1;
1021 /* If OBJ is (error STRING), just return STRING.
1022 That is not only faster, it also avoids the need to allocate
1023 space here when the error is due to memory full. */
1024 if (CONSP (obj) && EQ (XCAR (obj), Qerror)
1025 && CONSP (XCDR (obj))
1026 && STRINGP (XCAR (XCDR (obj)))
1027 && NILP (XCDR (XCDR (obj))))
1028 return XCAR (XCDR (obj));
1030 print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
1032 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
1033 value = Fbuffer_string ();
1035 GCPRO1 (value);
1036 Ferase_buffer ();
1037 set_buffer_internal (old);
1038 UNGCPRO;
1040 return value;
1043 /* Print an error message for the error DATA onto Lisp output stream
1044 STREAM (suitable for the print functions).
1045 CONTEXT is a C string describing the context of the error.
1046 CALLER is the Lisp function inside which the error was signaled. */
1048 void
1049 print_error_message (data, stream, context, caller)
1050 Lisp_Object data, stream;
1051 char *context;
1052 Lisp_Object caller;
1054 Lisp_Object errname, errmsg, file_error, tail;
1055 struct gcpro gcpro1;
1056 int i;
1058 if (context != 0)
1059 write_string_1 (context, -1, stream);
1061 /* If we know from where the error was signaled, show it in
1062 *Messages*. */
1063 if (!NILP (caller) && SYMBOLP (caller))
1065 Lisp_Object cname = SYMBOL_NAME (caller);
1066 char *name = alloca (SBYTES (cname));
1067 bcopy (SDATA (cname), name, SBYTES (cname));
1068 message_dolog (name, SBYTES (cname), 0, 0);
1069 message_dolog (": ", 2, 0, 0);
1072 errname = Fcar (data);
1074 if (EQ (errname, Qerror))
1076 data = Fcdr (data);
1077 if (!CONSP (data))
1078 data = Qnil;
1079 errmsg = Fcar (data);
1080 file_error = Qnil;
1082 else
1084 Lisp_Object error_conditions;
1085 errmsg = Fget (errname, Qerror_message);
1086 error_conditions = Fget (errname, Qerror_conditions);
1087 file_error = Fmemq (Qfile_error, error_conditions);
1090 /* Print an error message including the data items. */
1092 tail = Fcdr_safe (data);
1093 GCPRO1 (tail);
1095 /* For file-error, make error message by concatenating
1096 all the data items. They are all strings. */
1097 if (!NILP (file_error) && CONSP (tail))
1098 errmsg = XCAR (tail), tail = XCDR (tail);
1100 if (STRINGP (errmsg))
1101 Fprinc (errmsg, stream);
1102 else
1103 write_string_1 ("peculiar error", -1, stream);
1105 for (i = 0; CONSP (tail); tail = XCDR (tail), i++)
1107 Lisp_Object obj;
1109 write_string_1 (i ? ", " : ": ", 2, stream);
1110 obj = XCAR (tail);
1111 if (!NILP (file_error) || EQ (errname, Qend_of_file))
1112 Fprinc (obj, stream);
1113 else
1114 Fprin1 (obj, stream);
1117 UNGCPRO;
1123 * The buffer should be at least as large as the max string size of the
1124 * largest float, printed in the biggest notation. This is undoubtedly
1125 * 20d float_output_format, with the negative of the C-constant "HUGE"
1126 * from <math.h>.
1128 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1130 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1131 * case of -1e307 in 20d float_output_format. What is one to do (short of
1132 * re-writing _doprnt to be more sane)?
1133 * -wsr
1136 void
1137 float_to_string (buf, data)
1138 unsigned char *buf;
1139 double data;
1141 unsigned char *cp;
1142 int width;
1144 /* Check for plus infinity in a way that won't lose
1145 if there is no plus infinity. */
1146 if (data == data / 2 && data > 1.0)
1148 strcpy (buf, "1.0e+INF");
1149 return;
1151 /* Likewise for minus infinity. */
1152 if (data == data / 2 && data < -1.0)
1154 strcpy (buf, "-1.0e+INF");
1155 return;
1157 /* Check for NaN in a way that won't fail if there are no NaNs. */
1158 if (! (data * 0.0 >= 0.0))
1160 /* Prepend "-" if the NaN's sign bit is negative.
1161 The sign bit of a double is the bit that is 1 in -0.0. */
1162 int i;
1163 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
1164 u_data.d = data;
1165 u_minus_zero.d = - 0.0;
1166 for (i = 0; i < sizeof (double); i++)
1167 if (u_data.c[i] & u_minus_zero.c[i])
1169 *buf++ = '-';
1170 break;
1173 strcpy (buf, "0.0e+NaN");
1174 return;
1177 if (NILP (Vfloat_output_format)
1178 || !STRINGP (Vfloat_output_format))
1179 lose:
1181 /* Generate the fewest number of digits that represent the
1182 floating point value without losing information.
1183 The following method is simple but a bit slow.
1184 For ideas about speeding things up, please see:
1186 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1187 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1189 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1190 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1192 width = fabs (data) < DBL_MIN ? 1 : DBL_DIG;
1194 sprintf (buf, "%.*g", width, data);
1195 while (width++ < DOUBLE_DIGITS_BOUND && atof (buf) != data);
1197 else /* oink oink */
1199 /* Check that the spec we have is fully valid.
1200 This means not only valid for printf,
1201 but meant for floats, and reasonable. */
1202 cp = SDATA (Vfloat_output_format);
1204 if (cp[0] != '%')
1205 goto lose;
1206 if (cp[1] != '.')
1207 goto lose;
1209 cp += 2;
1211 /* Check the width specification. */
1212 width = -1;
1213 if ('0' <= *cp && *cp <= '9')
1215 width = 0;
1217 width = (width * 10) + (*cp++ - '0');
1218 while (*cp >= '0' && *cp <= '9');
1220 /* A precision of zero is valid only for %f. */
1221 if (width > DBL_DIG
1222 || (width == 0 && *cp != 'f'))
1223 goto lose;
1226 if (*cp != 'e' && *cp != 'f' && *cp != 'g')
1227 goto lose;
1229 if (cp[1] != 0)
1230 goto lose;
1232 sprintf (buf, SDATA (Vfloat_output_format), data);
1235 /* Make sure there is a decimal point with digit after, or an
1236 exponent, so that the value is readable as a float. But don't do
1237 this with "%.0f"; it's valid for that not to produce a decimal
1238 point. Note that width can be 0 only for %.0f. */
1239 if (width != 0)
1241 for (cp = buf; *cp; cp++)
1242 if ((*cp < '0' || *cp > '9') && *cp != '-')
1243 break;
1245 if (*cp == '.' && cp[1] == 0)
1247 cp[1] = '0';
1248 cp[2] = 0;
1251 if (*cp == 0)
1253 *cp++ = '.';
1254 *cp++ = '0';
1255 *cp++ = 0;
1261 static void
1262 print (obj, printcharfun, escapeflag)
1263 Lisp_Object obj;
1264 register Lisp_Object printcharfun;
1265 int escapeflag;
1267 old_backquote_output = 0;
1269 /* Reset print_number_index and Vprint_number_table only when
1270 the variable Vprint_continuous_numbering is nil. Otherwise,
1271 the values of these variables will be kept between several
1272 print functions. */
1273 if (NILP (Vprint_continuous_numbering))
1275 print_number_index = 0;
1276 Vprint_number_table = Qnil;
1279 /* Construct Vprint_number_table for print-gensym and print-circle. */
1280 if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
1282 int i, start, index;
1283 start = index = print_number_index;
1284 /* Construct Vprint_number_table.
1285 This increments print_number_index for the objects added. */
1286 print_depth = 0;
1287 print_preprocess (obj);
1289 /* Remove unnecessary objects, which appear only once in OBJ;
1290 that is, whose status is Qnil. Compactify the necessary objects. */
1291 for (i = start; i < print_number_index; i++)
1292 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1294 PRINT_NUMBER_OBJECT (Vprint_number_table, index)
1295 = PRINT_NUMBER_OBJECT (Vprint_number_table, i);
1296 index++;
1299 /* Clear out objects outside the active part of the table. */
1300 for (i = index; i < print_number_index; i++)
1301 PRINT_NUMBER_OBJECT (Vprint_number_table, i) = Qnil;
1303 /* Reset the status field for the next print step. Now this
1304 field means whether the object has already been printed. */
1305 for (i = start; i < print_number_index; i++)
1306 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qnil;
1308 print_number_index = index;
1311 print_depth = 0;
1312 print_object (obj, printcharfun, escapeflag);
1315 /* Construct Vprint_number_table according to the structure of OBJ.
1316 OBJ itself and all its elements will be added to Vprint_number_table
1317 recursively if it is a list, vector, compiled function, char-table,
1318 string (its text properties will be traced), or a symbol that has
1319 no obarray (this is for the print-gensym feature).
1320 The status fields of Vprint_number_table mean whether each object appears
1321 more than once in OBJ: Qnil at the first time, and Qt after that . */
1322 static void
1323 print_preprocess (obj)
1324 Lisp_Object obj;
1326 int i;
1327 EMACS_INT size;
1328 int loop_count = 0;
1329 Lisp_Object halftail;
1331 /* Give up if we go so deep that print_object will get an error. */
1332 /* See similar code in print_object. */
1333 if (print_depth >= PRINT_CIRCLE)
1334 error ("Apparently circular structure being printed");
1336 /* Avoid infinite recursion for circular nested structure
1337 in the case where Vprint_circle is nil. */
1338 if (NILP (Vprint_circle))
1340 for (i = 0; i < print_depth; i++)
1341 if (EQ (obj, being_printed[i]))
1342 return;
1343 being_printed[print_depth] = obj;
1346 print_depth++;
1347 halftail = obj;
1349 loop:
1350 if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
1351 || COMPILEDP (obj) || CHAR_TABLE_P (obj)
1352 || (! NILP (Vprint_gensym)
1353 && SYMBOLP (obj)
1354 && !SYMBOL_INTERNED_P (obj)))
1356 /* In case print-circle is nil and print-gensym is t,
1357 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1358 if (! NILP (Vprint_circle) || SYMBOLP (obj))
1360 for (i = 0; i < print_number_index; i++)
1361 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
1363 /* OBJ appears more than once. Let's remember that. */
1364 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
1365 print_depth--;
1366 return;
1369 /* OBJ is not yet recorded. Let's add to the table. */
1370 if (print_number_index == 0)
1372 /* Initialize the table. */
1373 Vprint_number_table = Fmake_vector (make_number (40), Qnil);
1375 else if (XVECTOR (Vprint_number_table)->size == print_number_index * 2)
1377 /* Reallocate the table. */
1378 int i = print_number_index * 4;
1379 Lisp_Object old_table = Vprint_number_table;
1380 Vprint_number_table = Fmake_vector (make_number (i), Qnil);
1381 for (i = 0; i < print_number_index; i++)
1383 PRINT_NUMBER_OBJECT (Vprint_number_table, i)
1384 = PRINT_NUMBER_OBJECT (old_table, i);
1385 PRINT_NUMBER_STATUS (Vprint_number_table, i)
1386 = PRINT_NUMBER_STATUS (old_table, i);
1389 PRINT_NUMBER_OBJECT (Vprint_number_table, print_number_index) = obj;
1390 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1391 always print the gensym with a number. This is a special for
1392 the lisp function byte-compile-output-docform. */
1393 if (!NILP (Vprint_continuous_numbering)
1394 && SYMBOLP (obj)
1395 && !SYMBOL_INTERNED_P (obj))
1396 PRINT_NUMBER_STATUS (Vprint_number_table, print_number_index) = Qt;
1397 print_number_index++;
1400 switch (XGCTYPE (obj))
1402 case Lisp_String:
1403 /* A string may have text properties, which can be circular. */
1404 traverse_intervals_noorder (STRING_INTERVALS (obj),
1405 print_preprocess_string, Qnil);
1406 break;
1408 case Lisp_Cons:
1409 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1410 just as in print_object. */
1411 if (loop_count && EQ (obj, halftail))
1412 break;
1413 print_preprocess (XCAR (obj));
1414 obj = XCDR (obj);
1415 loop_count++;
1416 if (!(loop_count & 1))
1417 halftail = XCDR (halftail);
1418 goto loop;
1420 case Lisp_Vectorlike:
1421 size = XVECTOR (obj)->size;
1422 if (size & PSEUDOVECTOR_FLAG)
1423 size &= PSEUDOVECTOR_SIZE_MASK;
1424 for (i = 0; i < size; i++)
1425 print_preprocess (XVECTOR (obj)->contents[i]);
1426 break;
1428 default:
1429 break;
1432 print_depth--;
1435 static void
1436 print_preprocess_string (interval, arg)
1437 INTERVAL interval;
1438 Lisp_Object arg;
1440 print_preprocess (interval->plist);
1443 static void
1444 print_object (obj, printcharfun, escapeflag)
1445 Lisp_Object obj;
1446 register Lisp_Object printcharfun;
1447 int escapeflag;
1449 char buf[40];
1451 QUIT;
1453 /* Detect circularities and truncate them. */
1454 if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
1455 || COMPILEDP (obj) || CHAR_TABLE_P (obj)
1456 || (! NILP (Vprint_gensym)
1457 && SYMBOLP (obj)
1458 && !SYMBOL_INTERNED_P (obj)))
1460 if (NILP (Vprint_circle) && NILP (Vprint_gensym))
1462 /* Simple but incomplete way. */
1463 int i;
1464 for (i = 0; i < print_depth; i++)
1465 if (EQ (obj, being_printed[i]))
1467 sprintf (buf, "#%d", i);
1468 strout (buf, -1, -1, printcharfun, 0);
1469 return;
1471 being_printed[print_depth] = obj;
1473 else
1475 /* With the print-circle feature. */
1476 int i;
1477 for (i = 0; i < print_number_index; i++)
1478 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
1480 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1482 /* Add a prefix #n= if OBJ has not yet been printed;
1483 that is, its status field is nil. */
1484 sprintf (buf, "#%d=", i + 1);
1485 strout (buf, -1, -1, printcharfun, 0);
1486 /* OBJ is going to be printed. Set the status to t. */
1487 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
1488 break;
1490 else
1492 /* Just print #n# if OBJ has already been printed. */
1493 sprintf (buf, "#%d#", i + 1);
1494 strout (buf, -1, -1, printcharfun, 0);
1495 return;
1501 print_depth++;
1503 /* See similar code in print_preprocess. */
1504 if (print_depth > PRINT_CIRCLE)
1505 error ("Apparently circular structure being printed");
1506 #ifdef MAX_PRINT_CHARS
1507 if (max_print && print_chars > max_print)
1509 PRINTCHAR ('\n');
1510 print_chars = 0;
1512 #endif /* MAX_PRINT_CHARS */
1514 switch (XGCTYPE (obj))
1516 case Lisp_Int:
1517 if (sizeof (int) == sizeof (EMACS_INT))
1518 sprintf (buf, "%d", XINT (obj));
1519 else if (sizeof (long) == sizeof (EMACS_INT))
1520 sprintf (buf, "%ld", (long) XINT (obj));
1521 else
1522 abort ();
1523 strout (buf, -1, -1, printcharfun, 0);
1524 break;
1526 case Lisp_Float:
1528 char pigbuf[350]; /* see comments in float_to_string */
1530 float_to_string (pigbuf, XFLOAT_DATA (obj));
1531 strout (pigbuf, -1, -1, printcharfun, 0);
1533 break;
1535 case Lisp_String:
1536 if (!escapeflag)
1537 print_string (obj, printcharfun);
1538 else
1540 register int i, i_byte;
1541 struct gcpro gcpro1;
1542 unsigned char *str;
1543 int size_byte;
1544 /* 1 means we must ensure that the next character we output
1545 cannot be taken as part of a hex character escape. */
1546 int need_nonhex = 0;
1547 int multibyte = STRING_MULTIBYTE (obj);
1549 GCPRO1 (obj);
1551 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1553 PRINTCHAR ('#');
1554 PRINTCHAR ('(');
1557 PRINTCHAR ('\"');
1558 str = SDATA (obj);
1559 size_byte = SBYTES (obj);
1561 for (i = 0, i_byte = 0; i_byte < size_byte;)
1563 /* Here, we must convert each multi-byte form to the
1564 corresponding character code before handing it to PRINTCHAR. */
1565 int len;
1566 int c;
1568 if (multibyte)
1570 c = STRING_CHAR_AND_LENGTH (str + i_byte,
1571 size_byte - i_byte, len);
1572 if (CHAR_VALID_P (c, 0))
1573 i_byte += len;
1574 else
1575 c = str[i_byte++];
1577 else
1578 c = str[i_byte++];
1580 QUIT;
1582 if (c == '\n' && print_escape_newlines)
1584 PRINTCHAR ('\\');
1585 PRINTCHAR ('n');
1587 else if (c == '\f' && print_escape_newlines)
1589 PRINTCHAR ('\\');
1590 PRINTCHAR ('f');
1592 else if (multibyte
1593 && ! ASCII_BYTE_P (c)
1594 && (SINGLE_BYTE_CHAR_P (c) || print_escape_multibyte))
1596 /* When multibyte is disabled,
1597 print multibyte string chars using hex escapes.
1598 For a char code that could be in a unibyte string,
1599 when found in a multibyte string, always use a hex escape
1600 so it reads back as multibyte. */
1601 unsigned char outbuf[50];
1602 sprintf (outbuf, "\\x%x", c);
1603 strout (outbuf, -1, -1, printcharfun, 0);
1604 need_nonhex = 1;
1606 else if (! multibyte
1607 && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
1608 && print_escape_nonascii)
1610 /* When printing in a multibyte buffer
1611 or when explicitly requested,
1612 print single-byte non-ASCII string chars
1613 using octal escapes. */
1614 unsigned char outbuf[5];
1615 sprintf (outbuf, "\\%03o", c);
1616 strout (outbuf, -1, -1, printcharfun, 0);
1618 else
1620 /* If we just had a hex escape, and this character
1621 could be taken as part of it,
1622 output `\ ' to prevent that. */
1623 if (need_nonhex)
1625 need_nonhex = 0;
1626 if ((c >= 'a' && c <= 'f')
1627 || (c >= 'A' && c <= 'F')
1628 || (c >= '0' && c <= '9'))
1629 strout ("\\ ", -1, -1, printcharfun, 0);
1632 if (c == '\"' || c == '\\')
1633 PRINTCHAR ('\\');
1634 PRINTCHAR (c);
1637 PRINTCHAR ('\"');
1639 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1641 traverse_intervals (STRING_INTERVALS (obj),
1642 0, print_interval, printcharfun);
1643 PRINTCHAR (')');
1646 UNGCPRO;
1648 break;
1650 case Lisp_Symbol:
1652 register int confusing;
1653 register unsigned char *p = SDATA (SYMBOL_NAME (obj));
1654 register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
1655 register int c;
1656 int i, i_byte, size_byte;
1657 Lisp_Object name;
1659 name = SYMBOL_NAME (obj);
1661 if (p != end && (*p == '-' || *p == '+')) p++;
1662 if (p == end)
1663 confusing = 0;
1664 /* If symbol name begins with a digit, and ends with a digit,
1665 and contains nothing but digits and `e', it could be treated
1666 as a number. So set CONFUSING.
1668 Symbols that contain periods could also be taken as numbers,
1669 but periods are always escaped, so we don't have to worry
1670 about them here. */
1671 else if (*p >= '0' && *p <= '9'
1672 && end[-1] >= '0' && end[-1] <= '9')
1674 while (p != end && ((*p >= '0' && *p <= '9')
1675 /* Needed for \2e10. */
1676 || *p == 'e'))
1677 p++;
1678 confusing = (end == p);
1680 else
1681 confusing = 0;
1683 if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj))
1685 PRINTCHAR ('#');
1686 PRINTCHAR (':');
1689 size_byte = SBYTES (name);
1691 for (i = 0, i_byte = 0; i_byte < size_byte;)
1693 /* Here, we must convert each multi-byte form to the
1694 corresponding character code before handing it to PRINTCHAR. */
1695 FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
1696 QUIT;
1698 if (escapeflag)
1700 if (c == '\"' || c == '\\' || c == '\''
1701 || c == ';' || c == '#' || c == '(' || c == ')'
1702 || c == ',' || c =='.' || c == '`'
1703 || c == '[' || c == ']' || c == '?' || c <= 040
1704 || confusing)
1705 PRINTCHAR ('\\'), confusing = 0;
1707 PRINTCHAR (c);
1710 break;
1712 case Lisp_Cons:
1713 /* If deeper than spec'd depth, print placeholder. */
1714 if (INTEGERP (Vprint_level)
1715 && print_depth > XINT (Vprint_level))
1716 strout ("...", -1, -1, printcharfun, 0);
1717 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1718 && (EQ (XCAR (obj), Qquote)))
1720 PRINTCHAR ('\'');
1721 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1723 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1724 && (EQ (XCAR (obj), Qfunction)))
1726 PRINTCHAR ('#');
1727 PRINTCHAR ('\'');
1728 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1730 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1731 && ! old_backquote_output
1732 && ((EQ (XCAR (obj), Qbackquote)
1733 || EQ (XCAR (obj), Qcomma)
1734 || EQ (XCAR (obj), Qcomma_at)
1735 || EQ (XCAR (obj), Qcomma_dot))))
1737 print_object (XCAR (obj), printcharfun, 0);
1738 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1740 else
1742 PRINTCHAR ('(');
1744 /* If the first element is a backquote form,
1745 print it old-style so it won't be misunderstood. */
1746 if (print_quoted && CONSP (XCAR (obj))
1747 && CONSP (XCDR (XCAR (obj)))
1748 && NILP (XCDR (XCDR (XCAR (obj))))
1749 && EQ (XCAR (XCAR (obj)), Qbackquote))
1751 Lisp_Object tem;
1752 tem = XCAR (obj);
1753 PRINTCHAR ('(');
1755 print_object (Qbackquote, printcharfun, 0);
1756 PRINTCHAR (' ');
1758 ++old_backquote_output;
1759 print_object (XCAR (XCDR (tem)), printcharfun, 0);
1760 --old_backquote_output;
1761 PRINTCHAR (')');
1763 obj = XCDR (obj);
1767 int print_length, i;
1768 Lisp_Object halftail = obj;
1770 /* Negative values of print-length are invalid in CL.
1771 Treat them like nil, as CMUCL does. */
1772 if (NATNUMP (Vprint_length))
1773 print_length = XFASTINT (Vprint_length);
1774 else
1775 print_length = 0;
1777 i = 0;
1778 while (CONSP (obj))
1780 /* Detect circular list. */
1781 if (NILP (Vprint_circle))
1783 /* Simple but imcomplete way. */
1784 if (i != 0 && EQ (obj, halftail))
1786 sprintf (buf, " . #%d", i / 2);
1787 strout (buf, -1, -1, printcharfun, 0);
1788 goto end_of_list;
1791 else
1793 /* With the print-circle feature. */
1794 if (i != 0)
1796 int i;
1797 for (i = 0; i < print_number_index; i++)
1798 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i),
1799 obj))
1801 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1803 strout (" . ", 3, 3, printcharfun, 0);
1804 print_object (obj, printcharfun, escapeflag);
1806 else
1808 sprintf (buf, " . #%d#", i + 1);
1809 strout (buf, -1, -1, printcharfun, 0);
1811 goto end_of_list;
1816 if (i++)
1817 PRINTCHAR (' ');
1819 if (print_length && i > print_length)
1821 strout ("...", 3, 3, printcharfun, 0);
1822 goto end_of_list;
1825 print_object (XCAR (obj), printcharfun, escapeflag);
1827 obj = XCDR (obj);
1828 if (!(i & 1))
1829 halftail = XCDR (halftail);
1833 /* OBJ non-nil here means it's the end of a dotted list. */
1834 if (!NILP (obj))
1836 strout (" . ", 3, 3, printcharfun, 0);
1837 print_object (obj, printcharfun, escapeflag);
1840 end_of_list:
1841 PRINTCHAR (')');
1843 break;
1845 case Lisp_Vectorlike:
1846 if (PROCESSP (obj))
1848 if (escapeflag)
1850 strout ("#<process ", -1, -1, printcharfun, 0);
1851 print_string (XPROCESS (obj)->name, printcharfun);
1852 PRINTCHAR ('>');
1854 else
1855 print_string (XPROCESS (obj)->name, printcharfun);
1857 else if (BOOL_VECTOR_P (obj))
1859 register int i;
1860 register unsigned char c;
1861 struct gcpro gcpro1;
1862 int size_in_chars
1863 = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
1864 / BOOL_VECTOR_BITS_PER_CHAR);
1866 GCPRO1 (obj);
1868 PRINTCHAR ('#');
1869 PRINTCHAR ('&');
1870 sprintf (buf, "%ld", (long) XBOOL_VECTOR (obj)->size);
1871 strout (buf, -1, -1, printcharfun, 0);
1872 PRINTCHAR ('\"');
1874 /* Don't print more characters than the specified maximum.
1875 Negative values of print-length are invalid. Treat them
1876 like a print-length of nil. */
1877 if (NATNUMP (Vprint_length)
1878 && XFASTINT (Vprint_length) < size_in_chars)
1879 size_in_chars = XFASTINT (Vprint_length);
1881 for (i = 0; i < size_in_chars; i++)
1883 QUIT;
1884 c = XBOOL_VECTOR (obj)->data[i];
1885 if (c == '\n' && print_escape_newlines)
1887 PRINTCHAR ('\\');
1888 PRINTCHAR ('n');
1890 else if (c == '\f' && print_escape_newlines)
1892 PRINTCHAR ('\\');
1893 PRINTCHAR ('f');
1895 else if (c > '\177')
1897 /* Use octal escapes to avoid encoding issues. */
1898 PRINTCHAR ('\\');
1899 PRINTCHAR ('0' + ((c >> 6) & 3));
1900 PRINTCHAR ('0' + ((c >> 3) & 7));
1901 PRINTCHAR ('0' + (c & 7));
1903 else
1905 if (c == '\"' || c == '\\')
1906 PRINTCHAR ('\\');
1907 PRINTCHAR (c);
1910 PRINTCHAR ('\"');
1912 UNGCPRO;
1914 else if (SUBRP (obj))
1916 strout ("#<subr ", -1, -1, printcharfun, 0);
1917 strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun, 0);
1918 PRINTCHAR ('>');
1920 else if (WINDOWP (obj))
1922 strout ("#<window ", -1, -1, printcharfun, 0);
1923 sprintf (buf, "%ld", (long) XFASTINT (XWINDOW (obj)->sequence_number));
1924 strout (buf, -1, -1, printcharfun, 0);
1925 if (!NILP (XWINDOW (obj)->buffer))
1927 strout (" on ", -1, -1, printcharfun, 0);
1928 print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun);
1930 PRINTCHAR ('>');
1932 else if (HASH_TABLE_P (obj))
1934 struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
1935 strout ("#<hash-table", -1, -1, printcharfun, 0);
1936 if (SYMBOLP (h->test))
1938 PRINTCHAR (' ');
1939 PRINTCHAR ('\'');
1940 strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun, 0);
1941 PRINTCHAR (' ');
1942 strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0);
1943 PRINTCHAR (' ');
1944 sprintf (buf, "%ld/%ld", (long) XFASTINT (h->count),
1945 (long) XVECTOR (h->next)->size);
1946 strout (buf, -1, -1, printcharfun, 0);
1948 sprintf (buf, " 0x%lx", (unsigned long) h);
1949 strout (buf, -1, -1, printcharfun, 0);
1950 PRINTCHAR ('>');
1952 else if (BUFFERP (obj))
1954 if (NILP (XBUFFER (obj)->name))
1955 strout ("#<killed buffer>", -1, -1, printcharfun, 0);
1956 else if (escapeflag)
1958 strout ("#<buffer ", -1, -1, printcharfun, 0);
1959 print_string (XBUFFER (obj)->name, printcharfun);
1960 PRINTCHAR ('>');
1962 else
1963 print_string (XBUFFER (obj)->name, printcharfun);
1965 else if (WINDOW_CONFIGURATIONP (obj))
1967 strout ("#<window-configuration>", -1, -1, printcharfun, 0);
1969 else if (FRAMEP (obj))
1971 strout ((FRAME_LIVE_P (XFRAME (obj))
1972 ? "#<frame " : "#<dead frame "),
1973 -1, -1, printcharfun, 0);
1974 print_string (XFRAME (obj)->name, printcharfun);
1975 sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj)));
1976 strout (buf, -1, -1, printcharfun, 0);
1977 PRINTCHAR ('>');
1979 else
1981 EMACS_INT size = XVECTOR (obj)->size;
1982 if (COMPILEDP (obj))
1984 PRINTCHAR ('#');
1985 size &= PSEUDOVECTOR_SIZE_MASK;
1987 if (CHAR_TABLE_P (obj))
1989 /* We print a char-table as if it were a vector,
1990 lumping the parent and default slots in with the
1991 character slots. But we add #^ as a prefix. */
1992 PRINTCHAR ('#');
1993 PRINTCHAR ('^');
1994 if (SUB_CHAR_TABLE_P (obj))
1995 PRINTCHAR ('^');
1996 size &= PSEUDOVECTOR_SIZE_MASK;
1998 if (size & PSEUDOVECTOR_FLAG)
1999 goto badtype;
2001 PRINTCHAR ('[');
2003 register int i;
2004 register Lisp_Object tem;
2005 int real_size = size;
2007 /* Don't print more elements than the specified maximum. */
2008 if (NATNUMP (Vprint_length)
2009 && XFASTINT (Vprint_length) < size)
2010 size = XFASTINT (Vprint_length);
2012 for (i = 0; i < size; i++)
2014 if (i) PRINTCHAR (' ');
2015 tem = XVECTOR (obj)->contents[i];
2016 print_object (tem, printcharfun, escapeflag);
2018 if (size < real_size)
2019 strout (" ...", 4, 4, printcharfun, 0);
2021 PRINTCHAR (']');
2023 break;
2025 case Lisp_Misc:
2026 switch (XMISCTYPE (obj))
2028 case Lisp_Misc_Marker:
2029 strout ("#<marker ", -1, -1, printcharfun, 0);
2030 /* Do you think this is necessary? */
2031 if (XMARKER (obj)->insertion_type != 0)
2032 strout ("(moves after insertion) ", -1, -1, printcharfun, 0);
2033 if (!(XMARKER (obj)->buffer))
2034 strout ("in no buffer", -1, -1, printcharfun, 0);
2035 else
2037 sprintf (buf, "at %d", marker_position (obj));
2038 strout (buf, -1, -1, printcharfun, 0);
2039 strout (" in ", -1, -1, printcharfun, 0);
2040 print_string (XMARKER (obj)->buffer->name, printcharfun);
2042 PRINTCHAR ('>');
2043 break;
2045 case Lisp_Misc_Overlay:
2046 strout ("#<overlay ", -1, -1, printcharfun, 0);
2047 if (!(XMARKER (OVERLAY_START (obj))->buffer))
2048 strout ("in no buffer", -1, -1, printcharfun, 0);
2049 else
2051 sprintf (buf, "from %d to %d in ",
2052 marker_position (OVERLAY_START (obj)),
2053 marker_position (OVERLAY_END (obj)));
2054 strout (buf, -1, -1, printcharfun, 0);
2055 print_string (XMARKER (OVERLAY_START (obj))->buffer->name,
2056 printcharfun);
2058 PRINTCHAR ('>');
2059 break;
2061 /* Remaining cases shouldn't happen in normal usage, but let's print
2062 them anyway for the benefit of the debugger. */
2063 case Lisp_Misc_Free:
2064 strout ("#<misc free cell>", -1, -1, printcharfun, 0);
2065 break;
2067 case Lisp_Misc_Intfwd:
2068 sprintf (buf, "#<intfwd to %ld>", (long) *XINTFWD (obj)->intvar);
2069 strout (buf, -1, -1, printcharfun, 0);
2070 break;
2072 case Lisp_Misc_Boolfwd:
2073 sprintf (buf, "#<boolfwd to %s>",
2074 (*XBOOLFWD (obj)->boolvar ? "t" : "nil"));
2075 strout (buf, -1, -1, printcharfun, 0);
2076 break;
2078 case Lisp_Misc_Objfwd:
2079 strout ("#<objfwd to ", -1, -1, printcharfun, 0);
2080 print_object (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
2081 PRINTCHAR ('>');
2082 break;
2084 case Lisp_Misc_Buffer_Objfwd:
2085 strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
2086 print_object (PER_BUFFER_VALUE (current_buffer,
2087 XBUFFER_OBJFWD (obj)->offset),
2088 printcharfun, escapeflag);
2089 PRINTCHAR ('>');
2090 break;
2092 case Lisp_Misc_Kboard_Objfwd:
2093 strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
2094 print_object (*(Lisp_Object *)((char *) current_kboard
2095 + XKBOARD_OBJFWD (obj)->offset),
2096 printcharfun, escapeflag);
2097 PRINTCHAR ('>');
2098 break;
2100 case Lisp_Misc_Buffer_Local_Value:
2101 strout ("#<buffer_local_value ", -1, -1, printcharfun, 0);
2102 goto do_buffer_local;
2103 case Lisp_Misc_Some_Buffer_Local_Value:
2104 strout ("#<some_buffer_local_value ", -1, -1, printcharfun, 0);
2105 do_buffer_local:
2106 strout ("[realvalue] ", -1, -1, printcharfun, 0);
2107 print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue,
2108 printcharfun, escapeflag);
2109 if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer)
2110 strout ("[local in buffer] ", -1, -1, printcharfun, 0);
2111 else
2112 strout ("[buffer] ", -1, -1, printcharfun, 0);
2113 print_object (XBUFFER_LOCAL_VALUE (obj)->buffer,
2114 printcharfun, escapeflag);
2115 if (XBUFFER_LOCAL_VALUE (obj)->check_frame)
2117 if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame)
2118 strout ("[local in frame] ", -1, -1, printcharfun, 0);
2119 else
2120 strout ("[frame] ", -1, -1, printcharfun, 0);
2121 print_object (XBUFFER_LOCAL_VALUE (obj)->frame,
2122 printcharfun, escapeflag);
2124 strout ("[alist-elt] ", -1, -1, printcharfun, 0);
2125 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj)->cdr),
2126 printcharfun, escapeflag);
2127 strout ("[default-value] ", -1, -1, printcharfun, 0);
2128 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj)->cdr),
2129 printcharfun, escapeflag);
2130 PRINTCHAR ('>');
2131 break;
2133 case Lisp_Misc_Save_Value:
2134 strout ("#<save_value ", -1, -1, printcharfun, 0);
2135 sprintf(buf, "ptr=0x%08lx int=%d",
2136 (unsigned long) XSAVE_VALUE (obj)->pointer,
2137 XSAVE_VALUE (obj)->integer);
2138 strout (buf, -1, -1, printcharfun, 0);
2139 PRINTCHAR ('>');
2140 break;
2142 default:
2143 goto badtype;
2145 break;
2147 default:
2148 badtype:
2150 /* We're in trouble if this happens!
2151 Probably should just abort () */
2152 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun, 0);
2153 if (MISCP (obj))
2154 sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
2155 else if (VECTORLIKEP (obj))
2156 sprintf (buf, "(PVEC 0x%08x)", (int) XVECTOR (obj)->size);
2157 else
2158 sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
2159 strout (buf, -1, -1, printcharfun, 0);
2160 strout (" Save your buffers immediately and please report this bug>",
2161 -1, -1, printcharfun, 0);
2165 print_depth--;
2169 /* Print a description of INTERVAL using PRINTCHARFUN.
2170 This is part of printing a string that has text properties. */
2172 void
2173 print_interval (interval, printcharfun)
2174 INTERVAL interval;
2175 Lisp_Object printcharfun;
2177 PRINTCHAR (' ');
2178 print_object (make_number (interval->position), printcharfun, 1);
2179 PRINTCHAR (' ');
2180 print_object (make_number (interval->position + LENGTH (interval)),
2181 printcharfun, 1);
2182 PRINTCHAR (' ');
2183 print_object (interval->plist, printcharfun, 1);
2187 void
2188 syms_of_print ()
2190 Qtemp_buffer_setup_hook = intern ("temp-buffer-setup-hook");
2191 staticpro (&Qtemp_buffer_setup_hook);
2193 DEFVAR_LISP ("standard-output", &Vstandard_output,
2194 doc: /* Output stream `print' uses by default for outputting a character.
2195 This may be any function of one argument.
2196 It may also be a buffer (output is inserted before point)
2197 or a marker (output is inserted and the marker is advanced)
2198 or the symbol t (output appears in the echo area). */);
2199 Vstandard_output = Qt;
2200 Qstandard_output = intern ("standard-output");
2201 staticpro (&Qstandard_output);
2203 DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
2204 doc: /* The format descriptor string used to print floats.
2205 This is a %-spec like those accepted by `printf' in C,
2206 but with some restrictions. It must start with the two characters `%.'.
2207 After that comes an integer precision specification,
2208 and then a letter which controls the format.
2209 The letters allowed are `e', `f' and `g'.
2210 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2211 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2212 Use `g' to choose the shorter of those two formats for the number at hand.
2213 The precision in any of these cases is the number of digits following
2214 the decimal point. With `f', a precision of 0 means to omit the
2215 decimal point. 0 is not allowed with `e' or `g'.
2217 A value of nil means to use the shortest notation
2218 that represents the number without losing information. */);
2219 Vfloat_output_format = Qnil;
2220 Qfloat_output_format = intern ("float-output-format");
2221 staticpro (&Qfloat_output_format);
2223 DEFVAR_LISP ("print-length", &Vprint_length,
2224 doc: /* Maximum length of list to print before abbreviating.
2225 A value of nil means no limit. See also `eval-expression-print-length'. */);
2226 Vprint_length = Qnil;
2228 DEFVAR_LISP ("print-level", &Vprint_level,
2229 doc: /* Maximum depth of list nesting to print before abbreviating.
2230 A value of nil means no limit. See also `eval-expression-print-level'. */);
2231 Vprint_level = Qnil;
2233 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
2234 doc: /* Non-nil means print newlines in strings as `\\n'.
2235 Also print formfeeds as `\\f'. */);
2236 print_escape_newlines = 0;
2238 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii,
2239 doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2240 \(OOO is the octal representation of the character code.)
2241 Only single-byte characters are affected, and only in `prin1'.
2242 When the output goes in a multibyte buffer, this feature is
2243 enabled regardless of the value of the variable. */);
2244 print_escape_nonascii = 0;
2246 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte,
2247 doc: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2248 \(XXXX is the hex representation of the character code.)
2249 This affects only `prin1'. */);
2250 print_escape_multibyte = 0;
2252 DEFVAR_BOOL ("print-quoted", &print_quoted,
2253 doc: /* Non-nil means print quoted forms with reader syntax.
2254 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2255 forms print as in the new syntax. */);
2256 print_quoted = 0;
2258 DEFVAR_LISP ("print-gensym", &Vprint_gensym,
2259 doc: /* Non-nil means print uninterned symbols so they will read as uninterned.
2260 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2261 When the uninterned symbol appears within a recursive data structure,
2262 and the symbol appears more than once, in addition use the #N# and #N=
2263 constructs as needed, so that multiple references to the same symbol are
2264 shared once again when the text is read back. */);
2265 Vprint_gensym = Qnil;
2267 DEFVAR_LISP ("print-circle", &Vprint_circle,
2268 doc: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2269 If nil, printing proceeds recursively and may lead to
2270 `max-lisp-eval-depth' being exceeded or an error may occur:
2271 \"Apparently circular structure being printed.\" Also see
2272 `print-length' and `print-level'.
2273 If non-nil, shared substructures anywhere in the structure are printed
2274 with `#N=' before the first occurrence (in the order of the print
2275 representation) and `#N#' in place of each subsequent occurrence,
2276 where N is a positive decimal integer. */);
2277 Vprint_circle = Qnil;
2279 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering,
2280 doc: /* *Non-nil means number continuously across print calls.
2281 This affects the numbers printed for #N= labels and #M# references.
2282 See also `print-circle', `print-gensym', and `print-number-table'.
2283 This variable should not be set with `setq'; bind it with a `let' instead. */);
2284 Vprint_continuous_numbering = Qnil;
2286 DEFVAR_LISP ("print-number-table", &Vprint_number_table,
2287 doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
2288 The Lisp printer uses this vector to detect Lisp objects referenced more
2289 than once.
2291 When you bind `print-continuous-numbering' to t, you should probably
2292 also bind `print-number-table' to nil. This ensures that the value of
2293 `print-number-table' can be garbage-collected once the printing is
2294 done. If all elements of `print-number-table' are nil, it means that
2295 the printing done so far has not found any shared structure or objects
2296 that need to be recorded in the table. */);
2297 Vprint_number_table = Qnil;
2299 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2300 staticpro (&Vprin1_to_string_buffer);
2302 defsubr (&Sprin1);
2303 defsubr (&Sprin1_to_string);
2304 defsubr (&Serror_message_string);
2305 defsubr (&Sprinc);
2306 defsubr (&Sprint);
2307 defsubr (&Sterpri);
2308 defsubr (&Swrite_char);
2309 defsubr (&Sexternal_debugging_output);
2310 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2311 defsubr (&Sredirect_debugging_output);
2312 #endif
2314 Qexternal_debugging_output = intern ("external-debugging-output");
2315 staticpro (&Qexternal_debugging_output);
2317 Qprint_escape_newlines = intern ("print-escape-newlines");
2318 staticpro (&Qprint_escape_newlines);
2320 Qprint_escape_multibyte = intern ("print-escape-multibyte");
2321 staticpro (&Qprint_escape_multibyte);
2323 Qprint_escape_nonascii = intern ("print-escape-nonascii");
2324 staticpro (&Qprint_escape_nonascii);
2326 defsubr (&Swith_output_to_temp_buffer);
2329 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2330 (do not change this comment) */