1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 1986, 1988, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995, 1996, 2000 Ben Wing.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; 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. */
22 /* Synched up with: Not synched with FSF. */
24 /* This file has been Mule-ized. */
26 /* Seriously hacked on by Ben Wing for Mule. */
31 #include "backtrace.h"
34 #include "console-tty.h"
35 #include "console-stream.h"
42 #include "console-msw.h"
47 /* Define if not in float.h */
52 Lisp_Object Vstandard_output, Qstandard_output;
54 /* The subroutine object for external-debugging-output is kept here
55 for the convenience of the debugger. */
56 Lisp_Object Qexternal_debugging_output;
58 /* Avoid actual stack overflow in print. */
59 static int print_depth;
61 /* Detect most circularities to print finite output. */
62 #define PRINT_CIRCLE 200
63 static Lisp_Object being_printed[PRINT_CIRCLE];
65 /* Maximum length of list or vector to print in full; noninteger means
66 effectively infinity */
68 Lisp_Object Vprint_length;
69 Lisp_Object Qprint_length;
71 /* Maximum length of string to print in full; noninteger means
72 effectively infinity */
74 Lisp_Object Vprint_string_length;
75 Lisp_Object Qprint_string_length;
77 /* Maximum depth of list to print in full; noninteger means
78 effectively infinity. */
80 Lisp_Object Vprint_level;
82 /* Label to use when making echo-area messages. */
84 Lisp_Object Vprint_message_label;
86 /* Nonzero means print newlines in strings as \n. */
88 int print_escape_newlines;
91 /* Non-nil means print #: before uninterned symbols.
92 Neither t nor nil means so that and don't clear Vprint_gensym_alist
93 on entry to and exit from print functions. */
94 Lisp_Object Vprint_gensym;
95 Lisp_Object Vprint_gensym_alist;
97 Lisp_Object Qdisplay_error;
98 Lisp_Object Qprint_message_label;
100 /* Force immediate output of all printed data. Used for debugging. */
101 int print_unbuffered;
103 FILE *termscript; /* Stdio stream being used for copy of all output. */
107 int stdout_needs_newline;
110 std_handle_out_external (FILE *stream, Lisp_Object lstream,
111 const Extbyte *extptr, Extcount extlen,
112 /* is this really stdout/stderr?
113 (controls termscript writing) */
114 int output_is_std_handle,
120 /* we typically have no useful stdout/stderr under windows if we're
121 being invoked graphically. */
123 msw_output_console_string (extptr, extlen);
127 fwrite (extptr, 1, extlen, stream);
129 /* Q122442 says that pipes are "treated as files, not as
130 devices", and that this is a feature. Before I found that
131 article, I thought it was a bug. Thanks MS, I feel much
140 Lstream_write (XLSTREAM (lstream), extptr, extlen);
142 if (output_is_std_handle)
146 fwrite (extptr, 1, extlen, termscript);
149 stdout_needs_newline = (extptr[extlen - 1] != '\n');
153 /* #### The following function should be replaced a call to the
154 emacs_doprnt_*() functions. This is the only way to ensure that
155 I18N3 works properly (many implementations of the *printf()
156 functions, including the ones included in glibc, do not implement
157 the %###$ argument-positioning syntax).
159 Note, however, that to do this, we'd have to
161 1) pre-allocate all the lstreams and do whatever else was necessary
162 to make sure that no allocation occurs, since these functions may be
163 called from fatal_error_signal().
165 2) (to be really correct) make a new lstream that outputs using
166 msw_output_console_string(). */
169 std_handle_out_va (FILE *stream, const char *fmt, va_list args)
171 Bufbyte kludge[8192];
176 retval = vsprintf ((char *) kludge, fmt, args);
177 TO_EXTERNAL_FORMAT (DATA, (kludge, strlen ((char *) kludge)),
178 ALLOCA, (extptr, extlen),
180 std_handle_out_external (stream, Qnil, extptr, extlen, 1, 1);
184 /* Output portably to stderr or its equivalent; call GETTEXT on the
185 format string. Automatically flush when done. */
188 stderr_out (const char *fmt, ...)
192 va_start (args, fmt);
193 retval = std_handle_out_va (stderr, GETTEXT (fmt), args);
198 /* Output portably to stdout or its equivalent; call GETTEXT on the
199 format string. Automatically flush when done. */
202 stdout_out (const char *fmt, ...)
206 va_start (args, fmt);
207 retval = std_handle_out_va (stdout, GETTEXT (fmt), args);
213 fatal (const char *fmt, ...)
216 va_start (args, fmt);
218 stderr_out ("\nXEmacs: ");
219 std_handle_out_va (stderr, GETTEXT (fmt), args);
226 /* Write a string (in internal format) to stdio stream STREAM. */
229 write_string_to_stdio_stream (FILE *stream, struct console *con,
231 Bytecount offset, Bytecount len,
232 Lisp_Object coding_system,
236 const Extbyte *extptr;
238 /* #### yuck! sometimes this function is called with string data,
239 and the following call may gc. */
241 Bufbyte *puta = (Bufbyte *) alloca (len);
242 memcpy (puta, str + offset, len);
243 TO_EXTERNAL_FORMAT (DATA, (puta, len),
244 ALLOCA, (extptr, extlen),
249 std_handle_out_external (stream, Qnil, extptr, extlen,
250 stream == stdout || stream == stderr, must_flush);
253 assert (CONSOLE_TTY_P (con));
254 std_handle_out_external (0, CONSOLE_TTY_DATA (con)->outstream,
256 CONSOLE_TTY_DATA (con)->is_stdio, must_flush);
260 /* Write a string to the output location specified in FUNCTION.
261 Arguments NONRELOC, RELOC, OFFSET, and LEN are as in
262 buffer_insert_string_1() in insdel.c. */
265 output_string (Lisp_Object function, const Bufbyte *nonreloc,
266 Lisp_Object reloc, Bytecount offset, Bytecount len)
268 /* This function can GC */
270 /* We change the value of nonreloc (fetching it from reloc as
271 necessary), but we don't want to pass this changed value on to
272 other functions that take both a nonreloc and a reloc, or things
273 may get confused and an assertion failure in
274 fixup_internal_substring() may get triggered. */
275 const Bufbyte *newnonreloc = nonreloc;
276 struct gcpro gcpro1, gcpro2;
278 /* Emacs won't print while GCing, but an external debugger might */
279 if (gc_in_progress) return;
281 /* Perhaps not necessary but probably safer. */
282 GCPRO2 (function, reloc);
284 fixup_internal_substring (newnonreloc, reloc, offset, &len);
287 newnonreloc = XSTRING_DATA (reloc);
289 cclen = bytecount_to_charcount (newnonreloc + offset, len);
291 if (LSTREAMP (function))
295 /* Protect against Lstream_write() causing a GC and
296 relocating the string. For small strings, we do it by
297 alloc'ing the string and using a copy; for large strings,
301 Bufbyte *copied = alloca_array (Bufbyte, len);
302 memcpy (copied, newnonreloc + offset, len);
303 Lstream_write (XLSTREAM (function), copied, len);
307 int speccount = specpdl_depth ();
308 record_unwind_protect (restore_gc_inhibit,
309 make_int (gc_currently_forbidden));
310 gc_currently_forbidden = 1;
311 Lstream_write (XLSTREAM (function), newnonreloc + offset, len);
312 unbind_to (speccount, Qnil);
316 Lstream_write (XLSTREAM (function), newnonreloc + offset, len);
318 if (print_unbuffered)
319 Lstream_flush (XLSTREAM (function));
321 else if (BUFFERP (function))
323 CHECK_LIVE_BUFFER (function);
324 buffer_insert_string (XBUFFER (function), nonreloc, reloc, offset, len);
326 else if (MARKERP (function))
328 /* marker_position() will err if marker doesn't point anywhere. */
329 Bufpos spoint = marker_position (function);
331 buffer_insert_string_1 (XMARKER (function)->buffer,
332 spoint, nonreloc, reloc, offset, len,
334 Fset_marker (function, make_int (spoint + cclen),
335 Fmarker_buffer (function));
337 else if (FRAMEP (function))
339 /* This gets used by functions not invoking print_prepare(),
340 such as Fwrite_char, Fterpri, etc.. */
341 struct frame *f = XFRAME (function);
342 CHECK_LIVE_FRAME (function);
344 if (!EQ (Vprint_message_label, echo_area_status (f)))
345 clear_echo_area_from_print (f, Qnil, 1);
346 echo_area_append (f, nonreloc, reloc, offset, len, Vprint_message_label);
348 else if (EQ (function, Qt) || EQ (function, Qnil))
350 write_string_to_stdio_stream (stdout, 0, newnonreloc, offset, len,
351 Qterminal, print_unbuffered);
355 Charcount ccoff = bytecount_to_charcount (newnonreloc, offset);
358 for (iii = ccoff; iii < cclen + ccoff; iii++)
361 make_char (charptr_emchar_n (newnonreloc, iii)));
363 newnonreloc = XSTRING_DATA (reloc);
370 #define RESET_PRINT_GENSYM do { \
371 if (!CONSP (Vprint_gensym)) \
372 Vprint_gensym_alist = Qnil; \
376 canonicalize_printcharfun (Lisp_Object printcharfun)
378 if (NILP (printcharfun))
379 printcharfun = Vstandard_output;
381 if (EQ (printcharfun, Qt) || NILP (printcharfun))
382 printcharfun = Fselected_frame (Qnil); /* print to minibuffer */
388 print_prepare (Lisp_Object printcharfun, Lisp_Object *frame_kludge)
390 /* Emacs won't print while GCing, but an external debugger might */
396 printcharfun = canonicalize_printcharfun (printcharfun);
398 /* Here we could safely return the canonicalized PRINTCHARFUN.
399 However, if PRINTCHARFUN is a frame, printing of complex
400 structures becomes very expensive, because `append-message'
401 (called by echo_area_append) gets called as many times as
402 output_string() is called (and that's a *lot*). append-message
403 tries to keep top of the message-stack in sync with the contents
404 of " *Echo Area" buffer, consing a new string for each component
405 of the printed structure. For instance, if you print (a a),
406 append-message will cons up the following strings:
414 and will use only the last one. With larger objects, this turns
415 into an O(n^2) consing frenzy that locks up XEmacs in incessant
418 We prevent this by creating a resizing_buffer stream and letting
419 the printer write into it. print_finish() will notice this
420 stream, and invoke echo_area_append() with the stream's buffer,
422 if (FRAMEP (printcharfun))
424 CHECK_LIVE_FRAME (printcharfun);
425 *frame_kludge = printcharfun;
426 printcharfun = make_resizing_buffer_output_stream ();
433 print_finish (Lisp_Object stream, Lisp_Object frame_kludge)
435 /* Emacs won't print while GCing, but an external debugger might */
441 /* See the comment in print_prepare(). */
442 if (FRAMEP (frame_kludge))
444 struct frame *f = XFRAME (frame_kludge);
445 Lstream *str = XLSTREAM (stream);
446 CHECK_LIVE_FRAME (frame_kludge);
449 if (!EQ (Vprint_message_label, echo_area_status (f)))
450 clear_echo_area_from_print (f, Qnil, 1);
451 echo_area_append (f, resizing_buffer_stream_ptr (str),
452 Qnil, 0, Lstream_byte_count (str),
453 Vprint_message_label);
454 Lstream_delete (str);
458 /* Used for printing a single-byte character (*not* any Emchar). */
459 #define write_char_internal(string_of_length_1, stream) \
460 output_string (stream, (const Bufbyte *) (string_of_length_1), \
463 /* NOTE: Do not call this with the data of a Lisp_String, as
464 printcharfun might cause a GC, which might cause the string's data
465 to be relocated. To princ a Lisp string, use:
467 print_internal (string, printcharfun, 0);
469 Also note that STREAM should be the result of
470 canonicalize_printcharfun() (i.e. Qnil means stdout, not
471 Vstandard_output, etc.) */
473 write_string_1 (const Bufbyte *str, Bytecount size, Lisp_Object stream)
475 /* This function can GC */
476 #ifdef ERROR_CHECK_BUFPOS
479 output_string (stream, str, Qnil, 0, size);
483 write_c_string (const char *str, Lisp_Object stream)
485 /* This function can GC */
486 write_string_1 ((const Bufbyte *) str, strlen (str), stream);
490 DEFUN ("write-char", Fwrite_char, 1, 2, 0, /*
491 Output character CH to stream STREAM.
492 STREAM defaults to the value of `standard-output' (which see).
496 /* This function can GC */
497 Bufbyte str[MAX_EMCHAR_LEN];
500 CHECK_CHAR_COERCE_INT (ch);
501 len = set_charptr_emchar (str, XCHAR (ch));
502 output_string (canonicalize_printcharfun (stream), str, Qnil, 0, len);
507 temp_output_buffer_setup (Lisp_Object bufname)
509 /* This function can GC */
510 struct buffer *old = current_buffer;
514 /* #### This function should accept a Lisp_Object instead of a char *,
515 so that proper translation on the buffer name can occur. */
518 Fset_buffer (Fget_buffer_create (bufname));
520 current_buffer->read_only = Qnil;
521 Ferase_buffer (Qnil);
523 XSETBUFFER (buf, current_buffer);
524 specbind (Qstandard_output, buf);
526 set_buffer_internal (old);
530 internal_with_output_to_temp_buffer (Lisp_Object bufname,
531 Lisp_Object (*function) (Lisp_Object arg),
533 Lisp_Object same_frame)
535 int speccount = specpdl_depth ();
536 struct gcpro gcpro1, gcpro2, gcpro3;
537 Lisp_Object buf = Qnil;
539 GCPRO3 (buf, arg, same_frame);
541 temp_output_buffer_setup (bufname);
542 buf = Vstandard_output;
544 arg = (*function) (arg);
546 temp_output_buffer_show (buf, same_frame);
549 return unbind_to (speccount, arg);
552 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, 1, UNEVALLED, 0, /*
553 Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
554 The buffer is cleared out initially, and marked as unmodified when done.
555 All output done by BODY is inserted in that buffer by default.
556 The buffer is displayed in another window, but not selected.
557 The value of the last form in BODY is returned.
558 If BODY does not finish normally, the buffer BUFNAME is not displayed.
560 If variable `temp-buffer-show-function' is non-nil, call it at the end
561 to get the buffer displayed. It gets one argument, the buffer to display.
565 /* This function can GC */
566 Lisp_Object name = Qnil;
567 int speccount = specpdl_depth ();
568 struct gcpro gcpro1, gcpro2;
569 Lisp_Object val = Qnil;
572 /* #### should set the buffer to be translating. See print_internal(). */
576 name = Feval (XCAR (args));
580 temp_output_buffer_setup (name);
583 val = Fprogn (XCDR (args));
585 temp_output_buffer_show (Vstandard_output, Qnil);
587 return unbind_to (speccount, val);
590 DEFUN ("terpri", Fterpri, 0, 1, 0, /*
591 Output a newline to STREAM.
592 If STREAM is omitted or nil, the value of `standard-output' is used.
596 /* This function can GC */
597 write_char_internal ("\n", canonicalize_printcharfun (stream));
601 DEFUN ("prin1", Fprin1, 1, 2, 0, /*
602 Output the printed representation of OBJECT, any Lisp object.
603 Quoting characters are printed when needed to make output that `read'
604 can handle, whenever this is possible.
605 Output stream is STREAM, or value of `standard-output' (which see).
609 /* This function can GC */
610 Lisp_Object frame = Qnil;
611 struct gcpro gcpro1, gcpro2;
612 GCPRO2 (object, stream);
615 stream = print_prepare (stream, &frame);
616 print_internal (object, stream, 1);
617 print_finish (stream, frame);
623 DEFUN ("prin1-to-string", Fprin1_to_string, 1, 2, 0, /*
624 Return a string containing the printed representation of OBJECT,
625 any Lisp object. Quoting characters are used when needed to make output
626 that `read' can handle, whenever this is possible, unless the optional
627 second argument NOESCAPE is non-nil.
631 /* This function can GC */
632 Lisp_Object result = Qnil;
633 Lisp_Object stream = make_resizing_buffer_output_stream ();
634 Lstream *str = XLSTREAM (stream);
635 /* gcpro OBJECT in case a caller forgot to do so */
636 struct gcpro gcpro1, gcpro2, gcpro3;
637 GCPRO3 (object, stream, result);
641 print_internal (object, stream, NILP (noescape));
645 result = make_string (resizing_buffer_stream_ptr (str),
646 Lstream_byte_count (str));
647 Lstream_delete (str);
651 DEFUN ("princ", Fprinc, 1, 2, 0, /*
652 Output the printed representation of OBJECT, any Lisp object.
653 No quoting characters are used; no delimiters are printed around
654 the contents of strings.
655 Output stream is STREAM, or value of standard-output (which see).
659 /* This function can GC */
660 Lisp_Object frame = Qnil;
661 struct gcpro gcpro1, gcpro2;
663 GCPRO2 (object, stream);
664 stream = print_prepare (stream, &frame);
666 print_internal (object, stream, 0);
667 print_finish (stream, frame);
672 DEFUN ("print", Fprint, 1, 2, 0, /*
673 Output the printed representation of OBJECT, with newlines around it.
674 Quoting characters are printed when needed to make output that `read'
675 can handle, whenever this is possible.
676 Output stream is STREAM, or value of `standard-output' (which see).
680 /* This function can GC */
681 Lisp_Object frame = Qnil;
682 struct gcpro gcpro1, gcpro2;
684 GCPRO2 (object, stream);
685 stream = print_prepare (stream, &frame);
687 write_char_internal ("\n", stream);
688 print_internal (object, stream, 1);
689 write_char_internal ("\n", stream);
690 print_finish (stream, frame);
695 /* Print an error message for the error DATA to STREAM. This is a
696 complete implementation of `display-error', which used to be in
697 Lisp (see prim/cmdloop.el). It was ported to C so it can be used
698 efficiently by Ferror_message_string. Fdisplay_error and
699 Ferror_message_string are trivial wrappers around this function.
701 STREAM should be the result of canonicalize_printcharfun(). */
703 print_error_message (Lisp_Object error_object, Lisp_Object stream)
705 /* This function can GC */
706 Lisp_Object type = Fcar_safe (error_object);
707 Lisp_Object method = Qnil;
710 /* No need to GCPRO anything under the assumption that ERROR_OBJECT
713 if (! (CONSP (error_object) && SYMBOLP (type)
714 && CONSP (Fget (type, Qerror_conditions, Qnil))))
717 tail = XCDR (error_object);
725 tail = Fget (type, Qerror_conditions, Qnil);
728 if (!(CONSP (tail) && SYMBOLP (XCAR (tail))))
730 else if (!NILP (Fget (XCAR (tail), Qdisplay_error, Qnil)))
732 method = Fget (XCAR (tail), Qdisplay_error, Qnil);
741 int speccount = specpdl_depth ();
742 Lisp_Object frame = Qnil;
746 specbind (Qprint_message_label, Qerror);
747 stream = print_prepare (stream, &frame);
749 tail = Fcdr (error_object);
750 if (EQ (type, Qerror))
752 print_internal (Fcar (tail), stream, 0);
757 Lisp_Object errmsg = Fget (type, Qerror_message, Qnil);
759 print_internal (type, stream, 0);
761 print_internal (LISP_GETTEXT (errmsg), stream, 0);
765 write_c_string (first ? ": " : ", ", stream);
766 print_internal (Fcar (tail), stream, 1);
770 print_finish (stream, frame);
772 unbind_to (speccount, Qnil);
780 write_c_string (GETTEXT ("Peculiar error "), stream);
781 print_internal (error_object, stream, 1);
786 call2 (method, error_object, stream);
790 DEFUN ("error-message-string", Ferror_message_string, 1, 1, 0, /*
791 Convert ERROR-OBJECT to an error message, and return it.
793 The format of ERROR-OBJECT should be (ERROR-SYMBOL . DATA). The
794 message is equivalent to the one that would be issued by
795 `display-error' with the same argument.
799 /* This function can GC */
800 Lisp_Object result = Qnil;
801 Lisp_Object stream = make_resizing_buffer_output_stream ();
805 print_error_message (error_object, stream);
806 Lstream_flush (XLSTREAM (stream));
807 result = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
808 Lstream_byte_count (XLSTREAM (stream)));
809 Lstream_delete (XLSTREAM (stream));
815 DEFUN ("display-error", Fdisplay_error, 2, 2, 0, /*
816 Display ERROR-OBJECT on STREAM in a user-friendly way.
818 (error_object, stream))
820 /* This function can GC */
821 print_error_message (error_object, canonicalize_printcharfun (stream));
826 #ifdef LISP_FLOAT_TYPE
828 Lisp_Object Vfloat_output_format;
831 * This buffer should be at least as large as the max string size of the
832 * largest float, printed in the biggest notation. This is undoubtedly
833 * 20d float_output_format, with the negative of the C-constant "HUGE"
836 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
838 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
839 * case of -1e307 in 20d float_output_format. What is one to do (short of
840 * re-writing _doprnt to be more sane)?
844 float_to_string (char *buf, double data)
849 if (NILP (Vfloat_output_format)
850 || !STRINGP (Vfloat_output_format))
852 sprintf (buf, "%.16g", data);
855 /* Check that the spec we have is fully valid.
856 This means not only valid for printf,
857 but meant for floats, and reasonable. */
858 cp = XSTRING_DATA (Vfloat_output_format);
866 for (width = 0; (c = *cp, isdigit (c)); cp++)
872 if (*cp != 'e' && *cp != 'f' && *cp != 'g' && *cp != 'E' && *cp != 'G')
875 if (width < (int) (*cp != 'e' && *cp != 'E') || width > DBL_DIG)
881 sprintf (buf, (char *) XSTRING_DATA (Vfloat_output_format),
885 /* added by jwz: don't allow "1.0" to print as "1"; that destroys
886 the read-equivalence of lisp objects. (* x 1) and (* x 1.0) do
887 not do the same thing, so it's important that the printed
888 representation of that form not be corrupted by the printer.
891 Bufbyte *s = (Bufbyte *) buf; /* don't use signed chars here!
892 isdigit() can't hack them! */
895 /* if there's a non-digit, then there is a decimal point, or
896 it's in exponential notation, both of which are ok. */
899 /* otherwise, we need to hack it. */
906 /* Some machines print "0.4" as ".4". I don't like that. */
907 if (buf [0] == '.' || (buf [0] == '-' && buf [1] == '.'))
910 for (i = strlen (buf) + 1; i >= 0; i--)
912 buf [(buf [0] == '-' ? 1 : 0)] = '0';
915 #endif /* LISP_FLOAT_TYPE */
917 /* Print NUMBER to BUFFER. The digits are first written in reverse
918 order (the least significant digit first), and are then reversed.
919 This is equivalent to sprintf(buffer, "%ld", number), only much
922 BUFFER should accept 24 bytes. This should suffice for the longest
923 numbers on 64-bit machines, including the `-' sign and the trailing
926 long_to_string (char *buffer, long number)
928 #if (SIZEOF_LONG != 4) && (SIZEOF_LONG != 8)
930 sprintf (buffer, "%ld", number);
931 #else /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
941 #define FROB(figure) do { \
942 if (force || number >= figure) \
943 *p++ = number / figure + '0', number %= figure, force = 1; \
946 FROB (1000000000000000000L);
947 FROB (100000000000000000L);
948 FROB (10000000000000000L);
949 FROB (1000000000000000L);
950 FROB (100000000000000L);
951 FROB (10000000000000L);
952 FROB (1000000000000L);
953 FROB (100000000000L);
955 #endif /* SIZEOF_LONG == 8 */
968 #endif /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
972 print_vector_internal (const char *start, const char *end,
974 Lisp_Object printcharfun, int escapeflag)
976 /* This function can GC */
978 int len = XVECTOR_LENGTH (obj);
980 struct gcpro gcpro1, gcpro2;
981 GCPRO2 (obj, printcharfun);
983 if (INTP (Vprint_length))
985 int max = XINT (Vprint_length);
986 if (max < len) last = max;
989 write_c_string (start, printcharfun);
990 for (i = 0; i < last; i++)
992 Lisp_Object elt = XVECTOR_DATA (obj)[i];
993 if (i != 0) write_char_internal (" ", printcharfun);
994 print_internal (elt, printcharfun, escapeflag);
998 write_c_string (" ...", printcharfun);
999 write_c_string (end, printcharfun);
1003 print_cons (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1005 /* This function can GC */
1006 struct gcpro gcpro1, gcpro2;
1008 /* If print_readably is on, print (quote -foo-) as '-foo-
1009 (Yeah, this should really be what print-pretty does, but we
1010 don't have the rest of a pretty printer, and this actually
1011 has non-negligible impact on size/speed of .elc files.)
1013 if (print_readably &&
1014 EQ (XCAR (obj), Qquote) &&
1015 CONSP (XCDR (obj)) &&
1016 NILP (XCDR (XCDR (obj))))
1018 obj = XCAR (XCDR (obj));
1019 GCPRO2 (obj, printcharfun);
1020 write_char_internal ("\'", printcharfun);
1022 print_internal (obj, printcharfun, escapeflag);
1026 GCPRO2 (obj, printcharfun);
1027 write_char_internal ("(", printcharfun);
1031 int max = INTP (Vprint_length) ? XINT (Vprint_length) : INT_MAX;
1032 Lisp_Object tortoise;
1033 /* Use tortoise/hare to make sure circular lists don't infloop */
1035 for (tortoise = obj, len = 0;
1037 obj = XCDR (obj), len++)
1040 write_char_internal (" ", printcharfun);
1041 if (EQ (obj, tortoise) && len > 0)
1044 error ("printing unreadable circular list");
1046 write_c_string ("... <circular list>", printcharfun);
1050 tortoise = XCDR (tortoise);
1053 write_c_string ("...", printcharfun);
1056 print_internal (XCAR (obj), printcharfun, escapeflag);
1061 write_c_string (" . ", printcharfun);
1062 print_internal (obj, printcharfun, escapeflag);
1066 write_char_internal (")", printcharfun);
1071 print_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1073 print_vector_internal ("[", "]", obj, printcharfun, escapeflag);
1077 print_string (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1079 Lisp_String *s = XSTRING (obj);
1080 /* We distinguish between Bytecounts and Charcounts, to make
1081 Vprint_string_length work correctly under Mule. */
1082 Charcount size = string_char_length (s);
1083 Charcount max = size;
1084 Bytecount bcmax = string_length (s);
1085 struct gcpro gcpro1, gcpro2;
1086 GCPRO2 (obj, printcharfun);
1088 if (INTP (Vprint_string_length) &&
1089 XINT (Vprint_string_length) < max)
1091 max = XINT (Vprint_string_length);
1092 bcmax = charcount_to_bytecount (string_data (s), max);
1102 /* This deals with GC-relocation and Mule. */
1103 output_string (printcharfun, 0, obj, 0, bcmax);
1105 write_c_string (" ...", printcharfun);
1109 Bytecount i, last = 0;
1111 write_char_internal ("\"", printcharfun);
1112 for (i = 0; i < bcmax; i++)
1114 Bufbyte ch = string_byte (s, i);
1115 if (ch == '\"' || ch == '\\'
1116 || (ch == '\n' && print_escape_newlines))
1120 output_string (printcharfun, 0, obj, last,
1125 write_c_string ("\\n", printcharfun);
1129 write_char_internal ("\\", printcharfun);
1130 /* This is correct for Mule because the
1131 character is either \ or " */
1132 write_char_internal (string_data (s) + i, printcharfun);
1139 output_string (printcharfun, 0, obj, last,
1143 write_c_string (" ...", printcharfun);
1144 write_char_internal ("\"", printcharfun);
1150 default_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
1153 struct lcrecord_header *header =
1154 (struct lcrecord_header *) XPNTR (obj);
1158 error ("printing unreadable object #<%s 0x%x>",
1159 LHEADER_IMPLEMENTATION (&header->lheader)->name,
1162 sprintf (buf, "#<%s 0x%x>",
1163 LHEADER_IMPLEMENTATION (&header->lheader)->name,
1165 write_c_string (buf, printcharfun);
1169 internal_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
1173 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s) 0x%lx>",
1174 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
1175 (unsigned long) XPNTR (obj));
1176 write_c_string (buf, printcharfun);
1180 print_internal (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1182 /* This function can GC */
1186 /* Emacs won't print while GCing, but an external debugger might */
1187 if (gc_in_progress) return;
1190 /* #### Both input and output streams should have a flag associated
1191 with them indicating whether output to that stream, or strings
1192 read from the stream, get translated using Fgettext(). Such a
1193 stream is called a "translating stream". For the minibuffer and
1194 external-debugging-output this is always true on output, and
1195 with-output-to-temp-buffer sets the flag to true for the buffer
1196 it creates. This flag should also be user-settable. Perhaps it
1197 should be split up into two flags, one for input and one for
1201 /* Detect circularities and truncate them.
1202 No need to offer any alternative--this is better than an error. */
1203 if (CONSP (obj) || VECTORP (obj) || COMPILED_FUNCTIONP (obj))
1206 for (i = 0; i < print_depth; i++)
1207 if (EQ (obj, being_printed[i]))
1211 long_to_string (buf + 1, i);
1212 write_c_string (buf, printcharfun);
1217 being_printed[print_depth] = obj;
1220 if (print_depth > PRINT_CIRCLE)
1221 error ("Apparently circular structure being printed");
1223 switch (XTYPE (obj))
1225 case Lisp_Type_Int_Even:
1226 case Lisp_Type_Int_Odd:
1228 /* ASCII Decimal representation uses 2.4 times as many bits as
1230 char buf[3 * sizeof (EMACS_INT) + 5];
1231 long_to_string (buf, XINT (obj));
1232 write_c_string (buf, printcharfun);
1236 case Lisp_Type_Char:
1238 /* God intended that this be #\..., you know. */
1240 Emchar ch = XCHAR (obj);
1248 case '\t': *p++ = 't'; break;
1249 case '\n': *p++ = 'n'; break;
1250 case '\r': *p++ = 'r'; break;
1254 if ((ch + 64) == '\\')
1261 /* syntactically special characters should be escaped. */
1284 *p++ = '\\', *p++ = '^', *p++ = '?';
1288 *p++ = '\\', *p++ = '^';
1289 p += set_charptr_emchar ((Bufbyte *) p, ch + 64);
1293 p += set_charptr_emchar ((Bufbyte *) p, ch);
1296 output_string (printcharfun, (Bufbyte *) buf, Qnil, 0, p - buf);
1301 case Lisp_Type_Record:
1303 struct lrecord_header *lheader = XRECORD_LHEADER (obj);
1304 struct gcpro gcpro1, gcpro2;
1306 if (CONSP (obj) || VECTORP(obj))
1308 /* If deeper than spec'd depth, print placeholder. */
1309 if (INTP (Vprint_level)
1310 && print_depth > XINT (Vprint_level))
1312 GCPRO2 (obj, printcharfun);
1313 write_c_string ("...", printcharfun);
1319 GCPRO2 (obj, printcharfun);
1320 if (LHEADER_IMPLEMENTATION (lheader)->printer)
1321 ((LHEADER_IMPLEMENTATION (lheader)->printer)
1322 (obj, printcharfun, escapeflag));
1324 default_object_printer (obj, printcharfun, escapeflag);
1331 #ifdef ERROR_CHECK_TYPECHECK
1333 #else /* not ERROR_CHECK_TYPECHECK */
1335 /* We're in trouble if this happens! */
1337 error ("printing illegal data type #o%03o",
1339 write_c_string ("#<EMACS BUG: ILLEGAL DATATYPE ",
1341 sprintf (buf, "(#o%3o)", (int) XTYPE (obj));
1342 write_c_string (buf, printcharfun);
1344 (" Save your buffers immediately and please report this bug>",
1346 #endif /* not ERROR_CHECK_TYPECHECK */
1355 #ifdef LISP_FLOAT_TYPE
1357 print_float (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1359 char pigbuf[350]; /* see comments in float_to_string */
1361 float_to_string (pigbuf, XFLOAT_DATA (obj));
1362 write_c_string (pigbuf, printcharfun);
1364 #endif /* LISP_FLOAT_TYPE */
1367 print_symbol (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1369 /* This function can GC */
1370 /* #### Bug!! (intern "") isn't printed in some distinguished way */
1371 /* #### (the reader also loses on it) */
1372 Lisp_String *name = symbol_name (XSYMBOL (obj));
1373 Bytecount size = string_length (name);
1374 struct gcpro gcpro1, gcpro2;
1378 /* This deals with GC-relocation */
1379 Lisp_Object nameobj;
1380 XSETSTRING (nameobj, name);
1381 output_string (printcharfun, 0, nameobj, 0, size);
1384 GCPRO2 (obj, printcharfun);
1386 /* If we print an uninterned symbol as part of a complex object and
1387 the flag print-gensym is non-nil, prefix it with #n= to read the
1388 object back with the #n# reader syntax later if needed. */
1389 if (!NILP (Vprint_gensym)
1390 /* #### Test whether this produces a noticable slow-down for
1391 printing when print-gensym is non-nil. */
1392 && !EQ (obj, oblookup (Vobarray,
1393 string_data (symbol_name (XSYMBOL (obj))),
1394 string_length (symbol_name (XSYMBOL (obj))))))
1396 if (print_depth > 1)
1398 Lisp_Object tem = Fassq (obj, Vprint_gensym_alist);
1401 write_char_internal ("#", printcharfun);
1402 print_internal (XCDR (tem), printcharfun, escapeflag);
1403 write_char_internal ("#", printcharfun);
1408 if (CONSP (Vprint_gensym_alist))
1410 /* Vprint_gensym_alist is exposed to Lisp, so we
1411 have to be careful. */
1412 CHECK_CONS (XCAR (Vprint_gensym_alist));
1413 CHECK_INT (XCDR (XCAR (Vprint_gensym_alist)));
1414 XSETINT (tem, XINT (XCDR (XCAR (Vprint_gensym_alist))) + 1);
1418 Vprint_gensym_alist = Fcons (Fcons (obj, tem), Vprint_gensym_alist);
1420 write_char_internal ("#", printcharfun);
1421 print_internal (tem, printcharfun, escapeflag);
1422 write_char_internal ("=", printcharfun);
1425 write_c_string ("#:", printcharfun);
1428 /* Does it look like an integer or a float? */
1430 Bufbyte *data = string_data (name);
1431 Bytecount confusing = 0;
1434 goto not_yet_confused; /* Really confusing */
1435 else if (isdigit (data[0]))
1438 goto not_yet_confused;
1439 else if (data[0] == '-' || data[0] == '+')
1442 goto not_yet_confused;
1444 for (; confusing < size; confusing++)
1446 if (!isdigit (data[confusing]))
1454 #ifdef LISP_FLOAT_TYPE
1456 /* #### Ugh, this is needlessly complex and slow for what we
1457 need here. It might be a good idea to copy equivalent code
1458 from FSF. --hniksic */
1459 confusing = isfloat_string ((char *) data);
1462 write_char_internal ("\\", printcharfun);
1466 Lisp_Object nameobj;
1470 XSETSTRING (nameobj, name);
1471 for (i = 0; i < size; i++)
1473 switch (string_byte (name, i))
1475 case 0: case 1: case 2: case 3:
1476 case 4: case 5: case 6: case 7:
1477 case 8: case 9: case 10: case 11:
1478 case 12: case 13: case 14: case 15:
1479 case 16: case 17: case 18: case 19:
1480 case 20: case 21: case 22: case 23:
1481 case 24: case 25: case 26: case 27:
1482 case 28: case 29: case 30: case 31:
1483 case ' ': case '\"': case '\\': case '\'':
1484 case ';': case '#' : case '(' : case ')':
1485 case ',': case '.' : case '`' :
1486 case '[': case ']' : case '?' :
1488 output_string (printcharfun, 0, nameobj, last, i - last);
1489 write_char_internal ("\\", printcharfun);
1493 output_string (printcharfun, 0, nameobj, last, size - last);
1498 /* #ifdef DEBUG_XEMACS */
1500 /* I don't like seeing `Note: Strange doc (not fboundp) for function
1501 alternate-debugging-output @ 429542' -slb */
1502 /* #### Eek! Any clue how to get rid of it? In fact, how about
1503 getting rid of this function altogether? Does anything actually
1504 *use* it? --hniksic */
1506 static int alternate_do_pointer;
1507 static char alternate_do_string[5000];
1509 DEFUN ("alternate-debugging-output", Falternate_debugging_output, 1, 1, 0, /*
1510 Append CHARACTER to the array `alternate_do_string'.
1511 This can be used in place of `external-debugging-output' as a function
1512 to be passed to `print'. Before calling `print', set `alternate_do_pointer'
1517 Bufbyte str[MAX_EMCHAR_LEN];
1520 const Extbyte *extptr;
1522 CHECK_CHAR_COERCE_INT (character);
1523 len = set_charptr_emchar (str, XCHAR (character));
1524 TO_EXTERNAL_FORMAT (DATA, (str, len),
1525 ALLOCA, (extptr, extlen),
1527 memcpy (alternate_do_string + alternate_do_pointer, extptr, extlen);
1528 alternate_do_pointer += extlen;
1529 alternate_do_string[alternate_do_pointer] = 0;
1532 /* #endif / * DEBUG_XEMACS */
1534 DEFUN ("external-debugging-output", Fexternal_debugging_output, 1, 3, 0, /*
1535 Write CHAR-OR-STRING to stderr or stdout.
1536 If optional arg STDOUT-P is non-nil, write to stdout; otherwise, write
1537 to stderr. You can use this function to write directly to the terminal.
1538 This function can be used as the STREAM argument of Fprint() or the like.
1540 Under MS Windows, this writes output to the console window (which is
1541 created, if necessary), unless XEmacs is being run noninteractively
1542 (i.e. using the `-batch' argument).
1544 If you have opened a termscript file (using `open-termscript'), then
1545 the output also will be logged to this file.
1547 (char_or_string, stdout_p, device))
1550 struct console *con = 0;
1554 if (!NILP (stdout_p))
1561 CHECK_LIVE_DEVICE (device);
1562 if (!DEVICE_TTY_P (XDEVICE (device)) &&
1563 !DEVICE_STREAM_P (XDEVICE (device)))
1564 signal_simple_error ("Must be tty or stream device", device);
1565 con = XCONSOLE (DEVICE_CONSOLE (XDEVICE (device)));
1566 if (DEVICE_TTY_P (XDEVICE (device)))
1568 else if (!NILP (stdout_p))
1569 file = CONSOLE_STREAM_DATA (con)->out;
1571 file = CONSOLE_STREAM_DATA (con)->err;
1574 if (STRINGP (char_or_string))
1575 write_string_to_stdio_stream (file, con,
1576 XSTRING_DATA (char_or_string),
1577 0, XSTRING_LENGTH (char_or_string),
1581 Bufbyte str[MAX_EMCHAR_LEN];
1584 CHECK_CHAR_COERCE_INT (char_or_string);
1585 len = set_charptr_emchar (str, XCHAR (char_or_string));
1586 write_string_to_stdio_stream (file, con, str, 0, len, Qterminal, 1);
1589 return char_or_string;
1592 DEFUN ("open-termscript", Fopen_termscript, 1, 1, "FOpen termscript file: ", /*
1593 Start writing all terminal output to FILE as well as the terminal.
1594 FILE = nil means just close any termscript file currently open.
1598 /* This function can GC */
1599 if (termscript != 0)
1600 fclose (termscript);
1605 file = Fexpand_file_name (file, Qnil);
1606 termscript = fopen ((char *) XSTRING_DATA (file), "w");
1607 if (termscript == NULL)
1608 report_file_error ("Opening termscript", list1 (file));
1614 /* Debugging kludge -- unbuffered */
1615 static int debug_print_length = 50;
1616 static int debug_print_level = 15;
1617 static int debug_print_readably = -1;
1620 debug_print_no_newline (Lisp_Object debug_print_obj)
1622 /* This function can GC */
1623 int save_print_readably = print_readably;
1624 int save_print_depth = print_depth;
1625 Lisp_Object save_Vprint_length = Vprint_length;
1626 Lisp_Object save_Vprint_level = Vprint_level;
1627 Lisp_Object save_Vinhibit_quit = Vinhibit_quit;
1628 struct gcpro gcpro1, gcpro2, gcpro3;
1629 GCPRO3 (save_Vprint_level, save_Vprint_length, save_Vinhibit_quit);
1632 stderr_out ("** gc-in-progress! Bad idea to print anything! **\n");
1635 print_readably = debug_print_readably != -1 ? debug_print_readably : 0;
1637 /* Could use unwind-protect, but why bother? */
1638 if (debug_print_length > 0)
1639 Vprint_length = make_int (debug_print_length);
1640 if (debug_print_level > 0)
1641 Vprint_level = make_int (debug_print_level);
1643 print_internal (debug_print_obj, Qexternal_debugging_output, 1);
1645 Vinhibit_quit = save_Vinhibit_quit;
1646 Vprint_level = save_Vprint_level;
1647 Vprint_length = save_Vprint_length;
1648 print_depth = save_print_depth;
1649 print_readably = save_print_readably;
1655 debug_print (Lisp_Object debug_print_obj)
1657 debug_print_no_newline (debug_print_obj);
1661 /* Debugging kludge -- unbuffered */
1662 /* This function provided for the benefit of the debugger. */
1663 void debug_backtrace (void);
1665 debug_backtrace (void)
1667 /* This function can GC */
1668 int old_print_readably = print_readably;
1669 int old_print_depth = print_depth;
1670 Lisp_Object old_print_length = Vprint_length;
1671 Lisp_Object old_print_level = Vprint_level;
1672 Lisp_Object old_inhibit_quit = Vinhibit_quit;
1674 struct gcpro gcpro1, gcpro2, gcpro3;
1675 GCPRO3 (old_print_level, old_print_length, old_inhibit_quit);
1678 stderr_out ("** gc-in-progress! Bad idea to print anything! **\n");
1683 /* Could use unwind-protect, but why bother? */
1684 if (debug_print_length > 0)
1685 Vprint_length = make_int (debug_print_length);
1686 if (debug_print_level > 0)
1687 Vprint_level = make_int (debug_print_level);
1689 Fbacktrace (Qexternal_debugging_output, Qt);
1692 Vinhibit_quit = old_inhibit_quit;
1693 Vprint_level = old_print_level;
1694 Vprint_length = old_print_length;
1695 print_depth = old_print_depth;
1696 print_readably = old_print_readably;
1703 debug_short_backtrace (int length)
1706 struct backtrace *bt = backtrace_list;
1708 while (length > 0 && bt)
1714 if (COMPILED_FUNCTIONP (*bt->function))
1716 #if defined(COMPILED_FUNCTION_ANNOTATION_HACK)
1718 compiled_function_annotation (XCOMPILED_FUNCTION (*bt->function));
1720 Lisp_Object ann = Qnil;
1724 stderr_out ("<compiled-function from ");
1725 debug_print_no_newline (ann);
1730 stderr_out ("<compiled-function of unknown origin>");
1734 debug_print_no_newline (*bt->function);
1742 #endif /* debugging kludge */
1746 syms_of_print (void)
1748 defsymbol (&Qstandard_output, "standard-output");
1750 defsymbol (&Qprint_length, "print-length");
1752 defsymbol (&Qprint_string_length, "print-string-length");
1754 defsymbol (&Qdisplay_error, "display-error");
1755 defsymbol (&Qprint_message_label, "print-message-label");
1758 DEFSUBR (Fprin1_to_string);
1761 DEFSUBR (Ferror_message_string);
1762 DEFSUBR (Fdisplay_error);
1764 DEFSUBR (Fwrite_char);
1765 DEFSUBR (Falternate_debugging_output);
1766 DEFSUBR (Fexternal_debugging_output);
1767 DEFSUBR (Fopen_termscript);
1768 defsymbol (&Qexternal_debugging_output, "external-debugging-output");
1769 DEFSUBR (Fwith_output_to_temp_buffer);
1773 reinit_vars_of_print (void)
1775 alternate_do_pointer = 0;
1779 vars_of_print (void)
1781 reinit_vars_of_print ();
1783 DEFVAR_LISP ("standard-output", &Vstandard_output /*
1784 Output stream `print' uses by default for outputting a character.
1785 This may be any function of one argument.
1786 It may also be a buffer (output is inserted before point)
1787 or a marker (output is inserted and the marker is advanced)
1788 or the symbol t (output appears in the minibuffer line).
1790 Vstandard_output = Qt;
1792 #ifdef LISP_FLOAT_TYPE
1793 DEFVAR_LISP ("float-output-format", &Vfloat_output_format /*
1794 The format descriptor string that lisp uses to print floats.
1795 This is a %-spec like those accepted by `printf' in C,
1796 but with some restrictions. It must start with the two characters `%.'.
1797 After that comes an integer precision specification,
1798 and then a letter which controls the format.
1799 The letters allowed are `e', `f' and `g'.
1800 Use `e' for exponential notation "DIG.DIGITSeEXPT"
1801 Use `f' for decimal point notation "DIGITS.DIGITS".
1802 Use `g' to choose the shorter of those two formats for the number at hand.
1803 The precision in any of these cases is the number of digits following
1804 the decimal point. With `f', a precision of 0 means to omit the
1805 decimal point. 0 is not allowed with `f' or `g'.
1807 A value of nil means to use `%.16g'.
1809 Regardless of the value of `float-output-format', a floating point number
1810 will never be printed in such a way that it is ambiguous with an integer;
1811 that is, a floating-point number will always be printed with a decimal
1812 point and/or an exponent, even if the digits following the decimal point
1813 are all zero. This is to preserve read-equivalence.
1815 Vfloat_output_format = Qnil;
1816 #endif /* LISP_FLOAT_TYPE */
1818 DEFVAR_LISP ("print-length", &Vprint_length /*
1819 Maximum length of list or vector to print before abbreviating.
1820 A value of nil means no limit.
1822 Vprint_length = Qnil;
1824 DEFVAR_LISP ("print-string-length", &Vprint_string_length /*
1825 Maximum length of string to print before abbreviating.
1826 A value of nil means no limit.
1828 Vprint_string_length = Qnil;
1830 DEFVAR_LISP ("print-level", &Vprint_level /*
1831 Maximum depth of list nesting to print before abbreviating.
1832 A value of nil means no limit.
1834 Vprint_level = Qnil;
1836 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines /*
1837 Non-nil means print newlines in strings as backslash-n.
1839 print_escape_newlines = 0;
1841 DEFVAR_BOOL ("print-readably", &print_readably /*
1842 If non-nil, then all objects will be printed in a readable form.
1843 If an object has no readable representation, then an error is signalled.
1844 When print-readably is true, compiled-function objects will be written in
1845 #[...] form instead of in #<compiled-function [...]> form, and two-element
1846 lists of the form (quote object) will be written as the equivalent 'object.
1847 Do not SET this variable; bind it instead.
1851 /* #### I think this should default to t. But we'd better wait
1852 until we see that it works out. */
1853 DEFVAR_LISP ("print-gensym", &Vprint_gensym /*
1854 If non-nil, then uninterned symbols will be printed specially.
1855 Uninterned symbols are those which are not present in `obarray', that is,
1856 those which were made with `make-symbol' or by calling `intern' with a
1859 When print-gensym is true, such symbols will be preceded by "#:",
1860 which causes the reader to create a new symbol instead of interning
1861 and returning an existing one. Beware: the #: syntax creates a new
1862 symbol each time it is seen, so if you print an object which contains
1863 two pointers to the same uninterned symbol, `read' will not duplicate
1866 If the value of `print-gensym' is a cons cell, then in addition
1867 refrain from clearing `print-gensym-alist' on entry to and exit from
1868 printing functions, so that the use of #...# and #...= can carry over
1869 for several separately printed objects.
1871 Vprint_gensym = Qnil;
1873 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist /*
1874 Association list of elements (GENSYM . N) to guide use of #N# and #N=.
1875 In each element, GENSYM is an uninterned symbol that has been associated
1876 with #N= for the specified value of N.
1878 Vprint_gensym_alist = Qnil;
1880 DEFVAR_LISP ("print-message-label", &Vprint_message_label /*
1881 Label for minibuffer messages created with `print'. This should
1882 generally be bound with `let' rather than set. (See `display-message'.)
1884 Vprint_message_label = Qprint;