(comint-quote-filename): Correctly handle backslash
[emacs.git] / src / print.c
blob441894471a717165e7d7390f6bbecc1ae31aa6bd
1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 01, 2003
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 #include <config.h>
24 #include <stdio.h>
25 #include "lisp.h"
26 #include "buffer.h"
27 #include "charset.h"
28 #include "keyboard.h"
29 #include "frame.h"
30 #include "window.h"
31 #include "process.h"
32 #include "dispextern.h"
33 #include "termchar.h"
34 #include "intervals.h"
36 Lisp_Object Vstandard_output, Qstandard_output;
38 Lisp_Object Qtemp_buffer_setup_hook;
40 /* These are used to print like we read. */
41 extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
43 Lisp_Object Vfloat_output_format, Qfloat_output_format;
45 /* Work around a problem that happens because math.h on hpux 7
46 defines two static variables--which, in Emacs, are not really static,
47 because `static' is defined as nothing. The problem is that they are
48 defined both here and in lread.c.
49 These macros prevent the name conflict. */
50 #if defined (HPUX) && !defined (HPUX8)
51 #define _MAXLDBL print_maxldbl
52 #define _NMAXLDBL print_nmaxldbl
53 #endif
55 #include <math.h>
57 #if STDC_HEADERS
58 #include <float.h>
59 #endif
61 /* Default to values appropriate for IEEE floating point. */
62 #ifndef FLT_RADIX
63 #define FLT_RADIX 2
64 #endif
65 #ifndef DBL_MANT_DIG
66 #define DBL_MANT_DIG 53
67 #endif
68 #ifndef DBL_DIG
69 #define DBL_DIG 15
70 #endif
71 #ifndef DBL_MIN
72 #define DBL_MIN 2.2250738585072014e-308
73 #endif
75 #ifdef DBL_MIN_REPLACEMENT
76 #undef DBL_MIN
77 #define DBL_MIN DBL_MIN_REPLACEMENT
78 #endif
80 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
81 needed to express a float without losing information.
82 The general-case formula is valid for the usual case, IEEE floating point,
83 but many compilers can't optimize the formula to an integer constant,
84 so make a special case for it. */
85 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
86 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
87 #else
88 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
89 #endif
91 /* Avoid actual stack overflow in print. */
92 int print_depth;
94 /* Nonzero if inside outputting backquote in old style. */
95 int old_backquote_output;
97 /* Detect most circularities to print finite output. */
98 #define PRINT_CIRCLE 200
99 Lisp_Object being_printed[PRINT_CIRCLE];
101 /* When printing into a buffer, first we put the text in this
102 block, then insert it all at once. */
103 char *print_buffer;
105 /* Size allocated in print_buffer. */
106 int print_buffer_size;
107 /* Chars stored in print_buffer. */
108 int print_buffer_pos;
109 /* Bytes stored in print_buffer. */
110 int print_buffer_pos_byte;
112 /* Maximum length of list to print in full; noninteger means
113 effectively infinity */
115 Lisp_Object Vprint_length;
117 /* Maximum depth of list to print in full; noninteger means
118 effectively infinity. */
120 Lisp_Object Vprint_level;
122 /* Nonzero means print newlines in strings as \n. */
124 int print_escape_newlines;
126 /* Nonzero means to print single-byte non-ascii characters in strings as
127 octal escapes. */
129 int print_escape_nonascii;
131 /* Nonzero means to print multibyte characters in strings as hex escapes. */
133 int print_escape_multibyte;
135 Lisp_Object Qprint_escape_newlines;
136 Lisp_Object Qprint_escape_multibyte, Qprint_escape_nonascii;
138 /* Nonzero means print (quote foo) forms as 'foo, etc. */
140 int print_quoted;
142 /* Non-nil means print #: before uninterned symbols. */
144 Lisp_Object Vprint_gensym;
146 /* Non-nil means print recursive structures using #n= and #n# syntax. */
148 Lisp_Object Vprint_circle;
150 /* Non-nil means keep continuous number for #n= and #n# syntax
151 between several print functions. */
153 Lisp_Object Vprint_continuous_numbering;
155 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
156 where OBJn are objects going to be printed, and STATn are their status,
157 which may be different meanings during process. See the comments of
158 the functions print and print_preprocess for details.
159 print_number_index keeps the last position the next object should be added,
160 twice of which is the actual vector position in Vprint_number_table. */
161 int print_number_index;
162 Lisp_Object Vprint_number_table;
164 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
165 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
166 See the comment of the variable Vprint_number_table. */
167 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
168 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
170 /* Nonzero means print newline to stdout before next minibuffer message.
171 Defined in xdisp.c */
173 extern int noninteractive_need_newline;
175 extern int minibuffer_auto_raise;
177 #ifdef MAX_PRINT_CHARS
178 static int print_chars;
179 static int max_print;
180 #endif /* MAX_PRINT_CHARS */
182 void print_interval ();
185 /* Low level output routines for characters and strings */
187 /* Lisp functions to do output using a stream
188 must have the stream in a variable called printcharfun
189 and must start with PRINTPREPARE, end with PRINTFINISH,
190 and use PRINTDECLARE to declare common variables.
191 Use PRINTCHAR to output one character,
192 or call strout to output a block of characters. */
194 #define PRINTDECLARE \
195 struct buffer *old = current_buffer; \
196 int old_point = -1, start_point = -1; \
197 int old_point_byte = -1, start_point_byte = -1; \
198 int specpdl_count = SPECPDL_INDEX (); \
199 int free_print_buffer = 0; \
200 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
201 Lisp_Object original
203 #define PRINTPREPARE \
204 original = printcharfun; \
205 if (NILP (printcharfun)) printcharfun = Qt; \
206 if (BUFFERP (printcharfun)) \
208 if (XBUFFER (printcharfun) != current_buffer) \
209 Fset_buffer (printcharfun); \
210 printcharfun = Qnil; \
212 if (MARKERP (printcharfun)) \
214 if (!(XMARKER (original)->buffer)) \
215 error ("Marker does not point anywhere"); \
216 if (XMARKER (original)->buffer != current_buffer) \
217 set_buffer_internal (XMARKER (original)->buffer); \
218 old_point = PT; \
219 old_point_byte = PT_BYTE; \
220 SET_PT_BOTH (marker_position (printcharfun), \
221 marker_byte_position (printcharfun)); \
222 start_point = PT; \
223 start_point_byte = PT_BYTE; \
224 printcharfun = Qnil; \
226 if (NILP (printcharfun)) \
228 Lisp_Object string; \
229 if (NILP (current_buffer->enable_multibyte_characters) \
230 && ! print_escape_multibyte) \
231 specbind (Qprint_escape_multibyte, Qt); \
232 if (! NILP (current_buffer->enable_multibyte_characters) \
233 && ! print_escape_nonascii) \
234 specbind (Qprint_escape_nonascii, Qt); \
235 if (print_buffer != 0) \
237 string = make_string_from_bytes (print_buffer, \
238 print_buffer_pos, \
239 print_buffer_pos_byte); \
240 record_unwind_protect (print_unwind, string); \
242 else \
244 print_buffer_size = 1000; \
245 print_buffer = (char *) xmalloc (print_buffer_size); \
246 free_print_buffer = 1; \
248 print_buffer_pos = 0; \
249 print_buffer_pos_byte = 0; \
251 if (EQ (printcharfun, Qt) && ! noninteractive) \
252 setup_echo_area_for_printing (multibyte);
254 #define PRINTFINISH \
255 if (NILP (printcharfun)) \
257 if (print_buffer_pos != print_buffer_pos_byte \
258 && NILP (current_buffer->enable_multibyte_characters)) \
260 unsigned char *temp \
261 = (unsigned char *) alloca (print_buffer_pos + 1); \
262 copy_text (print_buffer, temp, print_buffer_pos_byte, \
263 1, 0); \
264 insert_1_both (temp, print_buffer_pos, \
265 print_buffer_pos, 0, 1, 0); \
267 else \
268 insert_1_both (print_buffer, print_buffer_pos, \
269 print_buffer_pos_byte, 0, 1, 0); \
271 if (free_print_buffer) \
273 xfree (print_buffer); \
274 print_buffer = 0; \
276 unbind_to (specpdl_count, Qnil); \
277 if (MARKERP (original)) \
278 set_marker_both (original, Qnil, PT, PT_BYTE); \
279 if (old_point >= 0) \
280 SET_PT_BOTH (old_point + (old_point >= start_point \
281 ? PT - start_point : 0), \
282 old_point_byte + (old_point_byte >= start_point_byte \
283 ? PT_BYTE - start_point_byte : 0)); \
284 if (old != current_buffer) \
285 set_buffer_internal (old);
287 #define PRINTCHAR(ch) printchar (ch, printcharfun)
289 /* This is used to restore the saved contents of print_buffer
290 when there is a recursive call to print. */
292 static Lisp_Object
293 print_unwind (saved_text)
294 Lisp_Object saved_text;
296 bcopy (SDATA (saved_text), print_buffer, SCHARS (saved_text));
297 return Qnil;
301 /* Print character CH using method FUN. FUN nil means print to
302 print_buffer. FUN t means print to echo area or stdout if
303 non-interactive. If FUN is neither nil nor t, call FUN with CH as
304 argument. */
306 static void
307 printchar (ch, fun)
308 unsigned int ch;
309 Lisp_Object fun;
311 #ifdef MAX_PRINT_CHARS
312 if (max_print)
313 print_chars++;
314 #endif /* MAX_PRINT_CHARS */
316 if (!NILP (fun) && !EQ (fun, Qt))
317 call1 (fun, make_number (ch));
318 else
320 unsigned char str[MAX_MULTIBYTE_LENGTH];
321 int len = CHAR_STRING (ch, str);
323 QUIT;
325 if (NILP (fun))
327 if (print_buffer_pos_byte + len >= print_buffer_size)
328 print_buffer = (char *) xrealloc (print_buffer,
329 print_buffer_size *= 2);
330 bcopy (str, print_buffer + print_buffer_pos_byte, len);
331 print_buffer_pos += 1;
332 print_buffer_pos_byte += len;
334 else if (noninteractive)
336 fwrite (str, 1, len, stdout);
337 noninteractive_need_newline = 1;
339 else
341 int multibyte_p
342 = !NILP (current_buffer->enable_multibyte_characters);
344 setup_echo_area_for_printing (multibyte_p);
345 insert_char (ch);
346 message_dolog (str, len, 0, multibyte_p);
352 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
353 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
354 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
355 print_buffer. PRINTCHARFUN t means output to the echo area or to
356 stdout if non-interactive. If neither nil nor t, call Lisp
357 function PRINTCHARFUN for each character printed. MULTIBYTE
358 non-zero means PTR contains multibyte characters. */
360 static void
361 strout (ptr, size, size_byte, printcharfun, multibyte)
362 char *ptr;
363 int size, size_byte;
364 Lisp_Object printcharfun;
365 int multibyte;
367 if (size < 0)
368 size_byte = size = strlen (ptr);
370 if (NILP (printcharfun))
372 if (print_buffer_pos_byte + size_byte > print_buffer_size)
374 print_buffer_size = print_buffer_size * 2 + size_byte;
375 print_buffer = (char *) xrealloc (print_buffer,
376 print_buffer_size);
378 bcopy (ptr, print_buffer + print_buffer_pos_byte, size_byte);
379 print_buffer_pos += size;
380 print_buffer_pos_byte += size_byte;
382 #ifdef MAX_PRINT_CHARS
383 if (max_print)
384 print_chars += size;
385 #endif /* MAX_PRINT_CHARS */
387 else if (noninteractive && EQ (printcharfun, Qt))
389 fwrite (ptr, 1, size_byte, stdout);
390 noninteractive_need_newline = 1;
392 else if (EQ (printcharfun, Qt))
394 /* Output to echo area. We're trying to avoid a little overhead
395 here, that's the reason we don't call printchar to do the
396 job. */
397 int i;
398 int multibyte_p
399 = !NILP (current_buffer->enable_multibyte_characters);
401 setup_echo_area_for_printing (multibyte_p);
402 message_dolog (ptr, size_byte, 0, multibyte_p);
404 if (size == size_byte)
406 for (i = 0; i < size; ++i)
407 insert_char ((unsigned char )*ptr++);
409 else
411 int len;
412 for (i = 0; i < size_byte; i += len)
414 int ch = STRING_CHAR_AND_LENGTH (ptr + i, size_byte - i, len);
415 insert_char (ch);
419 #ifdef MAX_PRINT_CHARS
420 if (max_print)
421 print_chars += size;
422 #endif /* MAX_PRINT_CHARS */
424 else
426 /* PRINTCHARFUN is a Lisp function. */
427 int i = 0;
429 if (size == size_byte)
431 while (i < size_byte)
433 int ch = ptr[i++];
434 PRINTCHAR (ch);
437 else
439 while (i < size_byte)
441 /* Here, we must convert each multi-byte form to the
442 corresponding character code before handing it to
443 PRINTCHAR. */
444 int len;
445 int ch = STRING_CHAR_AND_LENGTH (ptr + i, size_byte - i, len);
446 PRINTCHAR (ch);
447 i += len;
453 /* Print the contents of a string STRING using PRINTCHARFUN.
454 It isn't safe to use strout in many cases,
455 because printing one char can relocate. */
457 static void
458 print_string (string, printcharfun)
459 Lisp_Object string;
460 Lisp_Object printcharfun;
462 if (EQ (printcharfun, Qt) || NILP (printcharfun))
464 int chars;
466 if (STRING_MULTIBYTE (string))
467 chars = SCHARS (string);
468 else if (EQ (printcharfun, Qt)
469 ? ! NILP (buffer_defaults.enable_multibyte_characters)
470 : ! NILP (current_buffer->enable_multibyte_characters))
472 /* If unibyte string STRING contains 8-bit codes, we must
473 convert STRING to a multibyte string containing the same
474 character codes. */
475 Lisp_Object newstr;
476 int bytes;
478 chars = SBYTES (string);
479 bytes = parse_str_to_multibyte (SDATA (string), chars);
480 if (chars < bytes)
482 newstr = make_uninit_multibyte_string (chars, bytes);
483 bcopy (SDATA (string), SDATA (newstr), chars);
484 str_to_multibyte (SDATA (newstr), bytes, chars);
485 string = newstr;
488 else
489 chars = SBYTES (string);
491 /* strout is safe for output to a frame (echo area) or to print_buffer. */
492 strout (SDATA (string),
493 chars, SBYTES (string),
494 printcharfun, STRING_MULTIBYTE (string));
496 else
498 /* Otherwise, string may be relocated by printing one char.
499 So re-fetch the string address for each character. */
500 int i;
501 int size = SCHARS (string);
502 int size_byte = SBYTES (string);
503 struct gcpro gcpro1;
504 GCPRO1 (string);
505 if (size == size_byte)
506 for (i = 0; i < size; i++)
507 PRINTCHAR (SREF (string, i));
508 else
509 for (i = 0; i < size_byte; )
511 /* Here, we must convert each multi-byte form to the
512 corresponding character code before handing it to PRINTCHAR. */
513 int len;
514 int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i,
515 size_byte - i, len);
516 if (!CHAR_VALID_P (ch, 0))
518 ch = SREF (string, i);
519 len = 1;
521 PRINTCHAR (ch);
522 i += len;
524 UNGCPRO;
528 DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
529 doc: /* Output character CHARACTER to stream PRINTCHARFUN.
530 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
531 (character, printcharfun)
532 Lisp_Object character, printcharfun;
534 PRINTDECLARE;
536 if (NILP (printcharfun))
537 printcharfun = Vstandard_output;
538 CHECK_NUMBER (character);
539 PRINTPREPARE;
540 PRINTCHAR (XINT (character));
541 PRINTFINISH;
542 return character;
545 /* Used from outside of print.c to print a block of SIZE
546 single-byte chars at DATA on the default output stream.
547 Do not use this on the contents of a Lisp string. */
549 void
550 write_string (data, size)
551 char *data;
552 int size;
554 PRINTDECLARE;
555 Lisp_Object printcharfun;
557 printcharfun = Vstandard_output;
559 PRINTPREPARE;
560 strout (data, size, size, printcharfun, 0);
561 PRINTFINISH;
564 /* Used from outside of print.c to print a block of SIZE
565 single-byte chars at DATA on a specified stream PRINTCHARFUN.
566 Do not use this on the contents of a Lisp string. */
568 void
569 write_string_1 (data, size, printcharfun)
570 char *data;
571 int size;
572 Lisp_Object printcharfun;
574 PRINTDECLARE;
576 PRINTPREPARE;
577 strout (data, size, size, printcharfun, 0);
578 PRINTFINISH;
582 void
583 temp_output_buffer_setup (bufname)
584 const char *bufname;
586 int count = SPECPDL_INDEX ();
587 register struct buffer *old = current_buffer;
588 register Lisp_Object buf;
590 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
592 Fset_buffer (Fget_buffer_create (build_string (bufname)));
594 Fkill_all_local_variables ();
595 delete_all_overlays (current_buffer);
596 current_buffer->directory = old->directory;
597 current_buffer->read_only = Qnil;
598 current_buffer->filename = Qnil;
599 current_buffer->undo_list = Qt;
600 eassert (current_buffer->overlays_before == NULL);
601 eassert (current_buffer->overlays_after == NULL);
602 current_buffer->enable_multibyte_characters
603 = buffer_defaults.enable_multibyte_characters;
604 Ferase_buffer ();
605 XSETBUFFER (buf, current_buffer);
607 Frun_hooks (1, &Qtemp_buffer_setup_hook);
609 unbind_to (count, Qnil);
611 specbind (Qstandard_output, buf);
614 Lisp_Object
615 internal_with_output_to_temp_buffer (bufname, function, args)
616 const char *bufname;
617 Lisp_Object (*function) P_ ((Lisp_Object));
618 Lisp_Object args;
620 int count = SPECPDL_INDEX ();
621 Lisp_Object buf, val;
622 struct gcpro gcpro1;
624 GCPRO1 (args);
625 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
626 temp_output_buffer_setup (bufname);
627 buf = Vstandard_output;
628 UNGCPRO;
630 val = (*function) (args);
632 GCPRO1 (val);
633 temp_output_buffer_show (buf);
634 UNGCPRO;
636 return unbind_to (count, val);
639 DEFUN ("with-output-to-temp-buffer",
640 Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
641 1, UNEVALLED, 0,
642 doc: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
643 The buffer is cleared out initially, and marked as unmodified when done.
644 All output done by BODY is inserted in that buffer by default.
645 The buffer is displayed in another window, but not selected.
646 The value of the last form in BODY is returned.
647 If BODY does not finish normally, the buffer BUFNAME is not displayed.
649 The hook `temp-buffer-setup-hook' is run before BODY,
650 with the buffer BUFNAME temporarily current.
651 The hook `temp-buffer-show-hook' is run after the buffer is displayed,
652 with the buffer temporarily current, and the window that was used
653 to display it temporarily selected.
655 If variable `temp-buffer-show-function' is non-nil, call it at the end
656 to get the buffer displayed instead of just displaying the non-selected
657 buffer and calling the hook. It gets one argument, the buffer to display.
659 usage: (with-output-to-temp-buffer BUFFNAME BODY ...) */)
660 (args)
661 Lisp_Object args;
663 struct gcpro gcpro1;
664 Lisp_Object name;
665 int count = SPECPDL_INDEX ();
666 Lisp_Object buf, val;
668 GCPRO1(args);
669 name = Feval (Fcar (args));
670 CHECK_STRING (name);
671 temp_output_buffer_setup (SDATA (name));
672 buf = Vstandard_output;
673 UNGCPRO;
675 val = Fprogn (XCDR (args));
677 GCPRO1 (val);
678 temp_output_buffer_show (buf);
679 UNGCPRO;
681 return unbind_to (count, val);
685 static void print ();
686 static void print_preprocess ();
687 static void print_preprocess_string ();
688 static void print_object ();
690 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
691 doc: /* Output a newline to stream PRINTCHARFUN.
692 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
693 (printcharfun)
694 Lisp_Object printcharfun;
696 PRINTDECLARE;
698 if (NILP (printcharfun))
699 printcharfun = Vstandard_output;
700 PRINTPREPARE;
701 PRINTCHAR ('\n');
702 PRINTFINISH;
703 return Qt;
706 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
707 doc: /* Output the printed representation of OBJECT, any Lisp object.
708 Quoting characters are printed when needed to make output that `read'
709 can handle, whenever this is possible. For complex objects, the behavior
710 is controlled by `print-level' and `print-length', which see.
712 OBJECT is any of the Lisp data types: a number, a string, a symbol,
713 a list, a buffer, a window, a frame, etc.
715 A printed representation of an object is text which describes that object.
717 Optional argument PRINTCHARFUN is the output stream, which can be one
718 of these:
720 - a buffer, in which case output is inserted into that buffer at point;
721 - a marker, in which case output is inserted at marker's position;
722 - a function, in which case that function is called once for each
723 character of OBJECT's printed representation;
724 - a symbol, in which case that symbol's function definition is called; or
725 - t, in which case the output is displayed in the echo area.
727 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
728 is used instead. */)
729 (object, printcharfun)
730 Lisp_Object object, printcharfun;
732 PRINTDECLARE;
734 #ifdef MAX_PRINT_CHARS
735 max_print = 0;
736 #endif /* MAX_PRINT_CHARS */
737 if (NILP (printcharfun))
738 printcharfun = Vstandard_output;
739 PRINTPREPARE;
740 print (object, printcharfun, 1);
741 PRINTFINISH;
742 return object;
745 /* a buffer which is used to hold output being built by prin1-to-string */
746 Lisp_Object Vprin1_to_string_buffer;
748 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
749 doc: /* Return a string containing the printed representation of OBJECT.
750 OBJECT can be any Lisp object. This function outputs quoting characters
751 when necessary to make output that `read' can handle, whenever possible,
752 unless the optional second argument NOESCAPE is non-nil.
754 OBJECT is any of the Lisp data types: a number, a string, a symbol,
755 a list, a buffer, a window, a frame, etc.
757 A printed representation of an object is text which describes that object. */)
758 (object, noescape)
759 Lisp_Object object, noescape;
761 Lisp_Object printcharfun;
762 /* struct gcpro gcpro1, gcpro2; */
763 Lisp_Object save_deactivate_mark;
764 int count = specpdl_ptr - specpdl;
765 struct buffer *previous;
767 specbind (Qinhibit_modification_hooks, Qt);
770 PRINTDECLARE;
772 /* Save and restore this--we are altering a buffer
773 but we don't want to deactivate the mark just for that.
774 No need for specbind, since errors deactivate the mark. */
775 save_deactivate_mark = Vdeactivate_mark;
776 /* GCPRO2 (object, save_deactivate_mark); */
777 abort_on_gc++;
779 printcharfun = Vprin1_to_string_buffer;
780 PRINTPREPARE;
781 print (object, printcharfun, NILP (noescape));
782 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
783 PRINTFINISH;
786 previous = current_buffer;
787 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
788 object = Fbuffer_string ();
789 if (SBYTES (object) == SCHARS (object))
790 STRING_SET_UNIBYTE (object);
792 /* Note that this won't make prepare_to_modify_buffer call
793 ask-user-about-supersession-threat because this buffer
794 does not visit a file. */
795 Ferase_buffer ();
796 set_buffer_internal (previous);
798 Vdeactivate_mark = save_deactivate_mark;
799 /* UNGCPRO; */
801 abort_on_gc--;
802 return unbind_to (count, object);
805 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
806 doc: /* Output the printed representation of OBJECT, any Lisp object.
807 No quoting characters are used; no delimiters are printed around
808 the contents of strings.
810 OBJECT is any of the Lisp data types: a number, a string, a symbol,
811 a list, a buffer, a window, a frame, etc.
813 A printed representation of an object is text which describes that object.
815 Optional argument PRINTCHARFUN is the output stream, which can be one
816 of these:
818 - a buffer, in which case output is inserted into that buffer at point;
819 - a marker, in which case output is inserted at marker's position;
820 - a function, in which case that function is called once for each
821 character of OBJECT's printed representation;
822 - a symbol, in which case that symbol's function definition is called; or
823 - t, in which case the output is displayed in the echo area.
825 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
826 is used instead. */)
827 (object, printcharfun)
828 Lisp_Object object, printcharfun;
830 PRINTDECLARE;
832 if (NILP (printcharfun))
833 printcharfun = Vstandard_output;
834 PRINTPREPARE;
835 print (object, printcharfun, 0);
836 PRINTFINISH;
837 return object;
840 DEFUN ("print", Fprint, Sprint, 1, 2, 0,
841 doc: /* Output the printed representation of OBJECT, with newlines around it.
842 Quoting characters are printed when needed to make output that `read'
843 can handle, whenever this is possible. For complex objects, the behavior
844 is controlled by `print-level' and `print-length', which see.
846 OBJECT is any of the Lisp data types: a number, a string, a symbol,
847 a list, a buffer, a window, a frame, etc.
849 A printed representation of an object is text which describes that object.
851 Optional argument PRINTCHARFUN is the output stream, which can be one
852 of these:
854 - a buffer, in which case output is inserted into that buffer at point;
855 - a marker, in which case output is inserted at marker's position;
856 - a function, in which case that function is called once for each
857 character of OBJECT's printed representation;
858 - a symbol, in which case that symbol's function definition is called; or
859 - t, in which case the output is displayed in the echo area.
861 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
862 is used instead. */)
863 (object, printcharfun)
864 Lisp_Object object, printcharfun;
866 PRINTDECLARE;
867 struct gcpro gcpro1;
869 #ifdef MAX_PRINT_CHARS
870 print_chars = 0;
871 max_print = MAX_PRINT_CHARS;
872 #endif /* MAX_PRINT_CHARS */
873 if (NILP (printcharfun))
874 printcharfun = Vstandard_output;
875 GCPRO1 (object);
876 PRINTPREPARE;
877 PRINTCHAR ('\n');
878 print (object, printcharfun, 1);
879 PRINTCHAR ('\n');
880 PRINTFINISH;
881 #ifdef MAX_PRINT_CHARS
882 max_print = 0;
883 print_chars = 0;
884 #endif /* MAX_PRINT_CHARS */
885 UNGCPRO;
886 return object;
889 /* The subroutine object for external-debugging-output is kept here
890 for the convenience of the debugger. */
891 Lisp_Object Qexternal_debugging_output;
893 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
894 doc: /* Write CHARACTER to stderr.
895 You can call print while debugging emacs, and pass it this function
896 to make it write to the debugging output. */)
897 (character)
898 Lisp_Object character;
900 CHECK_NUMBER (character);
901 putc (XINT (character), stderr);
903 #ifdef WINDOWSNT
904 /* Send the output to a debugger (nothing happens if there isn't one). */
906 char buf[2] = {(char) XINT (character), '\0'};
907 OutputDebugString (buf);
909 #endif
911 return character;
915 #if defined(GNU_LINUX)
917 /* This functionality is not vitally important in general, so we rely on
918 non-portable ability to use stderr as lvalue. */
920 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
922 FILE *initial_stderr_stream = NULL;
924 DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output,
925 1, 2,
926 "FDebug output file: \nP",
927 doc: /* Redirect debugging output (stderr stream) to file FILE.
928 If FILE is nil, reset target to the initial stderr stream.
929 Optional arg APPEND non-nil (interactively, with prefix arg) means
930 append to existing target file. */)
931 (file, append)
932 Lisp_Object file, append;
934 if (initial_stderr_stream != NULL)
935 fclose(stderr);
936 stderr = initial_stderr_stream;
937 initial_stderr_stream = NULL;
939 if (STRINGP (file))
941 file = Fexpand_file_name (file, Qnil);
942 initial_stderr_stream = stderr;
943 stderr = fopen(SDATA (file), NILP (append) ? "w" : "a");
944 if (stderr == NULL)
946 stderr = initial_stderr_stream;
947 initial_stderr_stream = NULL;
948 report_file_error ("Cannot open debugging output stream",
949 Fcons (file, Qnil));
952 return Qnil;
954 #endif /* GNU_LINUX */
957 /* This is the interface for debugging printing. */
959 void
960 debug_print (arg)
961 Lisp_Object arg;
963 Fprin1 (arg, Qexternal_debugging_output);
964 fprintf (stderr, "\r\n");
967 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
968 1, 1, 0,
969 doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message. */)
970 (obj)
971 Lisp_Object obj;
973 struct buffer *old = current_buffer;
974 Lisp_Object value;
975 struct gcpro gcpro1;
977 /* If OBJ is (error STRING), just return STRING.
978 That is not only faster, it also avoids the need to allocate
979 space here when the error is due to memory full. */
980 if (CONSP (obj) && EQ (XCAR (obj), Qerror)
981 && CONSP (XCDR (obj))
982 && STRINGP (XCAR (XCDR (obj)))
983 && NILP (XCDR (XCDR (obj))))
984 return XCAR (XCDR (obj));
986 print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
988 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
989 value = Fbuffer_string ();
991 GCPRO1 (value);
992 Ferase_buffer ();
993 set_buffer_internal (old);
994 UNGCPRO;
996 return value;
999 /* Print an error message for the error DATA onto Lisp output stream
1000 STREAM (suitable for the print functions). */
1002 void
1003 print_error_message (data, stream, context, caller)
1004 Lisp_Object data, stream;
1005 char *context;
1006 Lisp_Object caller;
1008 Lisp_Object errname, errmsg, file_error, tail;
1009 struct gcpro gcpro1;
1010 int i;
1012 if (context != 0)
1013 write_string_1 (context, -1, stream);
1015 /* If we know from where the error was signaled, show it in
1016 *Messages*. */
1017 if (!NILP (caller) && SYMBOLP (caller))
1019 const char *name = SDATA (SYMBOL_NAME (caller));
1020 message_dolog (name, strlen (name), 0, 0);
1021 message_dolog (": ", 2, 0, 0);
1024 errname = Fcar (data);
1026 if (EQ (errname, Qerror))
1028 data = Fcdr (data);
1029 if (!CONSP (data))
1030 data = Qnil;
1031 errmsg = Fcar (data);
1032 file_error = Qnil;
1034 else
1036 Lisp_Object error_conditions;
1037 errmsg = Fget (errname, Qerror_message);
1038 error_conditions = Fget (errname, Qerror_conditions);
1039 file_error = Fmemq (Qfile_error, error_conditions);
1042 /* Print an error message including the data items. */
1044 tail = Fcdr_safe (data);
1045 GCPRO1 (tail);
1047 /* For file-error, make error message by concatenating
1048 all the data items. They are all strings. */
1049 if (!NILP (file_error) && CONSP (tail))
1050 errmsg = XCAR (tail), tail = XCDR (tail);
1052 if (STRINGP (errmsg))
1053 Fprinc (errmsg, stream);
1054 else
1055 write_string_1 ("peculiar error", -1, stream);
1057 for (i = 0; CONSP (tail); tail = XCDR (tail), i++)
1059 Lisp_Object obj;
1061 write_string_1 (i ? ", " : ": ", 2, stream);
1062 obj = XCAR (tail);
1063 if (!NILP (file_error) || EQ (errname, Qend_of_file))
1064 Fprinc (obj, stream);
1065 else
1066 Fprin1 (obj, stream);
1069 UNGCPRO;
1075 * The buffer should be at least as large as the max string size of the
1076 * largest float, printed in the biggest notation. This is undoubtedly
1077 * 20d float_output_format, with the negative of the C-constant "HUGE"
1078 * from <math.h>.
1080 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1082 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1083 * case of -1e307 in 20d float_output_format. What is one to do (short of
1084 * re-writing _doprnt to be more sane)?
1085 * -wsr
1088 void
1089 float_to_string (buf, data)
1090 unsigned char *buf;
1091 double data;
1093 unsigned char *cp;
1094 int width;
1096 /* Check for plus infinity in a way that won't lose
1097 if there is no plus infinity. */
1098 if (data == data / 2 && data > 1.0)
1100 strcpy (buf, "1.0e+INF");
1101 return;
1103 /* Likewise for minus infinity. */
1104 if (data == data / 2 && data < -1.0)
1106 strcpy (buf, "-1.0e+INF");
1107 return;
1109 /* Check for NaN in a way that won't fail if there are no NaNs. */
1110 if (! (data * 0.0 >= 0.0))
1112 /* Prepend "-" if the NaN's sign bit is negative.
1113 The sign bit of a double is the bit that is 1 in -0.0. */
1114 int i;
1115 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
1116 u_data.d = data;
1117 u_minus_zero.d = - 0.0;
1118 for (i = 0; i < sizeof (double); i++)
1119 if (u_data.c[i] & u_minus_zero.c[i])
1121 *buf++ = '-';
1122 break;
1125 strcpy (buf, "0.0e+NaN");
1126 return;
1129 if (NILP (Vfloat_output_format)
1130 || !STRINGP (Vfloat_output_format))
1131 lose:
1133 /* Generate the fewest number of digits that represent the
1134 floating point value without losing information.
1135 The following method is simple but a bit slow.
1136 For ideas about speeding things up, please see:
1138 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1139 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1141 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1142 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1144 width = fabs (data) < DBL_MIN ? 1 : DBL_DIG;
1146 sprintf (buf, "%.*g", width, data);
1147 while (width++ < DOUBLE_DIGITS_BOUND && atof (buf) != data);
1149 else /* oink oink */
1151 /* Check that the spec we have is fully valid.
1152 This means not only valid for printf,
1153 but meant for floats, and reasonable. */
1154 cp = SDATA (Vfloat_output_format);
1156 if (cp[0] != '%')
1157 goto lose;
1158 if (cp[1] != '.')
1159 goto lose;
1161 cp += 2;
1163 /* Check the width specification. */
1164 width = -1;
1165 if ('0' <= *cp && *cp <= '9')
1167 width = 0;
1169 width = (width * 10) + (*cp++ - '0');
1170 while (*cp >= '0' && *cp <= '9');
1172 /* A precision of zero is valid only for %f. */
1173 if (width > DBL_DIG
1174 || (width == 0 && *cp != 'f'))
1175 goto lose;
1178 if (*cp != 'e' && *cp != 'f' && *cp != 'g')
1179 goto lose;
1181 if (cp[1] != 0)
1182 goto lose;
1184 sprintf (buf, SDATA (Vfloat_output_format), data);
1187 /* Make sure there is a decimal point with digit after, or an
1188 exponent, so that the value is readable as a float. But don't do
1189 this with "%.0f"; it's valid for that not to produce a decimal
1190 point. Note that width can be 0 only for %.0f. */
1191 if (width != 0)
1193 for (cp = buf; *cp; cp++)
1194 if ((*cp < '0' || *cp > '9') && *cp != '-')
1195 break;
1197 if (*cp == '.' && cp[1] == 0)
1199 cp[1] = '0';
1200 cp[2] = 0;
1203 if (*cp == 0)
1205 *cp++ = '.';
1206 *cp++ = '0';
1207 *cp++ = 0;
1213 static void
1214 print (obj, printcharfun, escapeflag)
1215 Lisp_Object obj;
1216 register Lisp_Object printcharfun;
1217 int escapeflag;
1219 print_depth = 0;
1220 old_backquote_output = 0;
1222 /* Reset print_number_index and Vprint_number_table only when
1223 the variable Vprint_continuous_numbering is nil. Otherwise,
1224 the values of these variables will be kept between several
1225 print functions. */
1226 if (NILP (Vprint_continuous_numbering))
1228 print_number_index = 0;
1229 Vprint_number_table = Qnil;
1232 /* Construct Vprint_number_table for print-gensym and print-circle. */
1233 if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
1235 int i, start, index;
1236 start = index = print_number_index;
1237 /* Construct Vprint_number_table.
1238 This increments print_number_index for the objects added. */
1239 print_preprocess (obj);
1241 /* Remove unnecessary objects, which appear only once in OBJ;
1242 that is, whose status is Qnil. Compactify the necessary objects. */
1243 for (i = start; i < print_number_index; i++)
1244 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1246 PRINT_NUMBER_OBJECT (Vprint_number_table, index)
1247 = PRINT_NUMBER_OBJECT (Vprint_number_table, i);
1248 index++;
1251 /* Clear out objects outside the active part of the table. */
1252 for (i = index; i < print_number_index; i++)
1253 PRINT_NUMBER_OBJECT (Vprint_number_table, i) = Qnil;
1255 /* Reset the status field for the next print step. Now this
1256 field means whether the object has already been printed. */
1257 for (i = start; i < print_number_index; i++)
1258 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qnil;
1260 print_number_index = index;
1263 print_object (obj, printcharfun, escapeflag);
1266 /* Construct Vprint_number_table according to the structure of OBJ.
1267 OBJ itself and all its elements will be added to Vprint_number_table
1268 recursively if it is a list, vector, compiled function, char-table,
1269 string (its text properties will be traced), or a symbol that has
1270 no obarray (this is for the print-gensym feature).
1271 The status fields of Vprint_number_table mean whether each object appears
1272 more than once in OBJ: Qnil at the first time, and Qt after that . */
1273 static void
1274 print_preprocess (obj)
1275 Lisp_Object obj;
1277 int i, size;
1279 loop:
1280 if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
1281 || COMPILEDP (obj) || CHAR_TABLE_P (obj)
1282 || (! NILP (Vprint_gensym)
1283 && SYMBOLP (obj)
1284 && !SYMBOL_INTERNED_P (obj)))
1286 /* In case print-circle is nil and print-gensym is t,
1287 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1288 if (! NILP (Vprint_circle) || SYMBOLP (obj))
1290 for (i = 0; i < print_number_index; i++)
1291 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
1293 /* OBJ appears more than once. Let's remember that. */
1294 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
1295 return;
1298 /* OBJ is not yet recorded. Let's add to the table. */
1299 if (print_number_index == 0)
1301 /* Initialize the table. */
1302 Vprint_number_table = Fmake_vector (make_number (40), Qnil);
1304 else if (XVECTOR (Vprint_number_table)->size == print_number_index * 2)
1306 /* Reallocate the table. */
1307 int i = print_number_index * 4;
1308 Lisp_Object old_table = Vprint_number_table;
1309 Vprint_number_table = Fmake_vector (make_number (i), Qnil);
1310 for (i = 0; i < print_number_index; i++)
1312 PRINT_NUMBER_OBJECT (Vprint_number_table, i)
1313 = PRINT_NUMBER_OBJECT (old_table, i);
1314 PRINT_NUMBER_STATUS (Vprint_number_table, i)
1315 = PRINT_NUMBER_STATUS (old_table, i);
1318 PRINT_NUMBER_OBJECT (Vprint_number_table, print_number_index) = obj;
1319 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1320 always print the gensym with a number. This is a special for
1321 the lisp function byte-compile-output-docform. */
1322 if (!NILP (Vprint_continuous_numbering)
1323 && SYMBOLP (obj)
1324 && !SYMBOL_INTERNED_P (obj))
1325 PRINT_NUMBER_STATUS (Vprint_number_table, print_number_index) = Qt;
1326 print_number_index++;
1329 switch (XGCTYPE (obj))
1331 case Lisp_String:
1332 /* A string may have text properties, which can be circular. */
1333 traverse_intervals_noorder (STRING_INTERVALS (obj),
1334 print_preprocess_string, Qnil);
1335 break;
1337 case Lisp_Cons:
1338 print_preprocess (XCAR (obj));
1339 obj = XCDR (obj);
1340 goto loop;
1342 case Lisp_Vectorlike:
1343 size = XVECTOR (obj)->size & PSEUDOVECTOR_SIZE_MASK;
1344 for (i = 0; i < size; i++)
1345 print_preprocess (XVECTOR (obj)->contents[i]);
1346 break;
1348 default:
1349 break;
1354 static void
1355 print_preprocess_string (interval, arg)
1356 INTERVAL interval;
1357 Lisp_Object arg;
1359 print_preprocess (interval->plist);
1362 static void
1363 print_object (obj, printcharfun, escapeflag)
1364 Lisp_Object obj;
1365 register Lisp_Object printcharfun;
1366 int escapeflag;
1368 char buf[30];
1370 QUIT;
1372 /* Detect circularities and truncate them. */
1373 if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
1374 || COMPILEDP (obj) || CHAR_TABLE_P (obj)
1375 || (! NILP (Vprint_gensym)
1376 && SYMBOLP (obj)
1377 && !SYMBOL_INTERNED_P (obj)))
1379 if (NILP (Vprint_circle) && NILP (Vprint_gensym))
1381 /* Simple but incomplete way. */
1382 int i;
1383 for (i = 0; i < print_depth; i++)
1384 if (EQ (obj, being_printed[i]))
1386 sprintf (buf, "#%d", i);
1387 strout (buf, -1, -1, printcharfun, 0);
1388 return;
1390 being_printed[print_depth] = obj;
1392 else
1394 /* With the print-circle feature. */
1395 int i;
1396 for (i = 0; i < print_number_index; i++)
1397 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
1399 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1401 /* Add a prefix #n= if OBJ has not yet been printed;
1402 that is, its status field is nil. */
1403 sprintf (buf, "#%d=", i + 1);
1404 strout (buf, -1, -1, printcharfun, 0);
1405 /* OBJ is going to be printed. Set the status to t. */
1406 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
1407 break;
1409 else
1411 /* Just print #n# if OBJ has already been printed. */
1412 sprintf (buf, "#%d#", i + 1);
1413 strout (buf, -1, -1, printcharfun, 0);
1414 return;
1420 print_depth++;
1422 if (print_depth > PRINT_CIRCLE)
1423 error ("Apparently circular structure being printed");
1424 #ifdef MAX_PRINT_CHARS
1425 if (max_print && print_chars > max_print)
1427 PRINTCHAR ('\n');
1428 print_chars = 0;
1430 #endif /* MAX_PRINT_CHARS */
1432 switch (XGCTYPE (obj))
1434 case Lisp_Int:
1435 if (sizeof (int) == sizeof (EMACS_INT))
1436 sprintf (buf, "%d", XINT (obj));
1437 else if (sizeof (long) == sizeof (EMACS_INT))
1438 sprintf (buf, "%ld", (long) XINT (obj));
1439 else
1440 abort ();
1441 strout (buf, -1, -1, printcharfun, 0);
1442 break;
1444 case Lisp_Float:
1446 char pigbuf[350]; /* see comments in float_to_string */
1448 float_to_string (pigbuf, XFLOAT_DATA (obj));
1449 strout (pigbuf, -1, -1, printcharfun, 0);
1451 break;
1453 case Lisp_String:
1454 if (!escapeflag)
1455 print_string (obj, printcharfun);
1456 else
1458 register int i, i_byte;
1459 struct gcpro gcpro1;
1460 unsigned char *str;
1461 int size_byte;
1462 /* 1 means we must ensure that the next character we output
1463 cannot be taken as part of a hex character escape. */
1464 int need_nonhex = 0;
1465 int multibyte = STRING_MULTIBYTE (obj);
1467 GCPRO1 (obj);
1469 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1471 PRINTCHAR ('#');
1472 PRINTCHAR ('(');
1475 PRINTCHAR ('\"');
1476 str = SDATA (obj);
1477 size_byte = SBYTES (obj);
1479 for (i = 0, i_byte = 0; i_byte < size_byte;)
1481 /* Here, we must convert each multi-byte form to the
1482 corresponding character code before handing it to PRINTCHAR. */
1483 int len;
1484 int c;
1486 if (multibyte)
1488 c = STRING_CHAR_AND_LENGTH (str + i_byte,
1489 size_byte - i_byte, len);
1490 if (CHAR_VALID_P (c, 0))
1491 i_byte += len;
1492 else
1493 c = str[i_byte++];
1495 else
1496 c = str[i_byte++];
1498 QUIT;
1500 if (c == '\n' && print_escape_newlines)
1502 PRINTCHAR ('\\');
1503 PRINTCHAR ('n');
1505 else if (c == '\f' && print_escape_newlines)
1507 PRINTCHAR ('\\');
1508 PRINTCHAR ('f');
1510 else if (multibyte
1511 && ! ASCII_BYTE_P (c)
1512 && (SINGLE_BYTE_CHAR_P (c) || print_escape_multibyte))
1514 /* When multibyte is disabled,
1515 print multibyte string chars using hex escapes.
1516 For a char code that could be in a unibyte string,
1517 when found in a multibyte string, always use a hex escape
1518 so it reads back as multibyte. */
1519 unsigned char outbuf[50];
1520 sprintf (outbuf, "\\x%x", c);
1521 strout (outbuf, -1, -1, printcharfun, 0);
1522 need_nonhex = 1;
1524 else if (! multibyte
1525 && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
1526 && print_escape_nonascii)
1528 /* When printing in a multibyte buffer
1529 or when explicitly requested,
1530 print single-byte non-ASCII string chars
1531 using octal escapes. */
1532 unsigned char outbuf[5];
1533 sprintf (outbuf, "\\%03o", c);
1534 strout (outbuf, -1, -1, printcharfun, 0);
1536 else
1538 /* If we just had a hex escape, and this character
1539 could be taken as part of it,
1540 output `\ ' to prevent that. */
1541 if (need_nonhex)
1543 need_nonhex = 0;
1544 if ((c >= 'a' && c <= 'f')
1545 || (c >= 'A' && c <= 'F')
1546 || (c >= '0' && c <= '9'))
1547 strout ("\\ ", -1, -1, printcharfun, 0);
1550 if (c == '\"' || c == '\\')
1551 PRINTCHAR ('\\');
1552 PRINTCHAR (c);
1555 PRINTCHAR ('\"');
1557 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1559 traverse_intervals (STRING_INTERVALS (obj),
1560 0, print_interval, printcharfun);
1561 PRINTCHAR (')');
1564 UNGCPRO;
1566 break;
1568 case Lisp_Symbol:
1570 register int confusing;
1571 register unsigned char *p = SDATA (SYMBOL_NAME (obj));
1572 register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
1573 register int c;
1574 int i, i_byte, size_byte;
1575 Lisp_Object name;
1577 name = SYMBOL_NAME (obj);
1579 if (p != end && (*p == '-' || *p == '+')) p++;
1580 if (p == end)
1581 confusing = 0;
1582 /* If symbol name begins with a digit, and ends with a digit,
1583 and contains nothing but digits and `e', it could be treated
1584 as a number. So set CONFUSING.
1586 Symbols that contain periods could also be taken as numbers,
1587 but periods are always escaped, so we don't have to worry
1588 about them here. */
1589 else if (*p >= '0' && *p <= '9'
1590 && end[-1] >= '0' && end[-1] <= '9')
1592 while (p != end && ((*p >= '0' && *p <= '9')
1593 /* Needed for \2e10. */
1594 || *p == 'e'))
1595 p++;
1596 confusing = (end == p);
1598 else
1599 confusing = 0;
1601 if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj))
1603 PRINTCHAR ('#');
1604 PRINTCHAR (':');
1607 size_byte = SBYTES (name);
1609 for (i = 0, i_byte = 0; i_byte < size_byte;)
1611 /* Here, we must convert each multi-byte form to the
1612 corresponding character code before handing it to PRINTCHAR. */
1613 FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
1614 QUIT;
1616 if (escapeflag)
1618 if (c == '\"' || c == '\\' || c == '\''
1619 || c == ';' || c == '#' || c == '(' || c == ')'
1620 || c == ',' || c =='.' || c == '`'
1621 || c == '[' || c == ']' || c == '?' || c <= 040
1622 || confusing)
1623 PRINTCHAR ('\\'), confusing = 0;
1625 PRINTCHAR (c);
1628 break;
1630 case Lisp_Cons:
1631 /* If deeper than spec'd depth, print placeholder. */
1632 if (INTEGERP (Vprint_level)
1633 && print_depth > XINT (Vprint_level))
1634 strout ("...", -1, -1, printcharfun, 0);
1635 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1636 && (EQ (XCAR (obj), Qquote)))
1638 PRINTCHAR ('\'');
1639 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1641 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1642 && (EQ (XCAR (obj), Qfunction)))
1644 PRINTCHAR ('#');
1645 PRINTCHAR ('\'');
1646 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1648 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1649 && ! old_backquote_output
1650 && ((EQ (XCAR (obj), Qbackquote)
1651 || EQ (XCAR (obj), Qcomma)
1652 || EQ (XCAR (obj), Qcomma_at)
1653 || EQ (XCAR (obj), Qcomma_dot))))
1655 print_object (XCAR (obj), printcharfun, 0);
1656 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1658 else
1660 PRINTCHAR ('(');
1662 /* If the first element is a backquote form,
1663 print it old-style so it won't be misunderstood. */
1664 if (print_quoted && CONSP (XCAR (obj))
1665 && CONSP (XCDR (XCAR (obj)))
1666 && NILP (XCDR (XCDR (XCAR (obj))))
1667 && EQ (XCAR (XCAR (obj)), Qbackquote))
1669 Lisp_Object tem;
1670 tem = XCAR (obj);
1671 PRINTCHAR ('(');
1673 print_object (Qbackquote, printcharfun, 0);
1674 PRINTCHAR (' ');
1676 ++old_backquote_output;
1677 print_object (XCAR (XCDR (tem)), printcharfun, 0);
1678 --old_backquote_output;
1679 PRINTCHAR (')');
1681 obj = XCDR (obj);
1685 int print_length, i;
1686 Lisp_Object halftail = obj;
1688 /* Negative values of print-length are invalid in CL.
1689 Treat them like nil, as CMUCL does. */
1690 if (NATNUMP (Vprint_length))
1691 print_length = XFASTINT (Vprint_length);
1692 else
1693 print_length = 0;
1695 i = 0;
1696 while (CONSP (obj))
1698 /* Detect circular list. */
1699 if (NILP (Vprint_circle))
1701 /* Simple but imcomplete way. */
1702 if (i != 0 && EQ (obj, halftail))
1704 sprintf (buf, " . #%d", i / 2);
1705 strout (buf, -1, -1, printcharfun, 0);
1706 goto end_of_list;
1709 else
1711 /* With the print-circle feature. */
1712 if (i != 0)
1714 int i;
1715 for (i = 0; i < print_number_index; i++)
1716 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i),
1717 obj))
1719 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1721 strout (" . ", 3, 3, printcharfun, 0);
1722 print_object (obj, printcharfun, escapeflag);
1724 else
1726 sprintf (buf, " . #%d#", i + 1);
1727 strout (buf, -1, -1, printcharfun, 0);
1729 goto end_of_list;
1734 if (i++)
1735 PRINTCHAR (' ');
1737 if (print_length && i > print_length)
1739 strout ("...", 3, 3, printcharfun, 0);
1740 goto end_of_list;
1743 print_object (XCAR (obj), printcharfun, escapeflag);
1745 obj = XCDR (obj);
1746 if (!(i & 1))
1747 halftail = XCDR (halftail);
1751 /* OBJ non-nil here means it's the end of a dotted list. */
1752 if (!NILP (obj))
1754 strout (" . ", 3, 3, printcharfun, 0);
1755 print_object (obj, printcharfun, escapeflag);
1758 end_of_list:
1759 PRINTCHAR (')');
1761 break;
1763 case Lisp_Vectorlike:
1764 if (PROCESSP (obj))
1766 if (escapeflag)
1768 strout ("#<process ", -1, -1, printcharfun, 0);
1769 print_string (XPROCESS (obj)->name, printcharfun);
1770 PRINTCHAR ('>');
1772 else
1773 print_string (XPROCESS (obj)->name, printcharfun);
1775 else if (BOOL_VECTOR_P (obj))
1777 register int i;
1778 register unsigned char c;
1779 struct gcpro gcpro1;
1780 int size_in_chars
1781 = (XBOOL_VECTOR (obj)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
1783 GCPRO1 (obj);
1785 PRINTCHAR ('#');
1786 PRINTCHAR ('&');
1787 sprintf (buf, "%d", XBOOL_VECTOR (obj)->size);
1788 strout (buf, -1, -1, printcharfun, 0);
1789 PRINTCHAR ('\"');
1791 /* Don't print more characters than the specified maximum.
1792 Negative values of print-length are invalid. Treat them
1793 like a print-length of nil. */
1794 if (NATNUMP (Vprint_length)
1795 && XFASTINT (Vprint_length) < size_in_chars)
1796 size_in_chars = XFASTINT (Vprint_length);
1798 for (i = 0; i < size_in_chars; i++)
1800 QUIT;
1801 c = XBOOL_VECTOR (obj)->data[i];
1802 if (c == '\n' && print_escape_newlines)
1804 PRINTCHAR ('\\');
1805 PRINTCHAR ('n');
1807 else if (c == '\f' && print_escape_newlines)
1809 PRINTCHAR ('\\');
1810 PRINTCHAR ('f');
1812 else
1814 if (c == '\"' || c == '\\')
1815 PRINTCHAR ('\\');
1816 PRINTCHAR (c);
1819 PRINTCHAR ('\"');
1821 UNGCPRO;
1823 else if (SUBRP (obj))
1825 strout ("#<subr ", -1, -1, printcharfun, 0);
1826 strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun, 0);
1827 PRINTCHAR ('>');
1829 else if (WINDOWP (obj))
1831 strout ("#<window ", -1, -1, printcharfun, 0);
1832 sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number));
1833 strout (buf, -1, -1, printcharfun, 0);
1834 if (!NILP (XWINDOW (obj)->buffer))
1836 strout (" on ", -1, -1, printcharfun, 0);
1837 print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun);
1839 PRINTCHAR ('>');
1841 else if (HASH_TABLE_P (obj))
1843 struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
1844 strout ("#<hash-table", -1, -1, printcharfun, 0);
1845 if (SYMBOLP (h->test))
1847 PRINTCHAR (' ');
1848 PRINTCHAR ('\'');
1849 strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun, 0);
1850 PRINTCHAR (' ');
1851 strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0);
1852 PRINTCHAR (' ');
1853 sprintf (buf, "%d/%d", XFASTINT (h->count),
1854 XVECTOR (h->next)->size);
1855 strout (buf, -1, -1, printcharfun, 0);
1857 sprintf (buf, " 0x%lx", (unsigned long) h);
1858 strout (buf, -1, -1, printcharfun, 0);
1859 PRINTCHAR ('>');
1861 else if (BUFFERP (obj))
1863 if (NILP (XBUFFER (obj)->name))
1864 strout ("#<killed buffer>", -1, -1, printcharfun, 0);
1865 else if (escapeflag)
1867 strout ("#<buffer ", -1, -1, printcharfun, 0);
1868 print_string (XBUFFER (obj)->name, printcharfun);
1869 PRINTCHAR ('>');
1871 else
1872 print_string (XBUFFER (obj)->name, printcharfun);
1874 else if (WINDOW_CONFIGURATIONP (obj))
1876 strout ("#<window-configuration>", -1, -1, printcharfun, 0);
1878 else if (FRAMEP (obj))
1880 strout ((FRAME_LIVE_P (XFRAME (obj))
1881 ? "#<frame " : "#<dead frame "),
1882 -1, -1, printcharfun, 0);
1883 print_string (XFRAME (obj)->name, printcharfun);
1884 sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj)));
1885 strout (buf, -1, -1, printcharfun, 0);
1886 PRINTCHAR ('>');
1888 else
1890 int size = XVECTOR (obj)->size;
1891 if (COMPILEDP (obj))
1893 PRINTCHAR ('#');
1894 size &= PSEUDOVECTOR_SIZE_MASK;
1896 if (CHAR_TABLE_P (obj))
1898 /* We print a char-table as if it were a vector,
1899 lumping the parent and default slots in with the
1900 character slots. But we add #^ as a prefix. */
1901 PRINTCHAR ('#');
1902 PRINTCHAR ('^');
1903 if (SUB_CHAR_TABLE_P (obj))
1904 PRINTCHAR ('^');
1905 size &= PSEUDOVECTOR_SIZE_MASK;
1907 if (size & PSEUDOVECTOR_FLAG)
1908 goto badtype;
1910 PRINTCHAR ('[');
1912 register int i;
1913 register Lisp_Object tem;
1914 int real_size = size;
1916 /* Don't print more elements than the specified maximum. */
1917 if (NATNUMP (Vprint_length)
1918 && XFASTINT (Vprint_length) < size)
1919 size = XFASTINT (Vprint_length);
1921 for (i = 0; i < size; i++)
1923 if (i) PRINTCHAR (' ');
1924 tem = XVECTOR (obj)->contents[i];
1925 print_object (tem, printcharfun, escapeflag);
1927 if (size < real_size)
1928 strout (" ...", 4, 4, printcharfun, 0);
1930 PRINTCHAR (']');
1932 break;
1934 case Lisp_Misc:
1935 switch (XMISCTYPE (obj))
1937 case Lisp_Misc_Marker:
1938 strout ("#<marker ", -1, -1, printcharfun, 0);
1939 /* Do you think this is necessary? */
1940 if (XMARKER (obj)->insertion_type != 0)
1941 strout ("(moves after insertion) ", -1, -1, printcharfun, 0);
1942 if (!(XMARKER (obj)->buffer))
1943 strout ("in no buffer", -1, -1, printcharfun, 0);
1944 else
1946 sprintf (buf, "at %d", marker_position (obj));
1947 strout (buf, -1, -1, printcharfun, 0);
1948 strout (" in ", -1, -1, printcharfun, 0);
1949 print_string (XMARKER (obj)->buffer->name, printcharfun);
1951 PRINTCHAR ('>');
1952 break;
1954 case Lisp_Misc_Overlay:
1955 strout ("#<overlay ", -1, -1, printcharfun, 0);
1956 if (!(XMARKER (OVERLAY_START (obj))->buffer))
1957 strout ("in no buffer", -1, -1, printcharfun, 0);
1958 else
1960 sprintf (buf, "from %d to %d in ",
1961 marker_position (OVERLAY_START (obj)),
1962 marker_position (OVERLAY_END (obj)));
1963 strout (buf, -1, -1, printcharfun, 0);
1964 print_string (XMARKER (OVERLAY_START (obj))->buffer->name,
1965 printcharfun);
1967 PRINTCHAR ('>');
1968 break;
1970 /* Remaining cases shouldn't happen in normal usage, but let's print
1971 them anyway for the benefit of the debugger. */
1972 case Lisp_Misc_Free:
1973 strout ("#<misc free cell>", -1, -1, printcharfun, 0);
1974 break;
1976 case Lisp_Misc_Intfwd:
1977 sprintf (buf, "#<intfwd to %d>", *XINTFWD (obj)->intvar);
1978 strout (buf, -1, -1, printcharfun, 0);
1979 break;
1981 case Lisp_Misc_Boolfwd:
1982 sprintf (buf, "#<boolfwd to %s>",
1983 (*XBOOLFWD (obj)->boolvar ? "t" : "nil"));
1984 strout (buf, -1, -1, printcharfun, 0);
1985 break;
1987 case Lisp_Misc_Objfwd:
1988 strout ("#<objfwd to ", -1, -1, printcharfun, 0);
1989 print_object (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
1990 PRINTCHAR ('>');
1991 break;
1993 case Lisp_Misc_Buffer_Objfwd:
1994 strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
1995 print_object (PER_BUFFER_VALUE (current_buffer,
1996 XBUFFER_OBJFWD (obj)->offset),
1997 printcharfun, escapeflag);
1998 PRINTCHAR ('>');
1999 break;
2001 case Lisp_Misc_Kboard_Objfwd:
2002 strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
2003 print_object (*(Lisp_Object *)((char *) current_kboard
2004 + XKBOARD_OBJFWD (obj)->offset),
2005 printcharfun, escapeflag);
2006 PRINTCHAR ('>');
2007 break;
2009 case Lisp_Misc_Buffer_Local_Value:
2010 strout ("#<buffer_local_value ", -1, -1, printcharfun, 0);
2011 goto do_buffer_local;
2012 case Lisp_Misc_Some_Buffer_Local_Value:
2013 strout ("#<some_buffer_local_value ", -1, -1, printcharfun, 0);
2014 do_buffer_local:
2015 strout ("[realvalue] ", -1, -1, printcharfun, 0);
2016 print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue,
2017 printcharfun, escapeflag);
2018 if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer)
2019 strout ("[local in buffer] ", -1, -1, printcharfun, 0);
2020 else
2021 strout ("[buffer] ", -1, -1, printcharfun, 0);
2022 print_object (XBUFFER_LOCAL_VALUE (obj)->buffer,
2023 printcharfun, escapeflag);
2024 if (XBUFFER_LOCAL_VALUE (obj)->check_frame)
2026 if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame)
2027 strout ("[local in frame] ", -1, -1, printcharfun, 0);
2028 else
2029 strout ("[frame] ", -1, -1, printcharfun, 0);
2030 print_object (XBUFFER_LOCAL_VALUE (obj)->frame,
2031 printcharfun, escapeflag);
2033 strout ("[alist-elt] ", -1, -1, printcharfun, 0);
2034 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj)->cdr),
2035 printcharfun, escapeflag);
2036 strout ("[default-value] ", -1, -1, printcharfun, 0);
2037 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj)->cdr),
2038 printcharfun, escapeflag);
2039 PRINTCHAR ('>');
2040 break;
2042 default:
2043 goto badtype;
2045 break;
2047 default:
2048 badtype:
2050 /* We're in trouble if this happens!
2051 Probably should just abort () */
2052 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun, 0);
2053 if (MISCP (obj))
2054 sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
2055 else if (VECTORLIKEP (obj))
2056 sprintf (buf, "(PVEC 0x%08x)", (int) XVECTOR (obj)->size);
2057 else
2058 sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
2059 strout (buf, -1, -1, printcharfun, 0);
2060 strout (" Save your buffers immediately and please report this bug>",
2061 -1, -1, printcharfun, 0);
2065 print_depth--;
2069 /* Print a description of INTERVAL using PRINTCHARFUN.
2070 This is part of printing a string that has text properties. */
2072 void
2073 print_interval (interval, printcharfun)
2074 INTERVAL interval;
2075 Lisp_Object printcharfun;
2077 PRINTCHAR (' ');
2078 print_object (make_number (interval->position), printcharfun, 1);
2079 PRINTCHAR (' ');
2080 print_object (make_number (interval->position + LENGTH (interval)),
2081 printcharfun, 1);
2082 PRINTCHAR (' ');
2083 print_object (interval->plist, printcharfun, 1);
2087 void
2088 syms_of_print ()
2090 Qtemp_buffer_setup_hook = intern ("temp-buffer-setup-hook");
2091 staticpro (&Qtemp_buffer_setup_hook);
2093 DEFVAR_LISP ("standard-output", &Vstandard_output,
2094 doc: /* Output stream `print' uses by default for outputting a character.
2095 This may be any function of one argument.
2096 It may also be a buffer (output is inserted before point)
2097 or a marker (output is inserted and the marker is advanced)
2098 or the symbol t (output appears in the echo area). */);
2099 Vstandard_output = Qt;
2100 Qstandard_output = intern ("standard-output");
2101 staticpro (&Qstandard_output);
2103 DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
2104 doc: /* The format descriptor string used to print floats.
2105 This is a %-spec like those accepted by `printf' in C,
2106 but with some restrictions. It must start with the two characters `%.'.
2107 After that comes an integer precision specification,
2108 and then a letter which controls the format.
2109 The letters allowed are `e', `f' and `g'.
2110 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2111 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2112 Use `g' to choose the shorter of those two formats for the number at hand.
2113 The precision in any of these cases is the number of digits following
2114 the decimal point. With `f', a precision of 0 means to omit the
2115 decimal point. 0 is not allowed with `e' or `g'.
2117 A value of nil means to use the shortest notation
2118 that represents the number without losing information. */);
2119 Vfloat_output_format = Qnil;
2120 Qfloat_output_format = intern ("float-output-format");
2121 staticpro (&Qfloat_output_format);
2123 DEFVAR_LISP ("print-length", &Vprint_length,
2124 doc: /* Maximum length of list to print before abbreviating.
2125 A value of nil means no limit. See also `eval-expression-print-length'. */);
2126 Vprint_length = Qnil;
2128 DEFVAR_LISP ("print-level", &Vprint_level,
2129 doc: /* Maximum depth of list nesting to print before abbreviating.
2130 A value of nil means no limit. See also `eval-expression-print-level'. */);
2131 Vprint_level = Qnil;
2133 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
2134 doc: /* Non-nil means print newlines in strings as `\\n'.
2135 Also print formfeeds as `\\f'. */);
2136 print_escape_newlines = 0;
2138 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii,
2139 doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2140 \(OOO is the octal representation of the character code.)
2141 Only single-byte characters are affected, and only in `prin1'.
2142 When the output goes in a multibyte buffer, this feature is
2143 enabled regardless of the value of the variable. */);
2144 print_escape_nonascii = 0;
2146 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte,
2147 doc: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2148 \(XXXX is the hex representation of the character code.)
2149 This affects only `prin1'. */);
2150 print_escape_multibyte = 0;
2152 DEFVAR_BOOL ("print-quoted", &print_quoted,
2153 doc: /* Non-nil means print quoted forms with reader syntax.
2154 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2155 forms print as in the new syntax. */);
2156 print_quoted = 0;
2158 DEFVAR_LISP ("print-gensym", &Vprint_gensym,
2159 doc: /* Non-nil means print uninterned symbols so they will read as uninterned.
2160 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2161 When the uninterned symbol appears within a recursive data structure,
2162 and the symbol appears more than once, in addition use the #N# and #N=
2163 constructs as needed, so that multiple references to the same symbol are
2164 shared once again when the text is read back. */);
2165 Vprint_gensym = Qnil;
2167 DEFVAR_LISP ("print-circle", &Vprint_circle,
2168 doc: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2169 If nil, printing proceeds recursively and may lead to
2170 `max-lisp-eval-depth' being exceeded or an error may occur:
2171 \"Apparently circular structure being printed.\" Also see
2172 `print-length' and `print-level'.
2173 If non-nil, shared substructures anywhere in the structure are printed
2174 with `#N=' before the first occurrence (in the order of the print
2175 representation) and `#N#' in place of each subsequent occurrence,
2176 where N is a positive decimal integer. */);
2177 Vprint_circle = Qnil;
2179 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering,
2180 doc: /* *Non-nil means number continuously across print calls.
2181 This affects the numbers printed for #N= labels and #M# references.
2182 See also `print-circle', `print-gensym', and `print-number-table'.
2183 This variable should not be set with `setq'; bind it with a `let' instead. */);
2184 Vprint_continuous_numbering = Qnil;
2186 DEFVAR_LISP ("print-number-table", &Vprint_number_table,
2187 doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
2188 The Lisp printer uses this vector to detect Lisp objects referenced more
2189 than once.
2191 When you bind `print-continuous-numbering' to t, you should probably
2192 also bind `print-number-table' to nil. This ensures that the value of
2193 `print-number-table' can be garbage-collected once the printing is
2194 done. If all elements of `print-number-table' are nil, it means that
2195 the printing done so far has not found any shared structure or objects
2196 that need to be recorded in the table. */);
2197 Vprint_number_table = Qnil;
2199 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2200 staticpro (&Vprin1_to_string_buffer);
2202 defsubr (&Sprin1);
2203 defsubr (&Sprin1_to_string);
2204 defsubr (&Serror_message_string);
2205 defsubr (&Sprinc);
2206 defsubr (&Sprint);
2207 defsubr (&Sterpri);
2208 defsubr (&Swrite_char);
2209 defsubr (&Sexternal_debugging_output);
2210 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2211 defsubr (&Sredirect_debugging_output);
2212 #endif
2214 Qexternal_debugging_output = intern ("external-debugging-output");
2215 staticpro (&Qexternal_debugging_output);
2217 Qprint_escape_newlines = intern ("print-escape-newlines");
2218 staticpro (&Qprint_escape_newlines);
2220 Qprint_escape_multibyte = intern ("print-escape-multibyte");
2221 staticpro (&Qprint_escape_multibyte);
2223 Qprint_escape_nonascii = intern ("print-escape-nonascii");
2224 staticpro (&Qprint_escape_nonascii);
2226 defsubr (&Swith_output_to_temp_buffer);
2229 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2230 (do not change this comment) */