Better seed support for (random).
[emacs.git] / src / print.c
blob52c07c79122627dabbcede750747e902e933c37e
1 /* Lisp object printing and output streams.
3 Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012
4 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 3 of the License, or
11 (at your option) 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. If not, see <http://www.gnu.org/licenses/>. */
22 #include <config.h>
23 #include <stdio.h>
24 #include <setjmp.h>
25 #include "lisp.h"
26 #include "character.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"
36 #include "blockinput.h"
37 #include "termhooks.h" /* For struct terminal. */
38 #include "font.h"
40 Lisp_Object Qstandard_output;
42 static Lisp_Object Qtemp_buffer_setup_hook;
44 /* These are used to print like we read. */
46 static Lisp_Object Qfloat_output_format;
48 #include <math.h>
49 #include <float.h>
50 #include <ftoastr.h>
52 /* Default to values appropriate for IEEE floating point. */
53 #ifndef DBL_DIG
54 #define DBL_DIG 15
55 #endif
57 /* Avoid actual stack overflow in print. */
58 static ptrdiff_t print_depth;
60 /* Level of nesting inside outputting backquote in new style. */
61 static ptrdiff_t new_backquote_output;
63 /* Detect most circularities to print finite output. */
64 #define PRINT_CIRCLE 200
65 static Lisp_Object being_printed[PRINT_CIRCLE];
67 /* When printing into a buffer, first we put the text in this
68 block, then insert it all at once. */
69 static char *print_buffer;
71 /* Size allocated in print_buffer. */
72 static ptrdiff_t print_buffer_size;
73 /* Chars stored in print_buffer. */
74 static ptrdiff_t print_buffer_pos;
75 /* Bytes stored in print_buffer. */
76 static ptrdiff_t print_buffer_pos_byte;
78 Lisp_Object Qprint_escape_newlines;
79 static Lisp_Object Qprint_escape_multibyte, Qprint_escape_nonascii;
81 /* Vprint_number_table is a table, that keeps objects that are going to
82 be printed, to allow use of #n= and #n# to express sharing.
83 For any given object, the table can give the following values:
84 t the object will be printed only once.
85 -N the object will be printed several times and will take number N.
86 N the object has been printed so we can refer to it as #N#.
87 print_number_index holds the largest N already used.
88 N has to be striclty larger than 0 since we need to distinguish -N. */
89 static ptrdiff_t print_number_index;
90 static void print_interval (INTERVAL interval, Lisp_Object printcharfun);
92 /* GDB resets this to zero on W32 to disable OutputDebugString calls. */
93 int print_output_debug_flag EXTERNALLY_VISIBLE = 1;
96 /* Low level output routines for characters and strings. */
98 /* Lisp functions to do output using a stream
99 must have the stream in a variable called printcharfun
100 and must start with PRINTPREPARE, end with PRINTFINISH,
101 and use PRINTDECLARE to declare common variables.
102 Use PRINTCHAR to output one character,
103 or call strout to output a block of characters. */
105 #define PRINTDECLARE \
106 struct buffer *old = current_buffer; \
107 ptrdiff_t old_point = -1, start_point = -1; \
108 ptrdiff_t old_point_byte = -1, start_point_byte = -1; \
109 ptrdiff_t specpdl_count = SPECPDL_INDEX (); \
110 int free_print_buffer = 0; \
111 int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \
112 Lisp_Object original
114 #define PRINTPREPARE \
115 original = printcharfun; \
116 if (NILP (printcharfun)) printcharfun = Qt; \
117 if (BUFFERP (printcharfun)) \
119 if (XBUFFER (printcharfun) != current_buffer) \
120 Fset_buffer (printcharfun); \
121 printcharfun = Qnil; \
123 if (MARKERP (printcharfun)) \
125 ptrdiff_t marker_pos; \
126 if (! XMARKER (printcharfun)->buffer) \
127 error ("Marker does not point anywhere"); \
128 if (XMARKER (printcharfun)->buffer != current_buffer) \
129 set_buffer_internal (XMARKER (printcharfun)->buffer); \
130 marker_pos = marker_position (printcharfun); \
131 if (marker_pos < BEGV || marker_pos > ZV) \
132 error ("Marker is outside the accessible part of the buffer"); \
133 old_point = PT; \
134 old_point_byte = PT_BYTE; \
135 SET_PT_BOTH (marker_pos, \
136 marker_byte_position (printcharfun)); \
137 start_point = PT; \
138 start_point_byte = PT_BYTE; \
139 printcharfun = Qnil; \
141 if (NILP (printcharfun)) \
143 Lisp_Object string; \
144 if (NILP (BVAR (current_buffer, enable_multibyte_characters)) \
145 && ! print_escape_multibyte) \
146 specbind (Qprint_escape_multibyte, Qt); \
147 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)) \
148 && ! print_escape_nonascii) \
149 specbind (Qprint_escape_nonascii, Qt); \
150 if (print_buffer != 0) \
152 string = make_string_from_bytes (print_buffer, \
153 print_buffer_pos, \
154 print_buffer_pos_byte); \
155 record_unwind_protect (print_unwind, string); \
157 else \
159 int new_size = 1000; \
160 print_buffer = xmalloc (new_size); \
161 print_buffer_size = new_size; \
162 free_print_buffer = 1; \
164 print_buffer_pos = 0; \
165 print_buffer_pos_byte = 0; \
167 if (EQ (printcharfun, Qt) && ! noninteractive) \
168 setup_echo_area_for_printing (multibyte);
170 #define PRINTFINISH \
171 if (NILP (printcharfun)) \
173 if (print_buffer_pos != print_buffer_pos_byte \
174 && NILP (BVAR (current_buffer, enable_multibyte_characters))) \
176 unsigned char *temp = alloca (print_buffer_pos + 1); \
177 copy_text ((unsigned char *) print_buffer, temp, \
178 print_buffer_pos_byte, 1, 0); \
179 insert_1_both ((char *) temp, print_buffer_pos, \
180 print_buffer_pos, 0, 1, 0); \
182 else \
183 insert_1_both (print_buffer, print_buffer_pos, \
184 print_buffer_pos_byte, 0, 1, 0); \
185 signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
187 if (free_print_buffer) \
189 xfree (print_buffer); \
190 print_buffer = 0; \
192 unbind_to (specpdl_count, Qnil); \
193 if (MARKERP (original)) \
194 set_marker_both (original, Qnil, PT, PT_BYTE); \
195 if (old_point >= 0) \
196 SET_PT_BOTH (old_point + (old_point >= start_point \
197 ? PT - start_point : 0), \
198 old_point_byte + (old_point_byte >= start_point_byte \
199 ? PT_BYTE - start_point_byte : 0)); \
200 set_buffer_internal (old);
202 #define PRINTCHAR(ch) printchar (ch, printcharfun)
204 /* This is used to restore the saved contents of print_buffer
205 when there is a recursive call to print. */
207 static Lisp_Object
208 print_unwind (Lisp_Object saved_text)
210 memcpy (print_buffer, SDATA (saved_text), SCHARS (saved_text));
211 return Qnil;
215 /* Print character CH using method FUN. FUN nil means print to
216 print_buffer. FUN t means print to echo area or stdout if
217 non-interactive. If FUN is neither nil nor t, call FUN with CH as
218 argument. */
220 static void
221 printchar (unsigned int ch, Lisp_Object fun)
223 if (!NILP (fun) && !EQ (fun, Qt))
224 call1 (fun, make_number (ch));
225 else
227 unsigned char str[MAX_MULTIBYTE_LENGTH];
228 int len = CHAR_STRING (ch, str);
230 QUIT;
232 if (NILP (fun))
234 ptrdiff_t incr = len - (print_buffer_size - print_buffer_pos_byte);
235 if (0 < incr)
236 print_buffer =
237 xpalloc (print_buffer, &print_buffer_size, incr, -1, 1);
238 memcpy (print_buffer + print_buffer_pos_byte, str, len);
239 print_buffer_pos += 1;
240 print_buffer_pos_byte += len;
242 else if (noninteractive)
244 fwrite (str, 1, len, stdout);
245 noninteractive_need_newline = 1;
247 else
249 int multibyte_p
250 = !NILP (BVAR (current_buffer, enable_multibyte_characters));
252 setup_echo_area_for_printing (multibyte_p);
253 insert_char (ch);
254 message_dolog ((char *) str, len, 0, multibyte_p);
260 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
261 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
262 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
263 print_buffer. PRINTCHARFUN t means output to the echo area or to
264 stdout if non-interactive. If neither nil nor t, call Lisp
265 function PRINTCHARFUN for each character printed. MULTIBYTE
266 non-zero means PTR contains multibyte characters.
268 In the case where PRINTCHARFUN is nil, it is safe for PTR to point
269 to data in a Lisp string. Otherwise that is not safe. */
271 static void
272 strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
273 Lisp_Object printcharfun)
275 if (size < 0)
276 size_byte = size = strlen (ptr);
278 if (NILP (printcharfun))
280 ptrdiff_t incr = size_byte - (print_buffer_size - print_buffer_pos_byte);
281 if (0 < incr)
282 print_buffer = xpalloc (print_buffer, &print_buffer_size, incr, -1, 1);
283 memcpy (print_buffer + print_buffer_pos_byte, ptr, size_byte);
284 print_buffer_pos += size;
285 print_buffer_pos_byte += size_byte;
287 else if (noninteractive && EQ (printcharfun, Qt))
289 fwrite (ptr, 1, size_byte, stdout);
290 noninteractive_need_newline = 1;
292 else if (EQ (printcharfun, Qt))
294 /* Output to echo area. We're trying to avoid a little overhead
295 here, that's the reason we don't call printchar to do the
296 job. */
297 int i;
298 int multibyte_p
299 = !NILP (BVAR (current_buffer, enable_multibyte_characters));
301 setup_echo_area_for_printing (multibyte_p);
302 message_dolog (ptr, size_byte, 0, multibyte_p);
304 if (size == size_byte)
306 for (i = 0; i < size; ++i)
307 insert_char ((unsigned char) *ptr++);
309 else
311 int len;
312 for (i = 0; i < size_byte; i += len)
314 int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
315 len);
316 insert_char (ch);
320 else
322 /* PRINTCHARFUN is a Lisp function. */
323 ptrdiff_t i = 0;
325 if (size == size_byte)
327 while (i < size_byte)
329 int ch = ptr[i++];
330 PRINTCHAR (ch);
333 else
335 while (i < size_byte)
337 /* Here, we must convert each multi-byte form to the
338 corresponding character code before handing it to
339 PRINTCHAR. */
340 int len;
341 int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
342 len);
343 PRINTCHAR (ch);
344 i += len;
350 /* Print the contents of a string STRING using PRINTCHARFUN.
351 It isn't safe to use strout in many cases,
352 because printing one char can relocate. */
354 static void
355 print_string (Lisp_Object string, Lisp_Object printcharfun)
357 if (EQ (printcharfun, Qt) || NILP (printcharfun))
359 ptrdiff_t chars;
361 if (print_escape_nonascii)
362 string = string_escape_byte8 (string);
364 if (STRING_MULTIBYTE (string))
365 chars = SCHARS (string);
366 else if (! print_escape_nonascii
367 && (EQ (printcharfun, Qt)
368 ? ! NILP (BVAR (&buffer_defaults, enable_multibyte_characters))
369 : ! NILP (BVAR (current_buffer, enable_multibyte_characters))))
371 /* If unibyte string STRING contains 8-bit codes, we must
372 convert STRING to a multibyte string containing the same
373 character codes. */
374 Lisp_Object newstr;
375 ptrdiff_t bytes;
377 chars = SBYTES (string);
378 bytes = count_size_as_multibyte (SDATA (string), chars);
379 if (chars < bytes)
381 newstr = make_uninit_multibyte_string (chars, bytes);
382 memcpy (SDATA (newstr), SDATA (string), chars);
383 str_to_multibyte (SDATA (newstr), bytes, chars);
384 string = newstr;
387 else
388 chars = SBYTES (string);
390 if (EQ (printcharfun, Qt))
392 /* Output to echo area. */
393 ptrdiff_t nbytes = SBYTES (string);
395 /* Copy the string contents so that relocation of STRING by
396 GC does not cause trouble. */
397 USE_SAFE_ALLOCA;
398 char *buffer = SAFE_ALLOCA (nbytes);
399 memcpy (buffer, SDATA (string), nbytes);
401 strout (buffer, chars, nbytes, printcharfun);
403 SAFE_FREE ();
405 else
406 /* No need to copy, since output to print_buffer can't GC. */
407 strout (SSDATA (string), chars, SBYTES (string), printcharfun);
409 else
411 /* Otherwise, string may be relocated by printing one char.
412 So re-fetch the string address for each character. */
413 ptrdiff_t i;
414 ptrdiff_t size = SCHARS (string);
415 ptrdiff_t size_byte = SBYTES (string);
416 struct gcpro gcpro1;
417 GCPRO1 (string);
418 if (size == size_byte)
419 for (i = 0; i < size; i++)
420 PRINTCHAR (SREF (string, i));
421 else
422 for (i = 0; i < size_byte; )
424 /* Here, we must convert each multi-byte form to the
425 corresponding character code before handing it to PRINTCHAR. */
426 int len;
427 int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i, len);
428 PRINTCHAR (ch);
429 i += len;
431 UNGCPRO;
435 DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
436 doc: /* Output character CHARACTER to stream PRINTCHARFUN.
437 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
438 (Lisp_Object character, Lisp_Object printcharfun)
440 PRINTDECLARE;
442 if (NILP (printcharfun))
443 printcharfun = Vstandard_output;
444 CHECK_NUMBER (character);
445 PRINTPREPARE;
446 PRINTCHAR (XINT (character));
447 PRINTFINISH;
448 return character;
451 /* Used from outside of print.c to print a block of SIZE
452 single-byte chars at DATA on the default output stream.
453 Do not use this on the contents of a Lisp string. */
455 void
456 write_string (const char *data, int size)
458 PRINTDECLARE;
459 Lisp_Object printcharfun;
461 printcharfun = Vstandard_output;
463 PRINTPREPARE;
464 strout (data, size, size, printcharfun);
465 PRINTFINISH;
468 /* Used to print a block of SIZE single-byte chars at DATA on a
469 specified stream PRINTCHARFUN.
470 Do not use this on the contents of a Lisp string. */
472 static void
473 write_string_1 (const char *data, int size, Lisp_Object printcharfun)
475 PRINTDECLARE;
477 PRINTPREPARE;
478 strout (data, size, size, printcharfun);
479 PRINTFINISH;
483 void
484 temp_output_buffer_setup (const char *bufname)
486 ptrdiff_t count = SPECPDL_INDEX ();
487 register struct buffer *old = current_buffer;
488 register Lisp_Object buf;
490 record_unwind_current_buffer ();
492 Fset_buffer (Fget_buffer_create (build_string (bufname)));
494 Fkill_all_local_variables ();
495 delete_all_overlays (current_buffer);
496 bset_directory (current_buffer, BVAR (old, directory));
497 bset_read_only (current_buffer, Qnil);
498 bset_filename (current_buffer, Qnil);
499 bset_undo_list (current_buffer, Qt);
500 eassert (current_buffer->overlays_before == NULL);
501 eassert (current_buffer->overlays_after == NULL);
502 bset_enable_multibyte_characters
503 (current_buffer, BVAR (&buffer_defaults, enable_multibyte_characters));
504 specbind (Qinhibit_read_only, Qt);
505 specbind (Qinhibit_modification_hooks, Qt);
506 Ferase_buffer ();
507 XSETBUFFER (buf, current_buffer);
509 Frun_hooks (1, &Qtemp_buffer_setup_hook);
511 unbind_to (count, Qnil);
513 specbind (Qstandard_output, buf);
516 static void print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag);
517 static void print_preprocess (Lisp_Object obj);
518 static void print_preprocess_string (INTERVAL interval, Lisp_Object arg);
519 static void print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag);
521 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
522 doc: /* Output a newline to stream PRINTCHARFUN.
523 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
524 (Lisp_Object printcharfun)
526 PRINTDECLARE;
528 if (NILP (printcharfun))
529 printcharfun = Vstandard_output;
530 PRINTPREPARE;
531 PRINTCHAR ('\n');
532 PRINTFINISH;
533 return Qt;
536 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
537 doc: /* Output the printed representation of OBJECT, any Lisp object.
538 Quoting characters are printed when needed to make output that `read'
539 can handle, whenever this is possible. For complex objects, the behavior
540 is controlled by `print-level' and `print-length', which see.
542 OBJECT is any of the Lisp data types: a number, a string, a symbol,
543 a list, a buffer, a window, a frame, etc.
545 A printed representation of an object is text which describes that object.
547 Optional argument PRINTCHARFUN is the output stream, which can be one
548 of these:
550 - a buffer, in which case output is inserted into that buffer at point;
551 - a marker, in which case output is inserted at marker's position;
552 - a function, in which case that function is called once for each
553 character of OBJECT's printed representation;
554 - a symbol, in which case that symbol's function definition is called; or
555 - t, in which case the output is displayed in the echo area.
557 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
558 is used instead. */)
559 (Lisp_Object object, Lisp_Object printcharfun)
561 PRINTDECLARE;
563 if (NILP (printcharfun))
564 printcharfun = Vstandard_output;
565 PRINTPREPARE;
566 print (object, printcharfun, 1);
567 PRINTFINISH;
568 return object;
571 /* a buffer which is used to hold output being built by prin1-to-string */
572 Lisp_Object Vprin1_to_string_buffer;
574 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
575 doc: /* Return a string containing the printed representation of OBJECT.
576 OBJECT can be any Lisp object. This function outputs quoting characters
577 when necessary to make output that `read' can handle, whenever possible,
578 unless the optional second argument NOESCAPE is non-nil. For complex objects,
579 the behavior is controlled by `print-level' and `print-length', which see.
581 OBJECT is any of the Lisp data types: a number, a string, a symbol,
582 a list, a buffer, a window, a frame, etc.
584 A printed representation of an object is text which describes that object. */)
585 (Lisp_Object object, Lisp_Object noescape)
587 Lisp_Object printcharfun;
588 bool prev_abort_on_gc;
589 /* struct gcpro gcpro1, gcpro2; */
590 Lisp_Object save_deactivate_mark;
591 ptrdiff_t count = SPECPDL_INDEX ();
592 struct buffer *previous;
594 specbind (Qinhibit_modification_hooks, Qt);
597 PRINTDECLARE;
599 /* Save and restore this--we are altering a buffer
600 but we don't want to deactivate the mark just for that.
601 No need for specbind, since errors deactivate the mark. */
602 save_deactivate_mark = Vdeactivate_mark;
603 /* GCPRO2 (object, save_deactivate_mark); */
604 prev_abort_on_gc = abort_on_gc;
605 abort_on_gc = 1;
607 printcharfun = Vprin1_to_string_buffer;
608 PRINTPREPARE;
609 print (object, printcharfun, NILP (noescape));
610 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINISH */
611 PRINTFINISH;
614 previous = current_buffer;
615 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
616 object = Fbuffer_string ();
617 if (SBYTES (object) == SCHARS (object))
618 STRING_SET_UNIBYTE (object);
620 /* Note that this won't make prepare_to_modify_buffer call
621 ask-user-about-supersession-threat because this buffer
622 does not visit a file. */
623 Ferase_buffer ();
624 set_buffer_internal (previous);
626 Vdeactivate_mark = save_deactivate_mark;
627 /* UNGCPRO; */
629 abort_on_gc = prev_abort_on_gc;
630 return unbind_to (count, object);
633 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
634 doc: /* Output the printed representation of OBJECT, any Lisp object.
635 No quoting characters are used; no delimiters are printed around
636 the contents of strings.
638 OBJECT is any of the Lisp data types: a number, a string, a symbol,
639 a list, a buffer, a window, a frame, etc.
641 A printed representation of an object is text which describes that object.
643 Optional argument PRINTCHARFUN is the output stream, which can be one
644 of these:
646 - a buffer, in which case output is inserted into that buffer at point;
647 - a marker, in which case output is inserted at marker's position;
648 - a function, in which case that function is called once for each
649 character of OBJECT's printed representation;
650 - a symbol, in which case that symbol's function definition is called; or
651 - t, in which case the output is displayed in the echo area.
653 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
654 is used instead. */)
655 (Lisp_Object object, Lisp_Object printcharfun)
657 PRINTDECLARE;
659 if (NILP (printcharfun))
660 printcharfun = Vstandard_output;
661 PRINTPREPARE;
662 print (object, printcharfun, 0);
663 PRINTFINISH;
664 return object;
667 DEFUN ("print", Fprint, Sprint, 1, 2, 0,
668 doc: /* Output the printed representation of OBJECT, with newlines around it.
669 Quoting characters are printed when needed to make output that `read'
670 can handle, whenever this is possible. For complex objects, the behavior
671 is controlled by `print-level' and `print-length', which see.
673 OBJECT is any of the Lisp data types: a number, a string, a symbol,
674 a list, a buffer, a window, a frame, etc.
676 A printed representation of an object is text which describes that object.
678 Optional argument PRINTCHARFUN is the output stream, which can be one
679 of these:
681 - a buffer, in which case output is inserted into that buffer at point;
682 - a marker, in which case output is inserted at marker's position;
683 - a function, in which case that function is called once for each
684 character of OBJECT's printed representation;
685 - a symbol, in which case that symbol's function definition is called; or
686 - t, in which case the output is displayed in the echo area.
688 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
689 is used instead. */)
690 (Lisp_Object object, Lisp_Object printcharfun)
692 PRINTDECLARE;
693 struct gcpro gcpro1;
695 if (NILP (printcharfun))
696 printcharfun = Vstandard_output;
697 GCPRO1 (object);
698 PRINTPREPARE;
699 PRINTCHAR ('\n');
700 print (object, printcharfun, 1);
701 PRINTCHAR ('\n');
702 PRINTFINISH;
703 UNGCPRO;
704 return object;
707 /* The subroutine object for external-debugging-output is kept here
708 for the convenience of the debugger. */
709 Lisp_Object Qexternal_debugging_output;
711 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
712 doc: /* Write CHARACTER to stderr.
713 You can call print while debugging emacs, and pass it this function
714 to make it write to the debugging output. */)
715 (Lisp_Object character)
717 CHECK_NUMBER (character);
718 putc (XINT (character) & 0xFF, stderr);
720 #ifdef WINDOWSNT
721 /* Send the output to a debugger (nothing happens if there isn't one). */
722 if (print_output_debug_flag)
724 char buf[2] = {(char) XINT (character), '\0'};
725 OutputDebugString (buf);
727 #endif
729 return character;
732 /* This function is never called. Its purpose is to prevent
733 print_output_debug_flag from being optimized away. */
735 extern void debug_output_compilation_hack (int) EXTERNALLY_VISIBLE;
736 void
737 debug_output_compilation_hack (int x)
739 print_output_debug_flag = x;
742 #if defined (GNU_LINUX)
744 /* This functionality is not vitally important in general, so we rely on
745 non-portable ability to use stderr as lvalue. */
747 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
749 static FILE *initial_stderr_stream = NULL;
751 DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output,
752 1, 2,
753 "FDebug output file: \nP",
754 doc: /* Redirect debugging output (stderr stream) to file FILE.
755 If FILE is nil, reset target to the initial stderr stream.
756 Optional arg APPEND non-nil (interactively, with prefix arg) means
757 append to existing target file. */)
758 (Lisp_Object file, Lisp_Object append)
760 if (initial_stderr_stream != NULL)
762 BLOCK_INPUT;
763 fclose (stderr);
764 UNBLOCK_INPUT;
766 stderr = initial_stderr_stream;
767 initial_stderr_stream = NULL;
769 if (STRINGP (file))
771 file = Fexpand_file_name (file, Qnil);
772 initial_stderr_stream = stderr;
773 stderr = fopen (SSDATA (file), NILP (append) ? "w" : "a");
774 if (stderr == NULL)
776 stderr = initial_stderr_stream;
777 initial_stderr_stream = NULL;
778 report_file_error ("Cannot open debugging output stream",
779 Fcons (file, Qnil));
782 return Qnil;
784 #endif /* GNU_LINUX */
787 /* This is the interface for debugging printing. */
789 void
790 debug_print (Lisp_Object arg)
792 Fprin1 (arg, Qexternal_debugging_output);
793 fprintf (stderr, "\r\n");
796 void safe_debug_print (Lisp_Object) EXTERNALLY_VISIBLE;
797 void
798 safe_debug_print (Lisp_Object arg)
800 int valid = valid_lisp_object_p (arg);
802 if (valid > 0)
803 debug_print (arg);
804 else
805 fprintf (stderr, "#<%s_LISP_OBJECT 0x%08"pI"x>\r\n",
806 !valid ? "INVALID" : "SOME",
807 XHASH (arg));
811 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
812 1, 1, 0,
813 doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
814 See Info anchor `(elisp)Definition of signal' for some details on how this
815 error message is constructed. */)
816 (Lisp_Object obj)
818 struct buffer *old = current_buffer;
819 Lisp_Object value;
820 struct gcpro gcpro1;
822 /* If OBJ is (error STRING), just return STRING.
823 That is not only faster, it also avoids the need to allocate
824 space here when the error is due to memory full. */
825 if (CONSP (obj) && EQ (XCAR (obj), Qerror)
826 && CONSP (XCDR (obj))
827 && STRINGP (XCAR (XCDR (obj)))
828 && NILP (XCDR (XCDR (obj))))
829 return XCAR (XCDR (obj));
831 print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
833 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
834 value = Fbuffer_string ();
836 GCPRO1 (value);
837 Ferase_buffer ();
838 set_buffer_internal (old);
839 UNGCPRO;
841 return value;
844 /* Print an error message for the error DATA onto Lisp output stream
845 STREAM (suitable for the print functions).
846 CONTEXT is a C string describing the context of the error.
847 CALLER is the Lisp function inside which the error was signaled. */
849 void
850 print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
851 Lisp_Object caller)
853 Lisp_Object errname, errmsg, file_error, tail;
854 struct gcpro gcpro1;
856 if (context != 0)
857 write_string_1 (context, -1, stream);
859 /* If we know from where the error was signaled, show it in
860 *Messages*. */
861 if (!NILP (caller) && SYMBOLP (caller))
863 Lisp_Object cname = SYMBOL_NAME (caller);
864 ptrdiff_t cnamelen = SBYTES (cname);
865 USE_SAFE_ALLOCA;
866 char *name = SAFE_ALLOCA (cnamelen);
867 memcpy (name, SDATA (cname), cnamelen);
868 message_dolog (name, cnamelen, 0, 0);
869 message_dolog (": ", 2, 0, 0);
870 SAFE_FREE ();
873 errname = Fcar (data);
875 if (EQ (errname, Qerror))
877 data = Fcdr (data);
878 if (!CONSP (data))
879 data = Qnil;
880 errmsg = Fcar (data);
881 file_error = Qnil;
883 else
885 Lisp_Object error_conditions = Fget (errname, Qerror_conditions);
886 errmsg = Fget (errname, Qerror_message);
887 file_error = Fmemq (Qfile_error, error_conditions);
890 /* Print an error message including the data items. */
892 tail = Fcdr_safe (data);
893 GCPRO1 (tail);
895 /* For file-error, make error message by concatenating
896 all the data items. They are all strings. */
897 if (!NILP (file_error) && CONSP (tail))
898 errmsg = XCAR (tail), tail = XCDR (tail);
901 const char *sep = ": ";
903 if (!STRINGP (errmsg))
904 write_string_1 ("peculiar error", -1, stream);
905 else if (SCHARS (errmsg))
906 Fprinc (errmsg, stream);
907 else
908 sep = NULL;
910 for (; CONSP (tail); tail = XCDR (tail), sep = ", ")
912 Lisp_Object obj;
914 if (sep)
915 write_string_1 (sep, 2, stream);
916 obj = XCAR (tail);
917 if (!NILP (file_error)
918 || EQ (errname, Qend_of_file) || EQ (errname, Quser_error))
919 Fprinc (obj, stream);
920 else
921 Fprin1 (obj, stream);
925 UNGCPRO;
931 * The buffer should be at least as large as the max string size of the
932 * largest float, printed in the biggest notation. This is undoubtedly
933 * 20d float_output_format, with the negative of the C-constant "HUGE"
934 * from <math.h>.
936 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
938 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
939 * case of -1e307 in 20d float_output_format. What is one to do (short of
940 * re-writing _doprnt to be more sane)?
941 * -wsr
942 * Given the above, the buffer must be least FLOAT_TO_STRING_BUFSIZE bytes.
946 float_to_string (char *buf, double data)
948 char *cp;
949 int width;
950 int len;
952 /* Check for plus infinity in a way that won't lose
953 if there is no plus infinity. */
954 if (data == data / 2 && data > 1.0)
956 static char const infinity_string[] = "1.0e+INF";
957 strcpy (buf, infinity_string);
958 return sizeof infinity_string - 1;
960 /* Likewise for minus infinity. */
961 if (data == data / 2 && data < -1.0)
963 static char const minus_infinity_string[] = "-1.0e+INF";
964 strcpy (buf, minus_infinity_string);
965 return sizeof minus_infinity_string - 1;
967 /* Check for NaN in a way that won't fail if there are no NaNs. */
968 if (! (data * 0.0 >= 0.0))
970 /* Prepend "-" if the NaN's sign bit is negative.
971 The sign bit of a double is the bit that is 1 in -0.0. */
972 static char const NaN_string[] = "0.0e+NaN";
973 int i;
974 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
975 int negative = 0;
976 u_data.d = data;
977 u_minus_zero.d = - 0.0;
978 for (i = 0; i < sizeof (double); i++)
979 if (u_data.c[i] & u_minus_zero.c[i])
981 *buf = '-';
982 negative = 1;
983 break;
986 strcpy (buf + negative, NaN_string);
987 return negative + sizeof NaN_string - 1;
990 if (NILP (Vfloat_output_format)
991 || !STRINGP (Vfloat_output_format))
992 lose:
994 /* Generate the fewest number of digits that represent the
995 floating point value without losing information. */
996 len = dtoastr (buf, FLOAT_TO_STRING_BUFSIZE - 2, 0, 0, data);
997 /* The decimal point must be printed, or the byte compiler can
998 get confused (Bug#8033). */
999 width = 1;
1001 else /* oink oink */
1003 /* Check that the spec we have is fully valid.
1004 This means not only valid for printf,
1005 but meant for floats, and reasonable. */
1006 cp = SSDATA (Vfloat_output_format);
1008 if (cp[0] != '%')
1009 goto lose;
1010 if (cp[1] != '.')
1011 goto lose;
1013 cp += 2;
1015 /* Check the width specification. */
1016 width = -1;
1017 if ('0' <= *cp && *cp <= '9')
1019 width = 0;
1022 width = (width * 10) + (*cp++ - '0');
1023 if (DBL_DIG < width)
1024 goto lose;
1026 while (*cp >= '0' && *cp <= '9');
1028 /* A precision of zero is valid only for %f. */
1029 if (width == 0 && *cp != 'f')
1030 goto lose;
1033 if (*cp != 'e' && *cp != 'f' && *cp != 'g')
1034 goto lose;
1036 if (cp[1] != 0)
1037 goto lose;
1039 len = sprintf (buf, SSDATA (Vfloat_output_format), data);
1042 /* Make sure there is a decimal point with digit after, or an
1043 exponent, so that the value is readable as a float. But don't do
1044 this with "%.0f"; it's valid for that not to produce a decimal
1045 point. Note that width can be 0 only for %.0f. */
1046 if (width != 0)
1048 for (cp = buf; *cp; cp++)
1049 if ((*cp < '0' || *cp > '9') && *cp != '-')
1050 break;
1052 if (*cp == '.' && cp[1] == 0)
1054 cp[1] = '0';
1055 cp[2] = 0;
1056 len++;
1058 else if (*cp == 0)
1060 *cp++ = '.';
1061 *cp++ = '0';
1062 *cp++ = 0;
1063 len += 2;
1067 return len;
1071 static void
1072 print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
1074 new_backquote_output = 0;
1076 /* Reset print_number_index and Vprint_number_table only when
1077 the variable Vprint_continuous_numbering is nil. Otherwise,
1078 the values of these variables will be kept between several
1079 print functions. */
1080 if (NILP (Vprint_continuous_numbering)
1081 || NILP (Vprint_number_table))
1083 print_number_index = 0;
1084 Vprint_number_table = Qnil;
1087 /* Construct Vprint_number_table for print-gensym and print-circle. */
1088 if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
1090 /* Construct Vprint_number_table.
1091 This increments print_number_index for the objects added. */
1092 print_depth = 0;
1093 print_preprocess (obj);
1095 if (HASH_TABLE_P (Vprint_number_table))
1096 { /* Remove unnecessary objects, which appear only once in OBJ;
1097 that is, whose status is Qt. */
1098 struct Lisp_Hash_Table *h = XHASH_TABLE (Vprint_number_table);
1099 ptrdiff_t i;
1101 for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
1102 if (!NILP (HASH_HASH (h, i))
1103 && EQ (HASH_VALUE (h, i), Qt))
1104 Fremhash (HASH_KEY (h, i), Vprint_number_table);
1108 print_depth = 0;
1109 print_object (obj, printcharfun, escapeflag);
1112 #define PRINT_CIRCLE_CANDIDATE_P(obj) \
1113 (STRINGP (obj) || CONSP (obj) \
1114 || (VECTORLIKEP (obj) \
1115 && (VECTORP (obj) || COMPILEDP (obj) \
1116 || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \
1117 || HASH_TABLE_P (obj) || FONTP (obj))) \
1118 || (! NILP (Vprint_gensym) \
1119 && SYMBOLP (obj) \
1120 && !SYMBOL_INTERNED_P (obj)))
1122 /* Construct Vprint_number_table according to the structure of OBJ.
1123 OBJ itself and all its elements will be added to Vprint_number_table
1124 recursively if it is a list, vector, compiled function, char-table,
1125 string (its text properties will be traced), or a symbol that has
1126 no obarray (this is for the print-gensym feature).
1127 The status fields of Vprint_number_table mean whether each object appears
1128 more than once in OBJ: Qnil at the first time, and Qt after that . */
1129 static void
1130 print_preprocess (Lisp_Object obj)
1132 int i;
1133 ptrdiff_t size;
1134 int loop_count = 0;
1135 Lisp_Object halftail;
1137 /* Avoid infinite recursion for circular nested structure
1138 in the case where Vprint_circle is nil. */
1139 if (NILP (Vprint_circle))
1141 /* Give up if we go so deep that print_object will get an error. */
1142 /* See similar code in print_object. */
1143 if (print_depth >= PRINT_CIRCLE)
1144 error ("Apparently circular structure being printed");
1146 for (i = 0; i < print_depth; i++)
1147 if (EQ (obj, being_printed[i]))
1148 return;
1149 being_printed[print_depth] = obj;
1152 print_depth++;
1153 halftail = obj;
1155 loop:
1156 if (PRINT_CIRCLE_CANDIDATE_P (obj))
1158 if (!HASH_TABLE_P (Vprint_number_table))
1160 Lisp_Object args[2];
1161 args[0] = QCtest;
1162 args[1] = Qeq;
1163 Vprint_number_table = Fmake_hash_table (2, args);
1166 /* In case print-circle is nil and print-gensym is t,
1167 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1168 if (! NILP (Vprint_circle) || SYMBOLP (obj))
1170 Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
1171 if (!NILP (num)
1172 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1173 always print the gensym with a number. This is a special for
1174 the lisp function byte-compile-output-docform. */
1175 || (!NILP (Vprint_continuous_numbering)
1176 && SYMBOLP (obj)
1177 && !SYMBOL_INTERNED_P (obj)))
1178 { /* OBJ appears more than once. Let's remember that. */
1179 if (!INTEGERP (num))
1181 print_number_index++;
1182 /* Negative number indicates it hasn't been printed yet. */
1183 Fputhash (obj, make_number (- print_number_index),
1184 Vprint_number_table);
1186 print_depth--;
1187 return;
1189 else
1190 /* OBJ is not yet recorded. Let's add to the table. */
1191 Fputhash (obj, Qt, Vprint_number_table);
1194 switch (XTYPE (obj))
1196 case Lisp_String:
1197 /* A string may have text properties, which can be circular. */
1198 traverse_intervals_noorder (string_intervals (obj),
1199 print_preprocess_string, Qnil);
1200 break;
1202 case Lisp_Cons:
1203 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1204 just as in print_object. */
1205 if (loop_count && EQ (obj, halftail))
1206 break;
1207 print_preprocess (XCAR (obj));
1208 obj = XCDR (obj);
1209 loop_count++;
1210 if (!(loop_count & 1))
1211 halftail = XCDR (halftail);
1212 goto loop;
1214 case Lisp_Vectorlike:
1215 size = ASIZE (obj);
1216 if (size & PSEUDOVECTOR_FLAG)
1217 size &= PSEUDOVECTOR_SIZE_MASK;
1218 for (i = 0; i < size; i++)
1219 print_preprocess (AREF (obj, i));
1220 if (HASH_TABLE_P (obj))
1221 { /* For hash tables, the key_and_value slot is past
1222 `size' because it needs to be marked specially in case
1223 the table is weak. */
1224 struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
1225 print_preprocess (h->key_and_value);
1227 break;
1229 default:
1230 break;
1233 print_depth--;
1236 static void
1237 print_preprocess_string (INTERVAL interval, Lisp_Object arg)
1239 print_preprocess (interval->plist);
1242 static void print_check_string_charset_prop (INTERVAL interval, Lisp_Object string);
1244 #define PRINT_STRING_NON_CHARSET_FOUND 1
1245 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
1247 /* Bitwise or of the above macros. */
1248 static int print_check_string_result;
1250 static void
1251 print_check_string_charset_prop (INTERVAL interval, Lisp_Object string)
1253 Lisp_Object val;
1255 if (NILP (interval->plist)
1256 || (print_check_string_result == (PRINT_STRING_NON_CHARSET_FOUND
1257 | PRINT_STRING_UNSAFE_CHARSET_FOUND)))
1258 return;
1259 for (val = interval->plist; CONSP (val) && ! EQ (XCAR (val), Qcharset);
1260 val = XCDR (XCDR (val)));
1261 if (! CONSP (val))
1263 print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND;
1264 return;
1266 if (! (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND))
1268 if (! EQ (val, interval->plist)
1269 || CONSP (XCDR (XCDR (val))))
1270 print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND;
1272 if (NILP (Vprint_charset_text_property)
1273 || ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
1275 int i, c;
1276 ptrdiff_t charpos = interval->position;
1277 ptrdiff_t bytepos = string_char_to_byte (string, charpos);
1278 Lisp_Object charset;
1280 charset = XCAR (XCDR (val));
1281 for (i = 0; i < LENGTH (interval); i++)
1283 FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
1284 if (! ASCII_CHAR_P (c)
1285 && ! EQ (CHARSET_NAME (CHAR_CHARSET (c)), charset))
1287 print_check_string_result |= PRINT_STRING_UNSAFE_CHARSET_FOUND;
1288 break;
1294 /* The value is (charset . nil). */
1295 static Lisp_Object print_prune_charset_plist;
1297 static Lisp_Object
1298 print_prune_string_charset (Lisp_Object string)
1300 print_check_string_result = 0;
1301 traverse_intervals (string_intervals (string), 0,
1302 print_check_string_charset_prop, string);
1303 if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
1305 string = Fcopy_sequence (string);
1306 if (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND)
1308 if (NILP (print_prune_charset_plist))
1309 print_prune_charset_plist = Fcons (Qcharset, Qnil);
1310 Fremove_text_properties (make_number (0),
1311 make_number (SCHARS (string)),
1312 print_prune_charset_plist, string);
1314 else
1315 Fset_text_properties (make_number (0), make_number (SCHARS (string)),
1316 Qnil, string);
1318 return string;
1321 static void
1322 print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
1324 char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT),
1325 max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t),
1326 40))];
1328 QUIT;
1330 /* Detect circularities and truncate them. */
1331 if (NILP (Vprint_circle))
1333 /* Simple but incomplete way. */
1334 int i;
1336 /* See similar code in print_preprocess. */
1337 if (print_depth >= PRINT_CIRCLE)
1338 error ("Apparently circular structure being printed");
1340 for (i = 0; i < print_depth; i++)
1341 if (EQ (obj, being_printed[i]))
1343 int len = sprintf (buf, "#%d", i);
1344 strout (buf, len, len, printcharfun);
1345 return;
1347 being_printed[print_depth] = obj;
1349 else if (PRINT_CIRCLE_CANDIDATE_P (obj))
1351 /* With the print-circle feature. */
1352 Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
1353 if (INTEGERP (num))
1355 EMACS_INT n = XINT (num);
1356 if (n < 0)
1357 { /* Add a prefix #n= if OBJ has not yet been printed;
1358 that is, its status field is nil. */
1359 int len = sprintf (buf, "#%"pI"d=", -n);
1360 strout (buf, len, len, printcharfun);
1361 /* OBJ is going to be printed. Remember that fact. */
1362 Fputhash (obj, make_number (- n), Vprint_number_table);
1364 else
1366 /* Just print #n# if OBJ has already been printed. */
1367 int len = sprintf (buf, "#%"pI"d#", n);
1368 strout (buf, len, len, printcharfun);
1369 return;
1374 print_depth++;
1376 switch (XTYPE (obj))
1378 case_Lisp_Int:
1380 int len = sprintf (buf, "%"pI"d", XINT (obj));
1381 strout (buf, len, len, printcharfun);
1383 break;
1385 case Lisp_Float:
1387 char pigbuf[FLOAT_TO_STRING_BUFSIZE];
1388 int len = float_to_string (pigbuf, XFLOAT_DATA (obj));
1389 strout (pigbuf, len, len, printcharfun);
1391 break;
1393 case Lisp_String:
1394 if (!escapeflag)
1395 print_string (obj, printcharfun);
1396 else
1398 register ptrdiff_t i_byte;
1399 struct gcpro gcpro1;
1400 unsigned char *str;
1401 ptrdiff_t size_byte;
1402 /* 1 means we must ensure that the next character we output
1403 cannot be taken as part of a hex character escape. */
1404 int need_nonhex = 0;
1405 int multibyte = STRING_MULTIBYTE (obj);
1407 GCPRO1 (obj);
1409 if (! EQ (Vprint_charset_text_property, Qt))
1410 obj = print_prune_string_charset (obj);
1412 if (string_intervals (obj))
1414 PRINTCHAR ('#');
1415 PRINTCHAR ('(');
1418 PRINTCHAR ('\"');
1419 str = SDATA (obj);
1420 size_byte = SBYTES (obj);
1422 for (i_byte = 0; i_byte < size_byte;)
1424 /* Here, we must convert each multi-byte form to the
1425 corresponding character code before handing it to PRINTCHAR. */
1426 int len;
1427 int c;
1429 if (multibyte)
1431 c = STRING_CHAR_AND_LENGTH (str + i_byte, len);
1432 i_byte += len;
1434 else
1435 c = str[i_byte++];
1437 QUIT;
1439 if (c == '\n' && print_escape_newlines)
1441 PRINTCHAR ('\\');
1442 PRINTCHAR ('n');
1444 else if (c == '\f' && print_escape_newlines)
1446 PRINTCHAR ('\\');
1447 PRINTCHAR ('f');
1449 else if (multibyte
1450 && (CHAR_BYTE8_P (c)
1451 || (! ASCII_CHAR_P (c) && print_escape_multibyte)))
1453 /* When multibyte is disabled,
1454 print multibyte string chars using hex escapes.
1455 For a char code that could be in a unibyte string,
1456 when found in a multibyte string, always use a hex escape
1457 so it reads back as multibyte. */
1458 char outbuf[50];
1459 int len;
1461 if (CHAR_BYTE8_P (c))
1462 len = sprintf (outbuf, "\\%03o", CHAR_TO_BYTE8 (c));
1463 else
1465 len = sprintf (outbuf, "\\x%04x", c);
1466 need_nonhex = 1;
1468 strout (outbuf, len, len, printcharfun);
1470 else if (! multibyte
1471 && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
1472 && print_escape_nonascii)
1474 /* When printing in a multibyte buffer
1475 or when explicitly requested,
1476 print single-byte non-ASCII string chars
1477 using octal escapes. */
1478 char outbuf[5];
1479 int len = sprintf (outbuf, "\\%03o", c);
1480 strout (outbuf, len, len, printcharfun);
1482 else
1484 /* If we just had a hex escape, and this character
1485 could be taken as part of it,
1486 output `\ ' to prevent that. */
1487 if (need_nonhex)
1489 need_nonhex = 0;
1490 if ((c >= 'a' && c <= 'f')
1491 || (c >= 'A' && c <= 'F')
1492 || (c >= '0' && c <= '9'))
1493 strout ("\\ ", -1, -1, printcharfun);
1496 if (c == '\"' || c == '\\')
1497 PRINTCHAR ('\\');
1498 PRINTCHAR (c);
1501 PRINTCHAR ('\"');
1503 if (string_intervals (obj))
1505 traverse_intervals (string_intervals (obj),
1506 0, print_interval, printcharfun);
1507 PRINTCHAR (')');
1510 UNGCPRO;
1512 break;
1514 case Lisp_Symbol:
1516 register int confusing;
1517 register unsigned char *p = SDATA (SYMBOL_NAME (obj));
1518 register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
1519 register int c;
1520 ptrdiff_t i, i_byte;
1521 ptrdiff_t size_byte;
1522 Lisp_Object name;
1524 name = SYMBOL_NAME (obj);
1526 if (p != end && (*p == '-' || *p == '+')) p++;
1527 if (p == end)
1528 confusing = 0;
1529 /* If symbol name begins with a digit, and ends with a digit,
1530 and contains nothing but digits and `e', it could be treated
1531 as a number. So set CONFUSING.
1533 Symbols that contain periods could also be taken as numbers,
1534 but periods are always escaped, so we don't have to worry
1535 about them here. */
1536 else if (*p >= '0' && *p <= '9'
1537 && end[-1] >= '0' && end[-1] <= '9')
1539 while (p != end && ((*p >= '0' && *p <= '9')
1540 /* Needed for \2e10. */
1541 || *p == 'e' || *p == 'E'))
1542 p++;
1543 confusing = (end == p);
1545 else
1546 confusing = 0;
1548 size_byte = SBYTES (name);
1550 if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj))
1552 PRINTCHAR ('#');
1553 PRINTCHAR (':');
1555 else if (size_byte == 0)
1557 PRINTCHAR ('#');
1558 PRINTCHAR ('#');
1559 break;
1562 for (i = 0, i_byte = 0; i_byte < size_byte;)
1564 /* Here, we must convert each multi-byte form to the
1565 corresponding character code before handing it to PRINTCHAR. */
1566 FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
1567 QUIT;
1569 if (escapeflag)
1571 if (c == '\"' || c == '\\' || c == '\''
1572 || c == ';' || c == '#' || c == '(' || c == ')'
1573 || c == ',' || c == '.' || c == '`'
1574 || c == '[' || c == ']' || c == '?' || c <= 040
1575 || confusing)
1576 PRINTCHAR ('\\'), confusing = 0;
1578 PRINTCHAR (c);
1581 break;
1583 case Lisp_Cons:
1584 /* If deeper than spec'd depth, print placeholder. */
1585 if (INTEGERP (Vprint_level)
1586 && print_depth > XINT (Vprint_level))
1587 strout ("...", -1, -1, printcharfun);
1588 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1589 && (EQ (XCAR (obj), Qquote)))
1591 PRINTCHAR ('\'');
1592 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1594 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1595 && (EQ (XCAR (obj), Qfunction)))
1597 PRINTCHAR ('#');
1598 PRINTCHAR ('\'');
1599 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1601 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1602 && ((EQ (XCAR (obj), Qbackquote))))
1604 print_object (XCAR (obj), printcharfun, 0);
1605 new_backquote_output++;
1606 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1607 new_backquote_output--;
1609 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1610 && new_backquote_output
1611 && ((EQ (XCAR (obj), Qbackquote)
1612 || EQ (XCAR (obj), Qcomma)
1613 || EQ (XCAR (obj), Qcomma_at)
1614 || EQ (XCAR (obj), Qcomma_dot))))
1616 print_object (XCAR (obj), printcharfun, 0);
1617 new_backquote_output--;
1618 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1619 new_backquote_output++;
1621 else
1623 PRINTCHAR ('(');
1626 printmax_t i, print_length;
1627 Lisp_Object halftail = obj;
1629 /* Negative values of print-length are invalid in CL.
1630 Treat them like nil, as CMUCL does. */
1631 if (NATNUMP (Vprint_length))
1632 print_length = XFASTINT (Vprint_length);
1633 else
1634 print_length = TYPE_MAXIMUM (printmax_t);
1636 i = 0;
1637 while (CONSP (obj))
1639 /* Detect circular list. */
1640 if (NILP (Vprint_circle))
1642 /* Simple but incomplete way. */
1643 if (i != 0 && EQ (obj, halftail))
1645 int len = sprintf (buf, " . #%"pMd, i / 2);
1646 strout (buf, len, len, printcharfun);
1647 goto end_of_list;
1650 else
1652 /* With the print-circle feature. */
1653 if (i != 0)
1655 Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
1656 if (INTEGERP (num))
1658 strout (" . ", 3, 3, printcharfun);
1659 print_object (obj, printcharfun, escapeflag);
1660 goto end_of_list;
1665 if (i)
1666 PRINTCHAR (' ');
1668 if (print_length <= i)
1670 strout ("...", 3, 3, printcharfun);
1671 goto end_of_list;
1674 i++;
1675 print_object (XCAR (obj), printcharfun, escapeflag);
1677 obj = XCDR (obj);
1678 if (!(i & 1))
1679 halftail = XCDR (halftail);
1683 /* OBJ non-nil here means it's the end of a dotted list. */
1684 if (!NILP (obj))
1686 strout (" . ", 3, 3, printcharfun);
1687 print_object (obj, printcharfun, escapeflag);
1690 end_of_list:
1691 PRINTCHAR (')');
1693 break;
1695 case Lisp_Vectorlike:
1696 if (PROCESSP (obj))
1698 if (escapeflag)
1700 strout ("#<process ", -1, -1, printcharfun);
1701 print_string (XPROCESS (obj)->name, printcharfun);
1702 PRINTCHAR ('>');
1704 else
1705 print_string (XPROCESS (obj)->name, printcharfun);
1707 else if (BOOL_VECTOR_P (obj))
1709 ptrdiff_t i;
1710 int len;
1711 unsigned char c;
1712 struct gcpro gcpro1;
1713 ptrdiff_t size_in_chars
1714 = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
1715 / BOOL_VECTOR_BITS_PER_CHAR);
1717 GCPRO1 (obj);
1719 PRINTCHAR ('#');
1720 PRINTCHAR ('&');
1721 len = sprintf (buf, "%"pI"d", XBOOL_VECTOR (obj)->size);
1722 strout (buf, len, len, printcharfun);
1723 PRINTCHAR ('\"');
1725 /* Don't print more characters than the specified maximum.
1726 Negative values of print-length are invalid. Treat them
1727 like a print-length of nil. */
1728 if (NATNUMP (Vprint_length)
1729 && XFASTINT (Vprint_length) < size_in_chars)
1730 size_in_chars = XFASTINT (Vprint_length);
1732 for (i = 0; i < size_in_chars; i++)
1734 QUIT;
1735 c = XBOOL_VECTOR (obj)->data[i];
1736 if (c == '\n' && print_escape_newlines)
1738 PRINTCHAR ('\\');
1739 PRINTCHAR ('n');
1741 else if (c == '\f' && print_escape_newlines)
1743 PRINTCHAR ('\\');
1744 PRINTCHAR ('f');
1746 else if (c > '\177')
1748 /* Use octal escapes to avoid encoding issues. */
1749 PRINTCHAR ('\\');
1750 PRINTCHAR ('0' + ((c >> 6) & 3));
1751 PRINTCHAR ('0' + ((c >> 3) & 7));
1752 PRINTCHAR ('0' + (c & 7));
1754 else
1756 if (c == '\"' || c == '\\')
1757 PRINTCHAR ('\\');
1758 PRINTCHAR (c);
1761 PRINTCHAR ('\"');
1763 UNGCPRO;
1765 else if (SUBRP (obj))
1767 strout ("#<subr ", -1, -1, printcharfun);
1768 strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun);
1769 PRINTCHAR ('>');
1771 else if (WINDOWP (obj))
1773 int len;
1774 strout ("#<window ", -1, -1, printcharfun);
1775 len = sprintf (buf, "%d", XWINDOW (obj)->sequence_number);
1776 strout (buf, len, len, printcharfun);
1777 if (!NILP (XWINDOW (obj)->buffer))
1779 strout (" on ", -1, -1, printcharfun);
1780 print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name),
1781 printcharfun);
1783 PRINTCHAR ('>');
1785 else if (TERMINALP (obj))
1787 int len;
1788 struct terminal *t = XTERMINAL (obj);
1789 strout ("#<terminal ", -1, -1, printcharfun);
1790 len = sprintf (buf, "%d", t->id);
1791 strout (buf, len, len, printcharfun);
1792 if (t->name)
1794 strout (" on ", -1, -1, printcharfun);
1795 strout (t->name, -1, -1, printcharfun);
1797 PRINTCHAR ('>');
1799 else if (HASH_TABLE_P (obj))
1801 struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
1802 ptrdiff_t i;
1803 ptrdiff_t real_size, size;
1804 int len;
1805 #if 0
1806 strout ("#<hash-table", -1, -1, printcharfun);
1807 if (SYMBOLP (h->test))
1809 PRINTCHAR (' ');
1810 PRINTCHAR ('\'');
1811 strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun);
1812 PRINTCHAR (' ');
1813 strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun);
1814 PRINTCHAR (' ');
1815 len = sprintf (buf, "%"pD"d/%"pD"d", h->count, ASIZE (h->next));
1816 strout (buf, len, len, printcharfun);
1818 len = sprintf (buf, " %p", h);
1819 strout (buf, len, len, printcharfun);
1820 PRINTCHAR ('>');
1821 #endif
1822 /* Implement a readable output, e.g.:
1823 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
1824 /* Always print the size. */
1825 len = sprintf (buf, "#s(hash-table size %"pD"d", ASIZE (h->next));
1826 strout (buf, len, len, printcharfun);
1828 if (!NILP (h->test))
1830 strout (" test ", -1, -1, printcharfun);
1831 print_object (h->test, printcharfun, escapeflag);
1834 if (!NILP (h->weak))
1836 strout (" weakness ", -1, -1, printcharfun);
1837 print_object (h->weak, printcharfun, escapeflag);
1840 if (!NILP (h->rehash_size))
1842 strout (" rehash-size ", -1, -1, printcharfun);
1843 print_object (h->rehash_size, printcharfun, escapeflag);
1846 if (!NILP (h->rehash_threshold))
1848 strout (" rehash-threshold ", -1, -1, printcharfun);
1849 print_object (h->rehash_threshold, printcharfun, escapeflag);
1852 strout (" data ", -1, -1, printcharfun);
1854 /* Print the data here as a plist. */
1855 real_size = HASH_TABLE_SIZE (h);
1856 size = real_size;
1858 /* Don't print more elements than the specified maximum. */
1859 if (NATNUMP (Vprint_length)
1860 && XFASTINT (Vprint_length) < size)
1861 size = XFASTINT (Vprint_length);
1863 PRINTCHAR ('(');
1864 for (i = 0; i < size; i++)
1865 if (!NILP (HASH_HASH (h, i)))
1867 if (i) PRINTCHAR (' ');
1868 print_object (HASH_KEY (h, i), printcharfun, escapeflag);
1869 PRINTCHAR (' ');
1870 print_object (HASH_VALUE (h, i), printcharfun, escapeflag);
1873 if (size < real_size)
1874 strout (" ...", 4, 4, printcharfun);
1876 PRINTCHAR (')');
1877 PRINTCHAR (')');
1880 else if (BUFFERP (obj))
1882 if (NILP (BVAR (XBUFFER (obj), name)))
1883 strout ("#<killed buffer>", -1, -1, printcharfun);
1884 else if (escapeflag)
1886 strout ("#<buffer ", -1, -1, printcharfun);
1887 print_string (BVAR (XBUFFER (obj), name), printcharfun);
1888 PRINTCHAR ('>');
1890 else
1891 print_string (BVAR (XBUFFER (obj), name), printcharfun);
1893 else if (WINDOW_CONFIGURATIONP (obj))
1895 strout ("#<window-configuration>", -1, -1, printcharfun);
1897 else if (FRAMEP (obj))
1899 int len;
1900 Lisp_Object frame_name = XFRAME (obj)->name;
1902 strout ((FRAME_LIVE_P (XFRAME (obj))
1903 ? "#<frame " : "#<dead frame "),
1904 -1, -1, printcharfun);
1905 if (!STRINGP (frame_name))
1907 /* A frame could be too young and have no name yet;
1908 don't crash. */
1909 if (SYMBOLP (frame_name))
1910 frame_name = Fsymbol_name (frame_name);
1911 else /* can't happen: name should be either nil or string */
1912 frame_name = build_string ("*INVALID*FRAME*NAME*");
1914 print_string (frame_name, printcharfun);
1915 len = sprintf (buf, " %p", XFRAME (obj));
1916 strout (buf, len, len, printcharfun);
1917 PRINTCHAR ('>');
1919 else if (FONTP (obj))
1921 int i;
1923 if (! FONT_OBJECT_P (obj))
1925 if (FONT_SPEC_P (obj))
1926 strout ("#<font-spec", -1, -1, printcharfun);
1927 else
1928 strout ("#<font-entity", -1, -1, printcharfun);
1929 for (i = 0; i < FONT_SPEC_MAX; i++)
1931 PRINTCHAR (' ');
1932 if (i < FONT_WEIGHT_INDEX || i > FONT_WIDTH_INDEX)
1933 print_object (AREF (obj, i), printcharfun, escapeflag);
1934 else
1935 print_object (font_style_symbolic (obj, i, 0),
1936 printcharfun, escapeflag);
1939 else
1941 strout ("#<font-object ", -1, -1, printcharfun);
1942 print_object (AREF (obj, FONT_NAME_INDEX), printcharfun,
1943 escapeflag);
1945 PRINTCHAR ('>');
1947 else
1949 ptrdiff_t size = ASIZE (obj);
1950 if (COMPILEDP (obj))
1952 PRINTCHAR ('#');
1953 size &= PSEUDOVECTOR_SIZE_MASK;
1955 if (CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj))
1957 /* We print a char-table as if it were a vector,
1958 lumping the parent and default slots in with the
1959 character slots. But we add #^ as a prefix. */
1961 /* Make each lowest sub_char_table start a new line.
1962 Otherwise we'll make a line extremely long, which
1963 results in slow redisplay. */
1964 if (SUB_CHAR_TABLE_P (obj)
1965 && XINT (XSUB_CHAR_TABLE (obj)->depth) == 3)
1966 PRINTCHAR ('\n');
1967 PRINTCHAR ('#');
1968 PRINTCHAR ('^');
1969 if (SUB_CHAR_TABLE_P (obj))
1970 PRINTCHAR ('^');
1971 size &= PSEUDOVECTOR_SIZE_MASK;
1973 if (size & PSEUDOVECTOR_FLAG)
1974 goto badtype;
1976 PRINTCHAR ('[');
1978 register int i;
1979 register Lisp_Object tem;
1980 ptrdiff_t real_size = size;
1982 /* Don't print more elements than the specified maximum. */
1983 if (NATNUMP (Vprint_length)
1984 && XFASTINT (Vprint_length) < size)
1985 size = XFASTINT (Vprint_length);
1987 for (i = 0; i < size; i++)
1989 if (i) PRINTCHAR (' ');
1990 tem = AREF (obj, i);
1991 print_object (tem, printcharfun, escapeflag);
1993 if (size < real_size)
1994 strout (" ...", 4, 4, printcharfun);
1996 PRINTCHAR (']');
1998 break;
2000 case Lisp_Misc:
2001 switch (XMISCTYPE (obj))
2003 case Lisp_Misc_Marker:
2004 strout ("#<marker ", -1, -1, printcharfun);
2005 /* Do you think this is necessary? */
2006 if (XMARKER (obj)->insertion_type != 0)
2007 strout ("(moves after insertion) ", -1, -1, printcharfun);
2008 if (! XMARKER (obj)->buffer)
2009 strout ("in no buffer", -1, -1, printcharfun);
2010 else
2012 int len = sprintf (buf, "at %"pD"d", marker_position (obj));
2013 strout (buf, len, len, printcharfun);
2014 strout (" in ", -1, -1, printcharfun);
2015 print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun);
2017 PRINTCHAR ('>');
2018 break;
2020 case Lisp_Misc_Overlay:
2021 strout ("#<overlay ", -1, -1, printcharfun);
2022 if (! XMARKER (OVERLAY_START (obj))->buffer)
2023 strout ("in no buffer", -1, -1, printcharfun);
2024 else
2026 int len = sprintf (buf, "from %"pD"d to %"pD"d in ",
2027 marker_position (OVERLAY_START (obj)),
2028 marker_position (OVERLAY_END (obj)));
2029 strout (buf, len, len, printcharfun);
2030 print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name),
2031 printcharfun);
2033 PRINTCHAR ('>');
2034 break;
2036 /* Remaining cases shouldn't happen in normal usage, but let's print
2037 them anyway for the benefit of the debugger. */
2038 case Lisp_Misc_Free:
2039 strout ("#<misc free cell>", -1, -1, printcharfun);
2040 break;
2042 case Lisp_Misc_Save_Value:
2043 strout ("#<save_value ", -1, -1, printcharfun);
2045 int len = sprintf (buf, "ptr=%p int=%"pD"d",
2046 XSAVE_VALUE (obj)->pointer,
2047 XSAVE_VALUE (obj)->integer);
2048 strout (buf, len, len, printcharfun);
2050 PRINTCHAR ('>');
2051 break;
2053 default:
2054 goto badtype;
2056 break;
2058 default:
2059 badtype:
2061 int len;
2062 /* We're in trouble if this happens!
2063 Probably should just abort () */
2064 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun);
2065 if (MISCP (obj))
2066 len = sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
2067 else if (VECTORLIKEP (obj))
2068 len = sprintf (buf, "(PVEC 0x%08"pD"x)", ASIZE (obj));
2069 else
2070 len = sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
2071 strout (buf, len, len, printcharfun);
2072 strout (" Save your buffers immediately and please report this bug>",
2073 -1, -1, printcharfun);
2077 print_depth--;
2081 /* Print a description of INTERVAL using PRINTCHARFUN.
2082 This is part of printing a string that has text properties. */
2084 void
2085 print_interval (INTERVAL interval, Lisp_Object printcharfun)
2087 if (NILP (interval->plist))
2088 return;
2089 PRINTCHAR (' ');
2090 print_object (make_number (interval->position), printcharfun, 1);
2091 PRINTCHAR (' ');
2092 print_object (make_number (interval->position + LENGTH (interval)),
2093 printcharfun, 1);
2094 PRINTCHAR (' ');
2095 print_object (interval->plist, printcharfun, 1);
2099 void
2100 syms_of_print (void)
2102 DEFSYM (Qtemp_buffer_setup_hook, "temp-buffer-setup-hook");
2104 DEFVAR_LISP ("standard-output", Vstandard_output,
2105 doc: /* Output stream `print' uses by default for outputting a character.
2106 This may be any function of one argument.
2107 It may also be a buffer (output is inserted before point)
2108 or a marker (output is inserted and the marker is advanced)
2109 or the symbol t (output appears in the echo area). */);
2110 Vstandard_output = Qt;
2111 DEFSYM (Qstandard_output, "standard-output");
2113 DEFVAR_LISP ("float-output-format", Vfloat_output_format,
2114 doc: /* The format descriptor string used to print floats.
2115 This is a %-spec like those accepted by `printf' in C,
2116 but with some restrictions. It must start with the two characters `%.'.
2117 After that comes an integer precision specification,
2118 and then a letter which controls the format.
2119 The letters allowed are `e', `f' and `g'.
2120 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2121 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2122 Use `g' to choose the shorter of those two formats for the number at hand.
2123 The precision in any of these cases is the number of digits following
2124 the decimal point. With `f', a precision of 0 means to omit the
2125 decimal point. 0 is not allowed with `e' or `g'.
2127 A value of nil means to use the shortest notation
2128 that represents the number without losing information. */);
2129 Vfloat_output_format = Qnil;
2130 DEFSYM (Qfloat_output_format, "float-output-format");
2132 DEFVAR_LISP ("print-length", Vprint_length,
2133 doc: /* Maximum length of list to print before abbreviating.
2134 A value of nil means no limit. See also `eval-expression-print-length'. */);
2135 Vprint_length = Qnil;
2137 DEFVAR_LISP ("print-level", Vprint_level,
2138 doc: /* Maximum depth of list nesting to print before abbreviating.
2139 A value of nil means no limit. See also `eval-expression-print-level'. */);
2140 Vprint_level = Qnil;
2142 DEFVAR_BOOL ("print-escape-newlines", print_escape_newlines,
2143 doc: /* Non-nil means print newlines in strings as `\\n'.
2144 Also print formfeeds as `\\f'. */);
2145 print_escape_newlines = 0;
2147 DEFVAR_BOOL ("print-escape-nonascii", print_escape_nonascii,
2148 doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2149 \(OOO is the octal representation of the character code.)
2150 Only single-byte characters are affected, and only in `prin1'.
2151 When the output goes in a multibyte buffer, this feature is
2152 enabled regardless of the value of the variable. */);
2153 print_escape_nonascii = 0;
2155 DEFVAR_BOOL ("print-escape-multibyte", print_escape_multibyte,
2156 doc: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2157 \(XXXX is the hex representation of the character code.)
2158 This affects only `prin1'. */);
2159 print_escape_multibyte = 0;
2161 DEFVAR_BOOL ("print-quoted", print_quoted,
2162 doc: /* Non-nil means print quoted forms with reader syntax.
2163 I.e., (quote foo) prints as 'foo, (function foo) as #'foo. */);
2164 print_quoted = 0;
2166 DEFVAR_LISP ("print-gensym", Vprint_gensym,
2167 doc: /* Non-nil means print uninterned symbols so they will read as uninterned.
2168 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2169 When the uninterned symbol appears within a recursive data structure,
2170 and the symbol appears more than once, in addition use the #N# and #N=
2171 constructs as needed, so that multiple references to the same symbol are
2172 shared once again when the text is read back. */);
2173 Vprint_gensym = Qnil;
2175 DEFVAR_LISP ("print-circle", Vprint_circle,
2176 doc: /* Non-nil means print recursive structures using #N= and #N# syntax.
2177 If nil, printing proceeds recursively and may lead to
2178 `max-lisp-eval-depth' being exceeded or an error may occur:
2179 \"Apparently circular structure being printed.\" Also see
2180 `print-length' and `print-level'.
2181 If non-nil, shared substructures anywhere in the structure are printed
2182 with `#N=' before the first occurrence (in the order of the print
2183 representation) and `#N#' in place of each subsequent occurrence,
2184 where N is a positive decimal integer. */);
2185 Vprint_circle = Qnil;
2187 DEFVAR_LISP ("print-continuous-numbering", Vprint_continuous_numbering,
2188 doc: /* Non-nil means number continuously across print calls.
2189 This affects the numbers printed for #N= labels and #M# references.
2190 See also `print-circle', `print-gensym', and `print-number-table'.
2191 This variable should not be set with `setq'; bind it with a `let' instead. */);
2192 Vprint_continuous_numbering = Qnil;
2194 DEFVAR_LISP ("print-number-table", Vprint_number_table,
2195 doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
2196 The Lisp printer uses this vector to detect Lisp objects referenced more
2197 than once.
2199 When you bind `print-continuous-numbering' to t, you should probably
2200 also bind `print-number-table' to nil. This ensures that the value of
2201 `print-number-table' can be garbage-collected once the printing is
2202 done. If all elements of `print-number-table' are nil, it means that
2203 the printing done so far has not found any shared structure or objects
2204 that need to be recorded in the table. */);
2205 Vprint_number_table = Qnil;
2207 DEFVAR_LISP ("print-charset-text-property", Vprint_charset_text_property,
2208 doc: /* A flag to control printing of `charset' text property on printing a string.
2209 The value must be nil, t, or `default'.
2211 If the value is nil, don't print the text property `charset'.
2213 If the value is t, always print the text property `charset'.
2215 If the value is `default', print the text property `charset' only when
2216 the value is different from what is guessed in the current charset
2217 priorities. */);
2218 Vprint_charset_text_property = Qdefault;
2220 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2221 staticpro (&Vprin1_to_string_buffer);
2223 defsubr (&Sprin1);
2224 defsubr (&Sprin1_to_string);
2225 defsubr (&Serror_message_string);
2226 defsubr (&Sprinc);
2227 defsubr (&Sprint);
2228 defsubr (&Sterpri);
2229 defsubr (&Swrite_char);
2230 defsubr (&Sexternal_debugging_output);
2231 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2232 defsubr (&Sredirect_debugging_output);
2233 #endif
2235 DEFSYM (Qexternal_debugging_output, "external-debugging-output");
2236 DEFSYM (Qprint_escape_newlines, "print-escape-newlines");
2237 DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte");
2238 DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii");
2240 print_prune_charset_plist = Qnil;
2241 staticpro (&print_prune_charset_plist);