(Variable Definitions): Replace show-paren-mode example with tooltip-mode.
[emacs.git] / src / print.c
blob8bb55f21248cc2d495487d70e727faa0198cb9d2
1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 01, 03, 2004
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 specbind (Qinhibit_read_only, Qt);
605 specbind (Qinhibit_modification_hooks, Qt);
606 Ferase_buffer ();
607 XSETBUFFER (buf, current_buffer);
609 Frun_hooks (1, &Qtemp_buffer_setup_hook);
611 unbind_to (count, Qnil);
613 specbind (Qstandard_output, buf);
616 Lisp_Object
617 internal_with_output_to_temp_buffer (bufname, function, args)
618 const char *bufname;
619 Lisp_Object (*function) P_ ((Lisp_Object));
620 Lisp_Object args;
622 int count = SPECPDL_INDEX ();
623 Lisp_Object buf, val;
624 struct gcpro gcpro1;
626 GCPRO1 (args);
627 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
628 temp_output_buffer_setup (bufname);
629 buf = Vstandard_output;
630 UNGCPRO;
632 val = (*function) (args);
634 GCPRO1 (val);
635 temp_output_buffer_show (buf);
636 UNGCPRO;
638 return unbind_to (count, val);
641 DEFUN ("with-output-to-temp-buffer",
642 Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
643 1, UNEVALLED, 0,
644 doc: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
645 The buffer is cleared out initially, and marked as unmodified when done.
646 All output done by BODY is inserted in that buffer by default.
647 The buffer is displayed in another window, but not selected.
648 The value of the last form in BODY is returned.
649 If BODY does not finish normally, the buffer BUFNAME is not displayed.
651 The hook `temp-buffer-setup-hook' is run before BODY,
652 with the buffer BUFNAME temporarily current.
653 The hook `temp-buffer-show-hook' is run after the buffer is displayed,
654 with the buffer temporarily current, and the window that was used
655 to display it temporarily selected.
657 If variable `temp-buffer-show-function' is non-nil, call it at the end
658 to get the buffer displayed instead of just displaying the non-selected
659 buffer and calling the hook. It gets one argument, the buffer to display.
661 usage: (with-output-to-temp-buffer BUFNAME BODY ...) */)
662 (args)
663 Lisp_Object args;
665 struct gcpro gcpro1;
666 Lisp_Object name;
667 int count = SPECPDL_INDEX ();
668 Lisp_Object buf, val;
670 GCPRO1(args);
671 name = Feval (Fcar (args));
672 CHECK_STRING (name);
673 temp_output_buffer_setup (SDATA (name));
674 buf = Vstandard_output;
675 UNGCPRO;
677 val = Fprogn (XCDR (args));
679 GCPRO1 (val);
680 temp_output_buffer_show (buf);
681 UNGCPRO;
683 return unbind_to (count, val);
687 static void print ();
688 static void print_preprocess ();
689 static void print_preprocess_string ();
690 static void print_object ();
692 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
693 doc: /* Output a newline to stream PRINTCHARFUN.
694 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
695 (printcharfun)
696 Lisp_Object printcharfun;
698 PRINTDECLARE;
700 if (NILP (printcharfun))
701 printcharfun = Vstandard_output;
702 PRINTPREPARE;
703 PRINTCHAR ('\n');
704 PRINTFINISH;
705 return Qt;
708 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
709 doc: /* Output the printed representation of OBJECT, any Lisp object.
710 Quoting characters are printed when needed to make output that `read'
711 can handle, whenever this is possible. For complex objects, the behavior
712 is controlled by `print-level' and `print-length', which see.
714 OBJECT is any of the Lisp data types: a number, a string, a symbol,
715 a list, a buffer, a window, a frame, etc.
717 A printed representation of an object is text which describes that object.
719 Optional argument PRINTCHARFUN is the output stream, which can be one
720 of these:
722 - a buffer, in which case output is inserted into that buffer at point;
723 - a marker, in which case output is inserted at marker's position;
724 - a function, in which case that function is called once for each
725 character of OBJECT's printed representation;
726 - a symbol, in which case that symbol's function definition is called; or
727 - t, in which case the output is displayed in the echo area.
729 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
730 is used instead. */)
731 (object, printcharfun)
732 Lisp_Object object, printcharfun;
734 PRINTDECLARE;
736 #ifdef MAX_PRINT_CHARS
737 max_print = 0;
738 #endif /* MAX_PRINT_CHARS */
739 if (NILP (printcharfun))
740 printcharfun = Vstandard_output;
741 PRINTPREPARE;
742 print (object, printcharfun, 1);
743 PRINTFINISH;
744 return object;
747 /* a buffer which is used to hold output being built by prin1-to-string */
748 Lisp_Object Vprin1_to_string_buffer;
750 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
751 doc: /* Return a string containing the printed representation of OBJECT.
752 OBJECT can be any Lisp object. This function outputs quoting characters
753 when necessary to make output that `read' can handle, whenever possible,
754 unless the optional second argument NOESCAPE is non-nil.
756 OBJECT is any of the Lisp data types: a number, a string, a symbol,
757 a list, a buffer, a window, a frame, etc.
759 A printed representation of an object is text which describes that object. */)
760 (object, noescape)
761 Lisp_Object object, noescape;
763 Lisp_Object printcharfun;
764 /* struct gcpro gcpro1, gcpro2; */
765 Lisp_Object save_deactivate_mark;
766 int count = specpdl_ptr - specpdl;
767 struct buffer *previous;
769 specbind (Qinhibit_modification_hooks, Qt);
772 PRINTDECLARE;
774 /* Save and restore this--we are altering a buffer
775 but we don't want to deactivate the mark just for that.
776 No need for specbind, since errors deactivate the mark. */
777 save_deactivate_mark = Vdeactivate_mark;
778 /* GCPRO2 (object, save_deactivate_mark); */
779 abort_on_gc++;
781 printcharfun = Vprin1_to_string_buffer;
782 PRINTPREPARE;
783 print (object, printcharfun, NILP (noescape));
784 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
785 PRINTFINISH;
788 previous = current_buffer;
789 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
790 object = Fbuffer_string ();
791 if (SBYTES (object) == SCHARS (object))
792 STRING_SET_UNIBYTE (object);
794 /* Note that this won't make prepare_to_modify_buffer call
795 ask-user-about-supersession-threat because this buffer
796 does not visit a file. */
797 Ferase_buffer ();
798 set_buffer_internal (previous);
800 Vdeactivate_mark = save_deactivate_mark;
801 /* UNGCPRO; */
803 abort_on_gc--;
804 return unbind_to (count, object);
807 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
808 doc: /* Output the printed representation of OBJECT, any Lisp object.
809 No quoting characters are used; no delimiters are printed around
810 the contents of strings.
812 OBJECT is any of the Lisp data types: a number, a string, a symbol,
813 a list, a buffer, a window, a frame, etc.
815 A printed representation of an object is text which describes that object.
817 Optional argument PRINTCHARFUN is the output stream, which can be one
818 of these:
820 - a buffer, in which case output is inserted into that buffer at point;
821 - a marker, in which case output is inserted at marker's position;
822 - a function, in which case that function is called once for each
823 character of OBJECT's printed representation;
824 - a symbol, in which case that symbol's function definition is called; or
825 - t, in which case the output is displayed in the echo area.
827 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
828 is used instead. */)
829 (object, printcharfun)
830 Lisp_Object object, printcharfun;
832 PRINTDECLARE;
834 if (NILP (printcharfun))
835 printcharfun = Vstandard_output;
836 PRINTPREPARE;
837 print (object, printcharfun, 0);
838 PRINTFINISH;
839 return object;
842 DEFUN ("print", Fprint, Sprint, 1, 2, 0,
843 doc: /* Output the printed representation of OBJECT, with newlines around it.
844 Quoting characters are printed when needed to make output that `read'
845 can handle, whenever this is possible. For complex objects, the behavior
846 is controlled by `print-level' and `print-length', which see.
848 OBJECT is any of the Lisp data types: a number, a string, a symbol,
849 a list, a buffer, a window, a frame, etc.
851 A printed representation of an object is text which describes that object.
853 Optional argument PRINTCHARFUN is the output stream, which can be one
854 of these:
856 - a buffer, in which case output is inserted into that buffer at point;
857 - a marker, in which case output is inserted at marker's position;
858 - a function, in which case that function is called once for each
859 character of OBJECT's printed representation;
860 - a symbol, in which case that symbol's function definition is called; or
861 - t, in which case the output is displayed in the echo area.
863 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
864 is used instead. */)
865 (object, printcharfun)
866 Lisp_Object object, printcharfun;
868 PRINTDECLARE;
869 struct gcpro gcpro1;
871 #ifdef MAX_PRINT_CHARS
872 print_chars = 0;
873 max_print = MAX_PRINT_CHARS;
874 #endif /* MAX_PRINT_CHARS */
875 if (NILP (printcharfun))
876 printcharfun = Vstandard_output;
877 GCPRO1 (object);
878 PRINTPREPARE;
879 PRINTCHAR ('\n');
880 print (object, printcharfun, 1);
881 PRINTCHAR ('\n');
882 PRINTFINISH;
883 #ifdef MAX_PRINT_CHARS
884 max_print = 0;
885 print_chars = 0;
886 #endif /* MAX_PRINT_CHARS */
887 UNGCPRO;
888 return object;
891 /* The subroutine object for external-debugging-output is kept here
892 for the convenience of the debugger. */
893 Lisp_Object Qexternal_debugging_output;
895 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
896 doc: /* Write CHARACTER to stderr.
897 You can call print while debugging emacs, and pass it this function
898 to make it write to the debugging output. */)
899 (character)
900 Lisp_Object character;
902 CHECK_NUMBER (character);
903 putc (XINT (character), stderr);
905 #ifdef WINDOWSNT
906 /* Send the output to a debugger (nothing happens if there isn't one). */
908 char buf[2] = {(char) XINT (character), '\0'};
909 OutputDebugString (buf);
911 #endif
913 return character;
917 #if defined(GNU_LINUX)
919 /* This functionality is not vitally important in general, so we rely on
920 non-portable ability to use stderr as lvalue. */
922 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
924 FILE *initial_stderr_stream = NULL;
926 DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output,
927 1, 2,
928 "FDebug output file: \nP",
929 doc: /* Redirect debugging output (stderr stream) to file FILE.
930 If FILE is nil, reset target to the initial stderr stream.
931 Optional arg APPEND non-nil (interactively, with prefix arg) means
932 append to existing target file. */)
933 (file, append)
934 Lisp_Object file, append;
936 if (initial_stderr_stream != NULL)
937 fclose(stderr);
938 stderr = initial_stderr_stream;
939 initial_stderr_stream = NULL;
941 if (STRINGP (file))
943 file = Fexpand_file_name (file, Qnil);
944 initial_stderr_stream = stderr;
945 stderr = fopen(SDATA (file), NILP (append) ? "w" : "a");
946 if (stderr == NULL)
948 stderr = initial_stderr_stream;
949 initial_stderr_stream = NULL;
950 report_file_error ("Cannot open debugging output stream",
951 Fcons (file, Qnil));
954 return Qnil;
956 #endif /* GNU_LINUX */
959 /* This is the interface for debugging printing. */
961 void
962 debug_print (arg)
963 Lisp_Object arg;
965 Fprin1 (arg, Qexternal_debugging_output);
966 fprintf (stderr, "\r\n");
969 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
970 1, 1, 0,
971 doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
972 See Info anchor `(elisp)Definition of signal' for some details on how this
973 error message is constructed. */)
974 (obj)
975 Lisp_Object obj;
977 struct buffer *old = current_buffer;
978 Lisp_Object value;
979 struct gcpro gcpro1;
981 /* If OBJ is (error STRING), just return STRING.
982 That is not only faster, it also avoids the need to allocate
983 space here when the error is due to memory full. */
984 if (CONSP (obj) && EQ (XCAR (obj), Qerror)
985 && CONSP (XCDR (obj))
986 && STRINGP (XCAR (XCDR (obj)))
987 && NILP (XCDR (XCDR (obj))))
988 return XCAR (XCDR (obj));
990 print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
992 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
993 value = Fbuffer_string ();
995 GCPRO1 (value);
996 Ferase_buffer ();
997 set_buffer_internal (old);
998 UNGCPRO;
1000 return value;
1003 /* Print an error message for the error DATA onto Lisp output stream
1004 STREAM (suitable for the print functions). */
1006 void
1007 print_error_message (data, stream, context, caller)
1008 Lisp_Object data, stream;
1009 char *context;
1010 Lisp_Object caller;
1012 Lisp_Object errname, errmsg, file_error, tail;
1013 struct gcpro gcpro1;
1014 int i;
1016 if (context != 0)
1017 write_string_1 (context, -1, stream);
1019 /* If we know from where the error was signaled, show it in
1020 *Messages*. */
1021 if (!NILP (caller) && SYMBOLP (caller))
1023 const char *name = SDATA (SYMBOL_NAME (caller));
1024 message_dolog (name, strlen (name), 0, 0);
1025 message_dolog (": ", 2, 0, 0);
1028 errname = Fcar (data);
1030 if (EQ (errname, Qerror))
1032 data = Fcdr (data);
1033 if (!CONSP (data))
1034 data = Qnil;
1035 errmsg = Fcar (data);
1036 file_error = Qnil;
1038 else
1040 Lisp_Object error_conditions;
1041 errmsg = Fget (errname, Qerror_message);
1042 error_conditions = Fget (errname, Qerror_conditions);
1043 file_error = Fmemq (Qfile_error, error_conditions);
1046 /* Print an error message including the data items. */
1048 tail = Fcdr_safe (data);
1049 GCPRO1 (tail);
1051 /* For file-error, make error message by concatenating
1052 all the data items. They are all strings. */
1053 if (!NILP (file_error) && CONSP (tail))
1054 errmsg = XCAR (tail), tail = XCDR (tail);
1056 if (STRINGP (errmsg))
1057 Fprinc (errmsg, stream);
1058 else
1059 write_string_1 ("peculiar error", -1, stream);
1061 for (i = 0; CONSP (tail); tail = XCDR (tail), i++)
1063 Lisp_Object obj;
1065 write_string_1 (i ? ", " : ": ", 2, stream);
1066 obj = XCAR (tail);
1067 if (!NILP (file_error) || EQ (errname, Qend_of_file))
1068 Fprinc (obj, stream);
1069 else
1070 Fprin1 (obj, stream);
1073 UNGCPRO;
1079 * The buffer should be at least as large as the max string size of the
1080 * largest float, printed in the biggest notation. This is undoubtedly
1081 * 20d float_output_format, with the negative of the C-constant "HUGE"
1082 * from <math.h>.
1084 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1086 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1087 * case of -1e307 in 20d float_output_format. What is one to do (short of
1088 * re-writing _doprnt to be more sane)?
1089 * -wsr
1092 void
1093 float_to_string (buf, data)
1094 unsigned char *buf;
1095 double data;
1097 unsigned char *cp;
1098 int width;
1100 /* Check for plus infinity in a way that won't lose
1101 if there is no plus infinity. */
1102 if (data == data / 2 && data > 1.0)
1104 strcpy (buf, "1.0e+INF");
1105 return;
1107 /* Likewise for minus infinity. */
1108 if (data == data / 2 && data < -1.0)
1110 strcpy (buf, "-1.0e+INF");
1111 return;
1113 /* Check for NaN in a way that won't fail if there are no NaNs. */
1114 if (! (data * 0.0 >= 0.0))
1116 /* Prepend "-" if the NaN's sign bit is negative.
1117 The sign bit of a double is the bit that is 1 in -0.0. */
1118 int i;
1119 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
1120 u_data.d = data;
1121 u_minus_zero.d = - 0.0;
1122 for (i = 0; i < sizeof (double); i++)
1123 if (u_data.c[i] & u_minus_zero.c[i])
1125 *buf++ = '-';
1126 break;
1129 strcpy (buf, "0.0e+NaN");
1130 return;
1133 if (NILP (Vfloat_output_format)
1134 || !STRINGP (Vfloat_output_format))
1135 lose:
1137 /* Generate the fewest number of digits that represent the
1138 floating point value without losing information.
1139 The following method is simple but a bit slow.
1140 For ideas about speeding things up, please see:
1142 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1143 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1145 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1146 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1148 width = fabs (data) < DBL_MIN ? 1 : DBL_DIG;
1150 sprintf (buf, "%.*g", width, data);
1151 while (width++ < DOUBLE_DIGITS_BOUND && atof (buf) != data);
1153 else /* oink oink */
1155 /* Check that the spec we have is fully valid.
1156 This means not only valid for printf,
1157 but meant for floats, and reasonable. */
1158 cp = SDATA (Vfloat_output_format);
1160 if (cp[0] != '%')
1161 goto lose;
1162 if (cp[1] != '.')
1163 goto lose;
1165 cp += 2;
1167 /* Check the width specification. */
1168 width = -1;
1169 if ('0' <= *cp && *cp <= '9')
1171 width = 0;
1173 width = (width * 10) + (*cp++ - '0');
1174 while (*cp >= '0' && *cp <= '9');
1176 /* A precision of zero is valid only for %f. */
1177 if (width > DBL_DIG
1178 || (width == 0 && *cp != 'f'))
1179 goto lose;
1182 if (*cp != 'e' && *cp != 'f' && *cp != 'g')
1183 goto lose;
1185 if (cp[1] != 0)
1186 goto lose;
1188 sprintf (buf, SDATA (Vfloat_output_format), data);
1191 /* Make sure there is a decimal point with digit after, or an
1192 exponent, so that the value is readable as a float. But don't do
1193 this with "%.0f"; it's valid for that not to produce a decimal
1194 point. Note that width can be 0 only for %.0f. */
1195 if (width != 0)
1197 for (cp = buf; *cp; cp++)
1198 if ((*cp < '0' || *cp > '9') && *cp != '-')
1199 break;
1201 if (*cp == '.' && cp[1] == 0)
1203 cp[1] = '0';
1204 cp[2] = 0;
1207 if (*cp == 0)
1209 *cp++ = '.';
1210 *cp++ = '0';
1211 *cp++ = 0;
1217 static void
1218 print (obj, printcharfun, escapeflag)
1219 Lisp_Object obj;
1220 register Lisp_Object printcharfun;
1221 int escapeflag;
1223 old_backquote_output = 0;
1225 /* Reset print_number_index and Vprint_number_table only when
1226 the variable Vprint_continuous_numbering is nil. Otherwise,
1227 the values of these variables will be kept between several
1228 print functions. */
1229 if (NILP (Vprint_continuous_numbering))
1231 print_number_index = 0;
1232 Vprint_number_table = Qnil;
1235 /* Construct Vprint_number_table for print-gensym and print-circle. */
1236 if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
1238 int i, start, index;
1239 start = index = print_number_index;
1240 /* Construct Vprint_number_table.
1241 This increments print_number_index for the objects added. */
1242 print_depth = 0;
1243 print_preprocess (obj);
1245 /* Remove unnecessary objects, which appear only once in OBJ;
1246 that is, whose status is Qnil. Compactify the necessary objects. */
1247 for (i = start; i < print_number_index; i++)
1248 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1250 PRINT_NUMBER_OBJECT (Vprint_number_table, index)
1251 = PRINT_NUMBER_OBJECT (Vprint_number_table, i);
1252 index++;
1255 /* Clear out objects outside the active part of the table. */
1256 for (i = index; i < print_number_index; i++)
1257 PRINT_NUMBER_OBJECT (Vprint_number_table, i) = Qnil;
1259 /* Reset the status field for the next print step. Now this
1260 field means whether the object has already been printed. */
1261 for (i = start; i < print_number_index; i++)
1262 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qnil;
1264 print_number_index = index;
1267 print_depth = 0;
1268 print_object (obj, printcharfun, escapeflag);
1271 /* Construct Vprint_number_table according to the structure of OBJ.
1272 OBJ itself and all its elements will be added to Vprint_number_table
1273 recursively if it is a list, vector, compiled function, char-table,
1274 string (its text properties will be traced), or a symbol that has
1275 no obarray (this is for the print-gensym feature).
1276 The status fields of Vprint_number_table mean whether each object appears
1277 more than once in OBJ: Qnil at the first time, and Qt after that . */
1278 static void
1279 print_preprocess (obj)
1280 Lisp_Object obj;
1282 int i;
1283 EMACS_INT size;
1284 int loop_count = 0;
1285 Lisp_Object halftail;
1287 /* Give up if we go so deep that print_object will get an error. */
1288 /* See similar code in print_object. */
1289 if (print_depth >= PRINT_CIRCLE)
1290 return;
1292 /* Avoid infinite recursion for circular nested structure
1293 in the case where Vprint_circle is nil. */
1294 if (NILP (Vprint_circle))
1296 for (i = 0; i < print_depth; i++)
1297 if (EQ (obj, being_printed[i]))
1298 return;
1299 being_printed[print_depth] = obj;
1302 print_depth++;
1303 halftail = obj;
1305 loop:
1306 if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
1307 || COMPILEDP (obj) || CHAR_TABLE_P (obj)
1308 || (! NILP (Vprint_gensym)
1309 && SYMBOLP (obj)
1310 && !SYMBOL_INTERNED_P (obj)))
1312 /* In case print-circle is nil and print-gensym is t,
1313 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1314 if (! NILP (Vprint_circle) || SYMBOLP (obj))
1316 for (i = 0; i < print_number_index; i++)
1317 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
1319 /* OBJ appears more than once. Let's remember that. */
1320 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
1321 return;
1324 /* OBJ is not yet recorded. Let's add to the table. */
1325 if (print_number_index == 0)
1327 /* Initialize the table. */
1328 Vprint_number_table = Fmake_vector (make_number (40), Qnil);
1330 else if (XVECTOR (Vprint_number_table)->size == print_number_index * 2)
1332 /* Reallocate the table. */
1333 int i = print_number_index * 4;
1334 Lisp_Object old_table = Vprint_number_table;
1335 Vprint_number_table = Fmake_vector (make_number (i), Qnil);
1336 for (i = 0; i < print_number_index; i++)
1338 PRINT_NUMBER_OBJECT (Vprint_number_table, i)
1339 = PRINT_NUMBER_OBJECT (old_table, i);
1340 PRINT_NUMBER_STATUS (Vprint_number_table, i)
1341 = PRINT_NUMBER_STATUS (old_table, i);
1344 PRINT_NUMBER_OBJECT (Vprint_number_table, print_number_index) = obj;
1345 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1346 always print the gensym with a number. This is a special for
1347 the lisp function byte-compile-output-docform. */
1348 if (!NILP (Vprint_continuous_numbering)
1349 && SYMBOLP (obj)
1350 && !SYMBOL_INTERNED_P (obj))
1351 PRINT_NUMBER_STATUS (Vprint_number_table, print_number_index) = Qt;
1352 print_number_index++;
1355 switch (XGCTYPE (obj))
1357 case Lisp_String:
1358 /* A string may have text properties, which can be circular. */
1359 traverse_intervals_noorder (STRING_INTERVALS (obj),
1360 print_preprocess_string, Qnil);
1361 break;
1363 case Lisp_Cons:
1364 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1365 just as in print_object. */
1366 if (loop_count && EQ (obj, halftail))
1367 break;
1368 print_preprocess (XCAR (obj));
1369 obj = XCDR (obj);
1370 loop_count++;
1371 if (!(loop_count & 1))
1372 halftail = XCDR (halftail);
1373 goto loop;
1375 case Lisp_Vectorlike:
1376 size = XVECTOR (obj)->size;
1377 if (size & PSEUDOVECTOR_FLAG)
1378 size &= PSEUDOVECTOR_SIZE_MASK;
1379 for (i = 0; i < size; i++)
1380 print_preprocess (XVECTOR (obj)->contents[i]);
1381 break;
1383 default:
1384 break;
1387 print_depth--;
1390 static void
1391 print_preprocess_string (interval, arg)
1392 INTERVAL interval;
1393 Lisp_Object arg;
1395 print_preprocess (interval->plist);
1398 static void
1399 print_object (obj, printcharfun, escapeflag)
1400 Lisp_Object obj;
1401 register Lisp_Object printcharfun;
1402 int escapeflag;
1404 char buf[40];
1406 QUIT;
1408 /* Detect circularities and truncate them. */
1409 if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
1410 || COMPILEDP (obj) || CHAR_TABLE_P (obj)
1411 || (! NILP (Vprint_gensym)
1412 && SYMBOLP (obj)
1413 && !SYMBOL_INTERNED_P (obj)))
1415 if (NILP (Vprint_circle) && NILP (Vprint_gensym))
1417 /* Simple but incomplete way. */
1418 int i;
1419 for (i = 0; i < print_depth; i++)
1420 if (EQ (obj, being_printed[i]))
1422 sprintf (buf, "#%d", i);
1423 strout (buf, -1, -1, printcharfun, 0);
1424 return;
1426 being_printed[print_depth] = obj;
1428 else
1430 /* With the print-circle feature. */
1431 int i;
1432 for (i = 0; i < print_number_index; i++)
1433 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
1435 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1437 /* Add a prefix #n= if OBJ has not yet been printed;
1438 that is, its status field is nil. */
1439 sprintf (buf, "#%d=", i + 1);
1440 strout (buf, -1, -1, printcharfun, 0);
1441 /* OBJ is going to be printed. Set the status to t. */
1442 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
1443 break;
1445 else
1447 /* Just print #n# if OBJ has already been printed. */
1448 sprintf (buf, "#%d#", i + 1);
1449 strout (buf, -1, -1, printcharfun, 0);
1450 return;
1456 print_depth++;
1458 /* See similar code in print_preprocess. */
1459 if (print_depth > PRINT_CIRCLE)
1460 error ("Apparently circular structure being printed");
1461 #ifdef MAX_PRINT_CHARS
1462 if (max_print && print_chars > max_print)
1464 PRINTCHAR ('\n');
1465 print_chars = 0;
1467 #endif /* MAX_PRINT_CHARS */
1469 switch (XGCTYPE (obj))
1471 case Lisp_Int:
1472 if (sizeof (int) == sizeof (EMACS_INT))
1473 sprintf (buf, "%d", XINT (obj));
1474 else if (sizeof (long) == sizeof (EMACS_INT))
1475 sprintf (buf, "%ld", (long) XINT (obj));
1476 else
1477 abort ();
1478 strout (buf, -1, -1, printcharfun, 0);
1479 break;
1481 case Lisp_Float:
1483 char pigbuf[350]; /* see comments in float_to_string */
1485 float_to_string (pigbuf, XFLOAT_DATA (obj));
1486 strout (pigbuf, -1, -1, printcharfun, 0);
1488 break;
1490 case Lisp_String:
1491 if (!escapeflag)
1492 print_string (obj, printcharfun);
1493 else
1495 register int i, i_byte;
1496 struct gcpro gcpro1;
1497 unsigned char *str;
1498 int size_byte;
1499 /* 1 means we must ensure that the next character we output
1500 cannot be taken as part of a hex character escape. */
1501 int need_nonhex = 0;
1502 int multibyte = STRING_MULTIBYTE (obj);
1504 GCPRO1 (obj);
1506 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1508 PRINTCHAR ('#');
1509 PRINTCHAR ('(');
1512 PRINTCHAR ('\"');
1513 str = SDATA (obj);
1514 size_byte = SBYTES (obj);
1516 for (i = 0, i_byte = 0; i_byte < size_byte;)
1518 /* Here, we must convert each multi-byte form to the
1519 corresponding character code before handing it to PRINTCHAR. */
1520 int len;
1521 int c;
1523 if (multibyte)
1525 c = STRING_CHAR_AND_LENGTH (str + i_byte,
1526 size_byte - i_byte, len);
1527 if (CHAR_VALID_P (c, 0))
1528 i_byte += len;
1529 else
1530 c = str[i_byte++];
1532 else
1533 c = str[i_byte++];
1535 QUIT;
1537 if (c == '\n' && print_escape_newlines)
1539 PRINTCHAR ('\\');
1540 PRINTCHAR ('n');
1542 else if (c == '\f' && print_escape_newlines)
1544 PRINTCHAR ('\\');
1545 PRINTCHAR ('f');
1547 else if (multibyte
1548 && ! ASCII_BYTE_P (c)
1549 && (SINGLE_BYTE_CHAR_P (c) || print_escape_multibyte))
1551 /* When multibyte is disabled,
1552 print multibyte string chars using hex escapes.
1553 For a char code that could be in a unibyte string,
1554 when found in a multibyte string, always use a hex escape
1555 so it reads back as multibyte. */
1556 unsigned char outbuf[50];
1557 sprintf (outbuf, "\\x%x", c);
1558 strout (outbuf, -1, -1, printcharfun, 0);
1559 need_nonhex = 1;
1561 else if (! multibyte
1562 && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
1563 && print_escape_nonascii)
1565 /* When printing in a multibyte buffer
1566 or when explicitly requested,
1567 print single-byte non-ASCII string chars
1568 using octal escapes. */
1569 unsigned char outbuf[5];
1570 sprintf (outbuf, "\\%03o", c);
1571 strout (outbuf, -1, -1, printcharfun, 0);
1573 else
1575 /* If we just had a hex escape, and this character
1576 could be taken as part of it,
1577 output `\ ' to prevent that. */
1578 if (need_nonhex)
1580 need_nonhex = 0;
1581 if ((c >= 'a' && c <= 'f')
1582 || (c >= 'A' && c <= 'F')
1583 || (c >= '0' && c <= '9'))
1584 strout ("\\ ", -1, -1, printcharfun, 0);
1587 if (c == '\"' || c == '\\')
1588 PRINTCHAR ('\\');
1589 PRINTCHAR (c);
1592 PRINTCHAR ('\"');
1594 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1596 traverse_intervals (STRING_INTERVALS (obj),
1597 0, print_interval, printcharfun);
1598 PRINTCHAR (')');
1601 UNGCPRO;
1603 break;
1605 case Lisp_Symbol:
1607 register int confusing;
1608 register unsigned char *p = SDATA (SYMBOL_NAME (obj));
1609 register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
1610 register int c;
1611 int i, i_byte, size_byte;
1612 Lisp_Object name;
1614 name = SYMBOL_NAME (obj);
1616 if (p != end && (*p == '-' || *p == '+')) p++;
1617 if (p == end)
1618 confusing = 0;
1619 /* If symbol name begins with a digit, and ends with a digit,
1620 and contains nothing but digits and `e', it could be treated
1621 as a number. So set CONFUSING.
1623 Symbols that contain periods could also be taken as numbers,
1624 but periods are always escaped, so we don't have to worry
1625 about them here. */
1626 else if (*p >= '0' && *p <= '9'
1627 && end[-1] >= '0' && end[-1] <= '9')
1629 while (p != end && ((*p >= '0' && *p <= '9')
1630 /* Needed for \2e10. */
1631 || *p == 'e'))
1632 p++;
1633 confusing = (end == p);
1635 else
1636 confusing = 0;
1638 if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj))
1640 PRINTCHAR ('#');
1641 PRINTCHAR (':');
1644 size_byte = SBYTES (name);
1646 for (i = 0, i_byte = 0; i_byte < size_byte;)
1648 /* Here, we must convert each multi-byte form to the
1649 corresponding character code before handing it to PRINTCHAR. */
1650 FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
1651 QUIT;
1653 if (escapeflag)
1655 if (c == '\"' || c == '\\' || c == '\''
1656 || c == ';' || c == '#' || c == '(' || c == ')'
1657 || c == ',' || c =='.' || c == '`'
1658 || c == '[' || c == ']' || c == '?' || c <= 040
1659 || confusing)
1660 PRINTCHAR ('\\'), confusing = 0;
1662 PRINTCHAR (c);
1665 break;
1667 case Lisp_Cons:
1668 /* If deeper than spec'd depth, print placeholder. */
1669 if (INTEGERP (Vprint_level)
1670 && print_depth > XINT (Vprint_level))
1671 strout ("...", -1, -1, printcharfun, 0);
1672 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1673 && (EQ (XCAR (obj), Qquote)))
1675 PRINTCHAR ('\'');
1676 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1678 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1679 && (EQ (XCAR (obj), Qfunction)))
1681 PRINTCHAR ('#');
1682 PRINTCHAR ('\'');
1683 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1685 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1686 && ! old_backquote_output
1687 && ((EQ (XCAR (obj), Qbackquote)
1688 || EQ (XCAR (obj), Qcomma)
1689 || EQ (XCAR (obj), Qcomma_at)
1690 || EQ (XCAR (obj), Qcomma_dot))))
1692 print_object (XCAR (obj), printcharfun, 0);
1693 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1695 else
1697 PRINTCHAR ('(');
1699 /* If the first element is a backquote form,
1700 print it old-style so it won't be misunderstood. */
1701 if (print_quoted && CONSP (XCAR (obj))
1702 && CONSP (XCDR (XCAR (obj)))
1703 && NILP (XCDR (XCDR (XCAR (obj))))
1704 && EQ (XCAR (XCAR (obj)), Qbackquote))
1706 Lisp_Object tem;
1707 tem = XCAR (obj);
1708 PRINTCHAR ('(');
1710 print_object (Qbackquote, printcharfun, 0);
1711 PRINTCHAR (' ');
1713 ++old_backquote_output;
1714 print_object (XCAR (XCDR (tem)), printcharfun, 0);
1715 --old_backquote_output;
1716 PRINTCHAR (')');
1718 obj = XCDR (obj);
1722 int print_length, i;
1723 Lisp_Object halftail = obj;
1725 /* Negative values of print-length are invalid in CL.
1726 Treat them like nil, as CMUCL does. */
1727 if (NATNUMP (Vprint_length))
1728 print_length = XFASTINT (Vprint_length);
1729 else
1730 print_length = 0;
1732 i = 0;
1733 while (CONSP (obj))
1735 /* Detect circular list. */
1736 if (NILP (Vprint_circle))
1738 /* Simple but imcomplete way. */
1739 if (i != 0 && EQ (obj, halftail))
1741 sprintf (buf, " . #%d", i / 2);
1742 strout (buf, -1, -1, printcharfun, 0);
1743 goto end_of_list;
1746 else
1748 /* With the print-circle feature. */
1749 if (i != 0)
1751 int i;
1752 for (i = 0; i < print_number_index; i++)
1753 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i),
1754 obj))
1756 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1758 strout (" . ", 3, 3, printcharfun, 0);
1759 print_object (obj, printcharfun, escapeflag);
1761 else
1763 sprintf (buf, " . #%d#", i + 1);
1764 strout (buf, -1, -1, printcharfun, 0);
1766 goto end_of_list;
1771 if (i++)
1772 PRINTCHAR (' ');
1774 if (print_length && i > print_length)
1776 strout ("...", 3, 3, printcharfun, 0);
1777 goto end_of_list;
1780 print_object (XCAR (obj), printcharfun, escapeflag);
1782 obj = XCDR (obj);
1783 if (!(i & 1))
1784 halftail = XCDR (halftail);
1788 /* OBJ non-nil here means it's the end of a dotted list. */
1789 if (!NILP (obj))
1791 strout (" . ", 3, 3, printcharfun, 0);
1792 print_object (obj, printcharfun, escapeflag);
1795 end_of_list:
1796 PRINTCHAR (')');
1798 break;
1800 case Lisp_Vectorlike:
1801 if (PROCESSP (obj))
1803 if (escapeflag)
1805 strout ("#<process ", -1, -1, printcharfun, 0);
1806 print_string (XPROCESS (obj)->name, printcharfun);
1807 PRINTCHAR ('>');
1809 else
1810 print_string (XPROCESS (obj)->name, printcharfun);
1812 else if (BOOL_VECTOR_P (obj))
1814 register int i;
1815 register unsigned char c;
1816 struct gcpro gcpro1;
1817 int size_in_chars
1818 = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
1819 / BOOL_VECTOR_BITS_PER_CHAR);
1821 GCPRO1 (obj);
1823 PRINTCHAR ('#');
1824 PRINTCHAR ('&');
1825 sprintf (buf, "%ld", (long) XBOOL_VECTOR (obj)->size);
1826 strout (buf, -1, -1, printcharfun, 0);
1827 PRINTCHAR ('\"');
1829 /* Don't print more characters than the specified maximum.
1830 Negative values of print-length are invalid. Treat them
1831 like a print-length of nil. */
1832 if (NATNUMP (Vprint_length)
1833 && XFASTINT (Vprint_length) < size_in_chars)
1834 size_in_chars = XFASTINT (Vprint_length);
1836 for (i = 0; i < size_in_chars; i++)
1838 QUIT;
1839 c = XBOOL_VECTOR (obj)->data[i];
1840 if (c == '\n' && print_escape_newlines)
1842 PRINTCHAR ('\\');
1843 PRINTCHAR ('n');
1845 else if (c == '\f' && print_escape_newlines)
1847 PRINTCHAR ('\\');
1848 PRINTCHAR ('f');
1850 else if (c > '\177')
1852 /* Use octal escapes to avoid encoding issues. */
1853 PRINTCHAR ('\\');
1854 PRINTCHAR ('0' + ((c >> 6) & 3));
1855 PRINTCHAR ('0' + ((c >> 3) & 7));
1856 PRINTCHAR ('0' + (c & 7));
1858 else
1860 if (c == '\"' || c == '\\')
1861 PRINTCHAR ('\\');
1862 PRINTCHAR (c);
1865 PRINTCHAR ('\"');
1867 UNGCPRO;
1869 else if (SUBRP (obj))
1871 strout ("#<subr ", -1, -1, printcharfun, 0);
1872 strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun, 0);
1873 PRINTCHAR ('>');
1875 else if (WINDOWP (obj))
1877 strout ("#<window ", -1, -1, printcharfun, 0);
1878 sprintf (buf, "%ld", (long) XFASTINT (XWINDOW (obj)->sequence_number));
1879 strout (buf, -1, -1, printcharfun, 0);
1880 if (!NILP (XWINDOW (obj)->buffer))
1882 strout (" on ", -1, -1, printcharfun, 0);
1883 print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun);
1885 PRINTCHAR ('>');
1887 else if (HASH_TABLE_P (obj))
1889 struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
1890 strout ("#<hash-table", -1, -1, printcharfun, 0);
1891 if (SYMBOLP (h->test))
1893 PRINTCHAR (' ');
1894 PRINTCHAR ('\'');
1895 strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun, 0);
1896 PRINTCHAR (' ');
1897 strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0);
1898 PRINTCHAR (' ');
1899 sprintf (buf, "%ld/%ld", (long) XFASTINT (h->count),
1900 (long) XVECTOR (h->next)->size);
1901 strout (buf, -1, -1, printcharfun, 0);
1903 sprintf (buf, " 0x%lx", (unsigned long) h);
1904 strout (buf, -1, -1, printcharfun, 0);
1905 PRINTCHAR ('>');
1907 else if (BUFFERP (obj))
1909 if (NILP (XBUFFER (obj)->name))
1910 strout ("#<killed buffer>", -1, -1, printcharfun, 0);
1911 else if (escapeflag)
1913 strout ("#<buffer ", -1, -1, printcharfun, 0);
1914 print_string (XBUFFER (obj)->name, printcharfun);
1915 PRINTCHAR ('>');
1917 else
1918 print_string (XBUFFER (obj)->name, printcharfun);
1920 else if (WINDOW_CONFIGURATIONP (obj))
1922 strout ("#<window-configuration>", -1, -1, printcharfun, 0);
1924 else if (FRAMEP (obj))
1926 strout ((FRAME_LIVE_P (XFRAME (obj))
1927 ? "#<frame " : "#<dead frame "),
1928 -1, -1, printcharfun, 0);
1929 print_string (XFRAME (obj)->name, printcharfun);
1930 sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj)));
1931 strout (buf, -1, -1, printcharfun, 0);
1932 PRINTCHAR ('>');
1934 else
1936 EMACS_INT size = XVECTOR (obj)->size;
1937 if (COMPILEDP (obj))
1939 PRINTCHAR ('#');
1940 size &= PSEUDOVECTOR_SIZE_MASK;
1942 if (CHAR_TABLE_P (obj))
1944 /* We print a char-table as if it were a vector,
1945 lumping the parent and default slots in with the
1946 character slots. But we add #^ as a prefix. */
1947 PRINTCHAR ('#');
1948 PRINTCHAR ('^');
1949 if (SUB_CHAR_TABLE_P (obj))
1950 PRINTCHAR ('^');
1951 size &= PSEUDOVECTOR_SIZE_MASK;
1953 if (size & PSEUDOVECTOR_FLAG)
1954 goto badtype;
1956 PRINTCHAR ('[');
1958 register int i;
1959 register Lisp_Object tem;
1960 int real_size = size;
1962 /* Don't print more elements than the specified maximum. */
1963 if (NATNUMP (Vprint_length)
1964 && XFASTINT (Vprint_length) < size)
1965 size = XFASTINT (Vprint_length);
1967 for (i = 0; i < size; i++)
1969 if (i) PRINTCHAR (' ');
1970 tem = XVECTOR (obj)->contents[i];
1971 print_object (tem, printcharfun, escapeflag);
1973 if (size < real_size)
1974 strout (" ...", 4, 4, printcharfun, 0);
1976 PRINTCHAR (']');
1978 break;
1980 case Lisp_Misc:
1981 switch (XMISCTYPE (obj))
1983 case Lisp_Misc_Marker:
1984 strout ("#<marker ", -1, -1, printcharfun, 0);
1985 /* Do you think this is necessary? */
1986 if (XMARKER (obj)->insertion_type != 0)
1987 strout ("(moves after insertion) ", -1, -1, printcharfun, 0);
1988 if (!(XMARKER (obj)->buffer))
1989 strout ("in no buffer", -1, -1, printcharfun, 0);
1990 else
1992 sprintf (buf, "at %d", marker_position (obj));
1993 strout (buf, -1, -1, printcharfun, 0);
1994 strout (" in ", -1, -1, printcharfun, 0);
1995 print_string (XMARKER (obj)->buffer->name, printcharfun);
1997 PRINTCHAR ('>');
1998 break;
2000 case Lisp_Misc_Overlay:
2001 strout ("#<overlay ", -1, -1, printcharfun, 0);
2002 if (!(XMARKER (OVERLAY_START (obj))->buffer))
2003 strout ("in no buffer", -1, -1, printcharfun, 0);
2004 else
2006 sprintf (buf, "from %d to %d in ",
2007 marker_position (OVERLAY_START (obj)),
2008 marker_position (OVERLAY_END (obj)));
2009 strout (buf, -1, -1, printcharfun, 0);
2010 print_string (XMARKER (OVERLAY_START (obj))->buffer->name,
2011 printcharfun);
2013 PRINTCHAR ('>');
2014 break;
2016 /* Remaining cases shouldn't happen in normal usage, but let's print
2017 them anyway for the benefit of the debugger. */
2018 case Lisp_Misc_Free:
2019 strout ("#<misc free cell>", -1, -1, printcharfun, 0);
2020 break;
2022 case Lisp_Misc_Intfwd:
2023 sprintf (buf, "#<intfwd to %ld>", (long) *XINTFWD (obj)->intvar);
2024 strout (buf, -1, -1, printcharfun, 0);
2025 break;
2027 case Lisp_Misc_Boolfwd:
2028 sprintf (buf, "#<boolfwd to %s>",
2029 (*XBOOLFWD (obj)->boolvar ? "t" : "nil"));
2030 strout (buf, -1, -1, printcharfun, 0);
2031 break;
2033 case Lisp_Misc_Objfwd:
2034 strout ("#<objfwd to ", -1, -1, printcharfun, 0);
2035 print_object (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
2036 PRINTCHAR ('>');
2037 break;
2039 case Lisp_Misc_Buffer_Objfwd:
2040 strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
2041 print_object (PER_BUFFER_VALUE (current_buffer,
2042 XBUFFER_OBJFWD (obj)->offset),
2043 printcharfun, escapeflag);
2044 PRINTCHAR ('>');
2045 break;
2047 case Lisp_Misc_Kboard_Objfwd:
2048 strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
2049 print_object (*(Lisp_Object *)((char *) current_kboard
2050 + XKBOARD_OBJFWD (obj)->offset),
2051 printcharfun, escapeflag);
2052 PRINTCHAR ('>');
2053 break;
2055 case Lisp_Misc_Buffer_Local_Value:
2056 strout ("#<buffer_local_value ", -1, -1, printcharfun, 0);
2057 goto do_buffer_local;
2058 case Lisp_Misc_Some_Buffer_Local_Value:
2059 strout ("#<some_buffer_local_value ", -1, -1, printcharfun, 0);
2060 do_buffer_local:
2061 strout ("[realvalue] ", -1, -1, printcharfun, 0);
2062 print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue,
2063 printcharfun, escapeflag);
2064 if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer)
2065 strout ("[local in buffer] ", -1, -1, printcharfun, 0);
2066 else
2067 strout ("[buffer] ", -1, -1, printcharfun, 0);
2068 print_object (XBUFFER_LOCAL_VALUE (obj)->buffer,
2069 printcharfun, escapeflag);
2070 if (XBUFFER_LOCAL_VALUE (obj)->check_frame)
2072 if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame)
2073 strout ("[local in frame] ", -1, -1, printcharfun, 0);
2074 else
2075 strout ("[frame] ", -1, -1, printcharfun, 0);
2076 print_object (XBUFFER_LOCAL_VALUE (obj)->frame,
2077 printcharfun, escapeflag);
2079 strout ("[alist-elt] ", -1, -1, printcharfun, 0);
2080 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj)->cdr),
2081 printcharfun, escapeflag);
2082 strout ("[default-value] ", -1, -1, printcharfun, 0);
2083 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj)->cdr),
2084 printcharfun, escapeflag);
2085 PRINTCHAR ('>');
2086 break;
2088 case Lisp_Misc_Save_Value:
2089 strout ("#<save_value ", -1, -1, printcharfun, 0);
2090 sprintf(buf, "ptr=0x%08lx int=%d",
2091 (unsigned long) XSAVE_VALUE (obj)->pointer,
2092 XSAVE_VALUE (obj)->integer);
2093 strout (buf, -1, -1, printcharfun, 0);
2094 PRINTCHAR ('>');
2095 break;
2097 default:
2098 goto badtype;
2100 break;
2102 default:
2103 badtype:
2105 /* We're in trouble if this happens!
2106 Probably should just abort () */
2107 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun, 0);
2108 if (MISCP (obj))
2109 sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
2110 else if (VECTORLIKEP (obj))
2111 sprintf (buf, "(PVEC 0x%08x)", (int) XVECTOR (obj)->size);
2112 else
2113 sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
2114 strout (buf, -1, -1, printcharfun, 0);
2115 strout (" Save your buffers immediately and please report this bug>",
2116 -1, -1, printcharfun, 0);
2120 print_depth--;
2124 /* Print a description of INTERVAL using PRINTCHARFUN.
2125 This is part of printing a string that has text properties. */
2127 void
2128 print_interval (interval, printcharfun)
2129 INTERVAL interval;
2130 Lisp_Object printcharfun;
2132 PRINTCHAR (' ');
2133 print_object (make_number (interval->position), printcharfun, 1);
2134 PRINTCHAR (' ');
2135 print_object (make_number (interval->position + LENGTH (interval)),
2136 printcharfun, 1);
2137 PRINTCHAR (' ');
2138 print_object (interval->plist, printcharfun, 1);
2142 void
2143 syms_of_print ()
2145 Qtemp_buffer_setup_hook = intern ("temp-buffer-setup-hook");
2146 staticpro (&Qtemp_buffer_setup_hook);
2148 DEFVAR_LISP ("standard-output", &Vstandard_output,
2149 doc: /* Output stream `print' uses by default for outputting a character.
2150 This may be any function of one argument.
2151 It may also be a buffer (output is inserted before point)
2152 or a marker (output is inserted and the marker is advanced)
2153 or the symbol t (output appears in the echo area). */);
2154 Vstandard_output = Qt;
2155 Qstandard_output = intern ("standard-output");
2156 staticpro (&Qstandard_output);
2158 DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
2159 doc: /* The format descriptor string used to print floats.
2160 This is a %-spec like those accepted by `printf' in C,
2161 but with some restrictions. It must start with the two characters `%.'.
2162 After that comes an integer precision specification,
2163 and then a letter which controls the format.
2164 The letters allowed are `e', `f' and `g'.
2165 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2166 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2167 Use `g' to choose the shorter of those two formats for the number at hand.
2168 The precision in any of these cases is the number of digits following
2169 the decimal point. With `f', a precision of 0 means to omit the
2170 decimal point. 0 is not allowed with `e' or `g'.
2172 A value of nil means to use the shortest notation
2173 that represents the number without losing information. */);
2174 Vfloat_output_format = Qnil;
2175 Qfloat_output_format = intern ("float-output-format");
2176 staticpro (&Qfloat_output_format);
2178 DEFVAR_LISP ("print-length", &Vprint_length,
2179 doc: /* Maximum length of list to print before abbreviating.
2180 A value of nil means no limit. See also `eval-expression-print-length'. */);
2181 Vprint_length = Qnil;
2183 DEFVAR_LISP ("print-level", &Vprint_level,
2184 doc: /* Maximum depth of list nesting to print before abbreviating.
2185 A value of nil means no limit. See also `eval-expression-print-level'. */);
2186 Vprint_level = Qnil;
2188 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
2189 doc: /* Non-nil means print newlines in strings as `\\n'.
2190 Also print formfeeds as `\\f'. */);
2191 print_escape_newlines = 0;
2193 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii,
2194 doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2195 \(OOO is the octal representation of the character code.)
2196 Only single-byte characters are affected, and only in `prin1'.
2197 When the output goes in a multibyte buffer, this feature is
2198 enabled regardless of the value of the variable. */);
2199 print_escape_nonascii = 0;
2201 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte,
2202 doc: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2203 \(XXXX is the hex representation of the character code.)
2204 This affects only `prin1'. */);
2205 print_escape_multibyte = 0;
2207 DEFVAR_BOOL ("print-quoted", &print_quoted,
2208 doc: /* Non-nil means print quoted forms with reader syntax.
2209 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2210 forms print as in the new syntax. */);
2211 print_quoted = 0;
2213 DEFVAR_LISP ("print-gensym", &Vprint_gensym,
2214 doc: /* Non-nil means print uninterned symbols so they will read as uninterned.
2215 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2216 When the uninterned symbol appears within a recursive data structure,
2217 and the symbol appears more than once, in addition use the #N# and #N=
2218 constructs as needed, so that multiple references to the same symbol are
2219 shared once again when the text is read back. */);
2220 Vprint_gensym = Qnil;
2222 DEFVAR_LISP ("print-circle", &Vprint_circle,
2223 doc: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2224 If nil, printing proceeds recursively and may lead to
2225 `max-lisp-eval-depth' being exceeded or an error may occur:
2226 \"Apparently circular structure being printed.\" Also see
2227 `print-length' and `print-level'.
2228 If non-nil, shared substructures anywhere in the structure are printed
2229 with `#N=' before the first occurrence (in the order of the print
2230 representation) and `#N#' in place of each subsequent occurrence,
2231 where N is a positive decimal integer. */);
2232 Vprint_circle = Qnil;
2234 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering,
2235 doc: /* *Non-nil means number continuously across print calls.
2236 This affects the numbers printed for #N= labels and #M# references.
2237 See also `print-circle', `print-gensym', and `print-number-table'.
2238 This variable should not be set with `setq'; bind it with a `let' instead. */);
2239 Vprint_continuous_numbering = Qnil;
2241 DEFVAR_LISP ("print-number-table", &Vprint_number_table,
2242 doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
2243 The Lisp printer uses this vector to detect Lisp objects referenced more
2244 than once.
2246 When you bind `print-continuous-numbering' to t, you should probably
2247 also bind `print-number-table' to nil. This ensures that the value of
2248 `print-number-table' can be garbage-collected once the printing is
2249 done. If all elements of `print-number-table' are nil, it means that
2250 the printing done so far has not found any shared structure or objects
2251 that need to be recorded in the table. */);
2252 Vprint_number_table = Qnil;
2254 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2255 staticpro (&Vprin1_to_string_buffer);
2257 defsubr (&Sprin1);
2258 defsubr (&Sprin1_to_string);
2259 defsubr (&Serror_message_string);
2260 defsubr (&Sprinc);
2261 defsubr (&Sprint);
2262 defsubr (&Sterpri);
2263 defsubr (&Swrite_char);
2264 defsubr (&Sexternal_debugging_output);
2265 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2266 defsubr (&Sredirect_debugging_output);
2267 #endif
2269 Qexternal_debugging_output = intern ("external-debugging-output");
2270 staticpro (&Qexternal_debugging_output);
2272 Qprint_escape_newlines = intern ("print-escape-newlines");
2273 staticpro (&Qprint_escape_newlines);
2275 Qprint_escape_multibyte = intern ("print-escape-multibyte");
2276 staticpro (&Qprint_escape_multibyte);
2278 Qprint_escape_nonascii = intern ("print-escape-nonascii");
2279 staticpro (&Qprint_escape_nonascii);
2281 defsubr (&Swith_output_to_temp_buffer);
2284 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2285 (do not change this comment) */