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 static int no_useful_stderr;
114 std_handle_out_external (FILE *stream, Lisp_Object lstream,
115 const Extbyte *extptr, Extcount extlen,
116 /* is this really stdout/stderr?
117 (controls termscript writing) */
118 int output_is_std_handle,
124 if (!no_useful_stderr)
125 no_useful_stderr = GetStdHandle (STD_ERROR_HANDLE) == 0 ? 1 : -1;
127 /* we typically have no useful stdout/stderr under windows if we're
128 being invoked graphically. */
129 if (!noninteractive || no_useful_stderr > 0)
130 msw_output_console_string (extptr, extlen);
134 fwrite (extptr, 1, extlen, stream);
136 /* Q122442 says that pipes are "treated as files, not as
137 devices", and that this is a feature. Before I found that
138 article, I thought it was a bug. Thanks MS, I feel much
147 Lstream_write (XLSTREAM (lstream), extptr, extlen);
149 if (output_is_std_handle)
153 fwrite (extptr, 1, extlen, termscript);
156 stdout_needs_newline = (extptr[extlen - 1] != '\n');
160 /* #### The following function should be replaced a call to the
161 emacs_doprnt_*() functions. This is the only way to ensure that
162 I18N3 works properly (many implementations of the *printf()
163 functions, including the ones included in glibc, do not implement
164 the %###$ argument-positioning syntax).
166 Note, however, that to do this, we'd have to
168 1) pre-allocate all the lstreams and do whatever else was necessary
169 to make sure that no allocation occurs, since these functions may be
170 called from fatal_error_signal().
172 2) (to be really correct) make a new lstream that outputs using
173 msw_output_console_string(). */
176 std_handle_out_va (FILE *stream, const char *fmt, va_list args)
178 Bufbyte kludge[8192];
183 retval = vsprintf ((char *) kludge, fmt, args);
184 if (initialized && !fatal_error_in_progress)
185 TO_EXTERNAL_FORMAT (DATA, (kludge, strlen ((char *) kludge)),
186 ALLOCA, (extptr, extlen),
190 extptr = (Extbyte *) kludge;
191 extlen = (Extcount) strlen ((char *) kludge);
194 std_handle_out_external (stream, Qnil, extptr, extlen, 1, 1);
198 /* Output portably to stderr or its equivalent; call GETTEXT on the
199 format string. Automatically flush when done. */
202 stderr_out (const char *fmt, ...)
206 va_start (args, fmt);
209 (stderr, initialized && !fatal_error_in_progress ? GETTEXT (fmt) : fmt,
215 /* Output portably to stdout or its equivalent; call GETTEXT on the
216 format string. Automatically flush when done. */
219 stdout_out (const char *fmt, ...)
223 va_start (args, fmt);
226 (stdout, initialized && !fatal_error_in_progress ? GETTEXT (fmt) : fmt,
233 fatal (const char *fmt, ...)
236 va_start (args, fmt);
238 stderr_out ("\nXEmacs: ");
239 std_handle_out_va (stderr, GETTEXT (fmt), args);
246 /* Write a string (in internal format) to stdio stream STREAM. */
249 write_string_to_stdio_stream (FILE *stream, struct console *con,
251 Bytecount offset, Bytecount len,
252 Lisp_Object coding_system,
256 const Extbyte *extptr;
258 /* #### yuck! sometimes this function is called with string data,
259 and the following call may gc. */
261 Bufbyte *puta = (Bufbyte *) alloca (len);
262 memcpy (puta, str + offset, len);
263 TO_EXTERNAL_FORMAT (DATA, (puta, len),
264 ALLOCA, (extptr, extlen),
269 std_handle_out_external (stream, Qnil, extptr, extlen,
270 stream == stdout || stream == stderr, must_flush);
273 assert (CONSOLE_TTY_P (con));
274 std_handle_out_external (0, CONSOLE_TTY_DATA (con)->outstream,
276 CONSOLE_TTY_DATA (con)->is_stdio, must_flush);
280 /* Write a string to the output location specified in FUNCTION.
281 Arguments NONRELOC, RELOC, OFFSET, and LEN are as in
282 buffer_insert_string_1() in insdel.c. */
285 output_string (Lisp_Object function, const Bufbyte *nonreloc,
286 Lisp_Object reloc, Bytecount offset, Bytecount len)
288 /* This function can GC */
290 /* We change the value of nonreloc (fetching it from reloc as
291 necessary), but we don't want to pass this changed value on to
292 other functions that take both a nonreloc and a reloc, or things
293 may get confused and an assertion failure in
294 fixup_internal_substring() may get triggered. */
295 const Bufbyte *newnonreloc = nonreloc;
296 struct gcpro gcpro1, gcpro2;
298 /* Emacs won't print while GCing, but an external debugger might */
299 if (gc_in_progress) return;
301 /* Perhaps not necessary but probably safer. */
302 GCPRO2 (function, reloc);
304 fixup_internal_substring (newnonreloc, reloc, offset, &len);
307 newnonreloc = XSTRING_DATA (reloc);
309 cclen = bytecount_to_charcount (newnonreloc + offset, len);
311 if (LSTREAMP (function))
315 /* Protect against Lstream_write() causing a GC and
316 relocating the string. For small strings, we do it by
317 alloc'ing the string and using a copy; for large strings,
321 Bufbyte *copied = alloca_array (Bufbyte, len);
322 memcpy (copied, newnonreloc + offset, len);
323 Lstream_write (XLSTREAM (function), copied, len);
327 int speccount = specpdl_depth ();
328 record_unwind_protect (restore_gc_inhibit,
329 make_int (gc_currently_forbidden));
330 gc_currently_forbidden = 1;
331 Lstream_write (XLSTREAM (function), newnonreloc + offset, len);
332 unbind_to (speccount, Qnil);
336 Lstream_write (XLSTREAM (function), newnonreloc + offset, len);
338 if (print_unbuffered)
339 Lstream_flush (XLSTREAM (function));
341 else if (BUFFERP (function))
343 CHECK_LIVE_BUFFER (function);
344 buffer_insert_string (XBUFFER (function), nonreloc, reloc, offset, len);
346 else if (MARKERP (function))
348 /* marker_position() will err if marker doesn't point anywhere. */
349 Bufpos spoint = marker_position (function);
351 buffer_insert_string_1 (XMARKER (function)->buffer,
352 spoint, nonreloc, reloc, offset, len,
354 Fset_marker (function, make_int (spoint + cclen),
355 Fmarker_buffer (function));
357 else if (FRAMEP (function))
359 /* This gets used by functions not invoking print_prepare(),
360 such as Fwrite_char, Fterpri, etc.. */
361 struct frame *f = XFRAME (function);
362 CHECK_LIVE_FRAME (function);
364 if (!EQ (Vprint_message_label, echo_area_status (f)))
365 clear_echo_area_from_print (f, Qnil, 1);
366 echo_area_append (f, nonreloc, reloc, offset, len, Vprint_message_label);
368 else if (EQ (function, Qt) || EQ (function, Qnil))
370 write_string_to_stdio_stream (stdout, 0, newnonreloc, offset, len,
371 Qterminal, print_unbuffered);
375 Charcount ccoff = bytecount_to_charcount (newnonreloc, offset);
378 for (iii = ccoff; iii < cclen + ccoff; iii++)
381 make_char (charptr_emchar_n (newnonreloc, iii)));
383 newnonreloc = XSTRING_DATA (reloc);
390 #define RESET_PRINT_GENSYM do { \
391 if (!CONSP (Vprint_gensym)) \
392 Vprint_gensym_alist = Qnil; \
396 canonicalize_printcharfun (Lisp_Object printcharfun)
398 if (NILP (printcharfun))
399 printcharfun = Vstandard_output;
401 if (EQ (printcharfun, Qt) || NILP (printcharfun))
402 printcharfun = Fselected_frame (Qnil); /* print to minibuffer */
408 print_prepare (Lisp_Object printcharfun, Lisp_Object *frame_kludge)
410 /* Emacs won't print while GCing, but an external debugger might */
416 printcharfun = canonicalize_printcharfun (printcharfun);
418 /* Here we could safely return the canonicalized PRINTCHARFUN.
419 However, if PRINTCHARFUN is a frame, printing of complex
420 structures becomes very expensive, because `append-message'
421 (called by echo_area_append) gets called as many times as
422 output_string() is called (and that's a *lot*). append-message
423 tries to keep top of the message-stack in sync with the contents
424 of " *Echo Area" buffer, consing a new string for each component
425 of the printed structure. For instance, if you print (a a),
426 append-message will cons up the following strings:
434 and will use only the last one. With larger objects, this turns
435 into an O(n^2) consing frenzy that locks up XEmacs in incessant
438 We prevent this by creating a resizing_buffer stream and letting
439 the printer write into it. print_finish() will notice this
440 stream, and invoke echo_area_append() with the stream's buffer,
442 if (FRAMEP (printcharfun))
444 CHECK_LIVE_FRAME (printcharfun);
445 *frame_kludge = printcharfun;
446 printcharfun = make_resizing_buffer_output_stream ();
453 print_finish (Lisp_Object stream, Lisp_Object frame_kludge)
455 /* Emacs won't print while GCing, but an external debugger might */
461 /* See the comment in print_prepare(). */
462 if (FRAMEP (frame_kludge))
464 struct frame *f = XFRAME (frame_kludge);
465 Lstream *str = XLSTREAM (stream);
466 CHECK_LIVE_FRAME (frame_kludge);
469 if (!EQ (Vprint_message_label, echo_area_status (f)))
470 clear_echo_area_from_print (f, Qnil, 1);
471 echo_area_append (f, resizing_buffer_stream_ptr (str),
472 Qnil, 0, Lstream_byte_count (str),
473 Vprint_message_label);
474 Lstream_delete (str);
478 /* Used for printing a single-byte character (*not* any Emchar). */
479 #define write_char_internal(string_of_length_1, stream) \
480 output_string (stream, (const Bufbyte *) (string_of_length_1), \
483 /* NOTE: Do not call this with the data of a Lisp_String, as
484 printcharfun might cause a GC, which might cause the string's data
485 to be relocated. To princ a Lisp string, use:
487 print_internal (string, printcharfun, 0);
489 Also note that STREAM should be the result of
490 canonicalize_printcharfun() (i.e. Qnil means stdout, not
491 Vstandard_output, etc.) */
493 write_string_1 (const Bufbyte *str, Bytecount size, Lisp_Object stream)
495 /* This function can GC */
496 #ifdef ERROR_CHECK_BUFPOS
499 output_string (stream, str, Qnil, 0, size);
503 write_c_string (const char *str, Lisp_Object stream)
505 /* This function can GC */
506 write_string_1 ((const Bufbyte *) str, strlen (str), stream);
510 DEFUN ("write-char", Fwrite_char, 1, 2, 0, /*
511 Output character CH to stream STREAM.
512 STREAM defaults to the value of `standard-output' (which see).
516 /* This function can GC */
517 Bufbyte str[MAX_EMCHAR_LEN];
520 CHECK_CHAR_COERCE_INT (ch);
521 len = set_charptr_emchar (str, XCHAR (ch));
522 output_string (canonicalize_printcharfun (stream), str, Qnil, 0, len);
527 temp_output_buffer_setup (Lisp_Object bufname)
529 /* This function can GC */
530 struct buffer *old = current_buffer;
534 /* #### This function should accept a Lisp_Object instead of a char *,
535 so that proper translation on the buffer name can occur. */
538 Fset_buffer (Fget_buffer_create (bufname));
540 current_buffer->read_only = Qnil;
541 Ferase_buffer (Qnil);
543 XSETBUFFER (buf, current_buffer);
544 specbind (Qstandard_output, buf);
546 set_buffer_internal (old);
550 internal_with_output_to_temp_buffer (Lisp_Object bufname,
551 Lisp_Object (*function) (Lisp_Object arg),
553 Lisp_Object same_frame)
555 int speccount = specpdl_depth ();
556 struct gcpro gcpro1, gcpro2, gcpro3;
557 Lisp_Object buf = Qnil;
559 GCPRO3 (buf, arg, same_frame);
561 temp_output_buffer_setup (bufname);
562 buf = Vstandard_output;
564 arg = (*function) (arg);
566 temp_output_buffer_show (buf, same_frame);
569 return unbind_to (speccount, arg);
572 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, 1, UNEVALLED, 0, /*
573 Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
574 The buffer is cleared out initially, and marked as unmodified when done.
575 All output done by BODY is inserted in that buffer by default.
576 The buffer is displayed in another window, but not selected.
577 The value of the last form in BODY is returned.
578 If BODY does not finish normally, the buffer BUFNAME is not displayed.
580 If variable `temp-buffer-show-function' is non-nil, call it at the end
581 to get the buffer displayed. It gets one argument, the buffer to display.
585 /* This function can GC */
586 Lisp_Object name = Qnil;
587 int speccount = specpdl_depth ();
588 struct gcpro gcpro1, gcpro2;
589 Lisp_Object val = Qnil;
592 /* #### should set the buffer to be translating. See print_internal(). */
596 name = Feval (XCAR (args));
600 temp_output_buffer_setup (name);
603 val = Fprogn (XCDR (args));
605 temp_output_buffer_show (Vstandard_output, Qnil);
607 return unbind_to (speccount, val);
610 DEFUN ("terpri", Fterpri, 0, 1, 0, /*
611 Output a newline to STREAM.
612 If STREAM is omitted or nil, the value of `standard-output' is used.
616 /* This function can GC */
617 write_char_internal ("\n", canonicalize_printcharfun (stream));
621 DEFUN ("prin1", Fprin1, 1, 2, 0, /*
622 Output the printed representation of OBJECT, any Lisp object.
623 Quoting characters are printed when needed to make output that `read'
624 can handle, whenever this is possible.
625 Output stream is STREAM, or value of `standard-output' (which see).
629 /* This function can GC */
630 Lisp_Object frame = Qnil;
631 struct gcpro gcpro1, gcpro2;
632 GCPRO2 (object, stream);
635 stream = print_prepare (stream, &frame);
636 print_internal (object, stream, 1);
637 print_finish (stream, frame);
643 DEFUN ("prin1-to-string", Fprin1_to_string, 1, 2, 0, /*
644 Return a string containing the printed representation of OBJECT,
645 any Lisp object. Quoting characters are used when needed to make output
646 that `read' can handle, whenever this is possible, unless the optional
647 second argument NOESCAPE is non-nil.
651 /* This function can GC */
652 Lisp_Object result = Qnil;
653 Lisp_Object stream = make_resizing_buffer_output_stream ();
654 Lstream *str = XLSTREAM (stream);
655 /* gcpro OBJECT in case a caller forgot to do so */
656 struct gcpro gcpro1, gcpro2, gcpro3;
657 GCPRO3 (object, stream, result);
661 print_internal (object, stream, NILP (noescape));
665 result = make_string (resizing_buffer_stream_ptr (str),
666 Lstream_byte_count (str));
667 Lstream_delete (str);
671 DEFUN ("princ", Fprinc, 1, 2, 0, /*
672 Output the printed representation of OBJECT, any Lisp object.
673 No quoting characters are used; no delimiters are printed around
674 the contents of strings.
675 Output stream is STREAM, or value of standard-output (which see).
679 /* This function can GC */
680 Lisp_Object frame = Qnil;
681 struct gcpro gcpro1, gcpro2;
683 GCPRO2 (object, stream);
684 stream = print_prepare (stream, &frame);
686 print_internal (object, stream, 0);
687 print_finish (stream, frame);
692 DEFUN ("print", Fprint, 1, 2, 0, /*
693 Output the printed representation of OBJECT, with newlines around it.
694 Quoting characters are printed when needed to make output that `read'
695 can handle, whenever this is possible.
696 Output stream is STREAM, or value of `standard-output' (which see).
700 /* This function can GC */
701 Lisp_Object frame = Qnil;
702 struct gcpro gcpro1, gcpro2;
704 GCPRO2 (object, stream);
705 stream = print_prepare (stream, &frame);
707 write_char_internal ("\n", stream);
708 print_internal (object, stream, 1);
709 write_char_internal ("\n", stream);
710 print_finish (stream, frame);
715 /* Print an error message for the error DATA to STREAM. This is a
716 complete implementation of `display-error', which used to be in
717 Lisp (see prim/cmdloop.el). It was ported to C so it can be used
718 efficiently by Ferror_message_string. Fdisplay_error and
719 Ferror_message_string are trivial wrappers around this function.
721 STREAM should be the result of canonicalize_printcharfun(). */
723 print_error_message (Lisp_Object error_object, Lisp_Object stream)
725 /* This function can GC */
726 Lisp_Object type = Fcar_safe (error_object);
727 Lisp_Object method = Qnil;
730 /* No need to GCPRO anything under the assumption that ERROR_OBJECT
733 if (! (CONSP (error_object) && SYMBOLP (type)
734 && CONSP (Fget (type, Qerror_conditions, Qnil))))
737 tail = XCDR (error_object);
745 tail = Fget (type, Qerror_conditions, Qnil);
748 if (!(CONSP (tail) && SYMBOLP (XCAR (tail))))
750 else if (!NILP (Fget (XCAR (tail), Qdisplay_error, Qnil)))
752 method = Fget (XCAR (tail), Qdisplay_error, Qnil);
761 int speccount = specpdl_depth ();
762 Lisp_Object frame = Qnil;
766 specbind (Qprint_message_label, Qerror);
767 stream = print_prepare (stream, &frame);
769 tail = Fcdr (error_object);
770 if (EQ (type, Qerror))
772 print_internal (Fcar (tail), stream, 0);
777 Lisp_Object errmsg = Fget (type, Qerror_message, Qnil);
779 print_internal (type, stream, 0);
781 print_internal (LISP_GETTEXT (errmsg), stream, 0);
785 write_c_string (first ? ": " : ", ", stream);
786 print_internal (Fcar (tail), stream, 1);
790 print_finish (stream, frame);
792 unbind_to (speccount, Qnil);
800 write_c_string (GETTEXT ("Peculiar error "), stream);
801 print_internal (error_object, stream, 1);
806 call2 (method, error_object, stream);
810 DEFUN ("error-message-string", Ferror_message_string, 1, 1, 0, /*
811 Convert ERROR-OBJECT to an error message, and return it.
813 The format of ERROR-OBJECT should be (ERROR-SYMBOL . DATA). The
814 message is equivalent to the one that would be issued by
815 `display-error' with the same argument.
819 /* This function can GC */
820 Lisp_Object result = Qnil;
821 Lisp_Object stream = make_resizing_buffer_output_stream ();
825 print_error_message (error_object, stream);
826 Lstream_flush (XLSTREAM (stream));
827 result = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
828 Lstream_byte_count (XLSTREAM (stream)));
829 Lstream_delete (XLSTREAM (stream));
835 DEFUN ("display-error", Fdisplay_error, 2, 2, 0, /*
836 Display ERROR-OBJECT on STREAM in a user-friendly way.
838 (error_object, stream))
840 /* This function can GC */
841 print_error_message (error_object, canonicalize_printcharfun (stream));
846 #ifdef LISP_FLOAT_TYPE
848 Lisp_Object Vfloat_output_format;
851 * This buffer should be at least as large as the max string size of the
852 * largest float, printed in the biggest notation. This is undoubtedly
853 * 20d float_output_format, with the negative of the C-constant "HUGE"
856 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
858 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
859 * case of -1e307 in 20d float_output_format. What is one to do (short of
860 * re-writing _doprnt to be more sane)?
864 float_to_string (char *buf, double data)
869 if (NILP (Vfloat_output_format)
870 || !STRINGP (Vfloat_output_format))
872 sprintf (buf, "%.16g", data);
875 /* Check that the spec we have is fully valid.
876 This means not only valid for printf,
877 but meant for floats, and reasonable. */
878 cp = XSTRING_DATA (Vfloat_output_format);
886 for (width = 0; (c = *cp, isdigit (c)); cp++)
892 if (*cp != 'e' && *cp != 'f' && *cp != 'g' && *cp != 'E' && *cp != 'G')
895 if (width < (int) (*cp != 'e' && *cp != 'E') || width > DBL_DIG)
901 sprintf (buf, (char *) XSTRING_DATA (Vfloat_output_format),
905 /* added by jwz: don't allow "1.0" to print as "1"; that destroys
906 the read-equivalence of lisp objects. (* x 1) and (* x 1.0) do
907 not do the same thing, so it's important that the printed
908 representation of that form not be corrupted by the printer.
911 Bufbyte *s = (Bufbyte *) buf; /* don't use signed chars here!
912 isdigit() can't hack them! */
915 /* if there's a non-digit, then there is a decimal point, or
916 it's in exponential notation, both of which are ok. */
919 /* otherwise, we need to hack it. */
926 /* Some machines print "0.4" as ".4". I don't like that. */
927 if (buf [0] == '.' || (buf [0] == '-' && buf [1] == '.'))
930 for (i = strlen (buf) + 1; i >= 0; i--)
932 buf [(buf [0] == '-' ? 1 : 0)] = '0';
935 #endif /* LISP_FLOAT_TYPE */
937 /* Print NUMBER to BUFFER. The digits are first written in reverse
938 order (the least significant digit first), and are then reversed.
939 This is equivalent to sprintf(buffer, "%ld", number), only much
942 BUFFER should accept 24 bytes. This should suffice for the longest
943 numbers on 64-bit machines, including the `-' sign and the trailing
946 long_to_string (char *buffer, long number)
948 #if (SIZEOF_LONG != 4) && (SIZEOF_LONG != 8)
950 sprintf (buffer, "%ld", number);
951 #else /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
961 #define FROB(figure) do { \
962 if (force || number >= figure) \
963 *p++ = number / figure + '0', number %= figure, force = 1; \
966 FROB (1000000000000000000L);
967 FROB (100000000000000000L);
968 FROB (10000000000000000L);
969 FROB (1000000000000000L);
970 FROB (100000000000000L);
971 FROB (10000000000000L);
972 FROB (1000000000000L);
973 FROB (100000000000L);
975 #endif /* SIZEOF_LONG == 8 */
988 #endif /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
992 print_vector_internal (const char *start, const char *end,
994 Lisp_Object printcharfun, int escapeflag)
996 /* This function can GC */
998 int len = XVECTOR_LENGTH (obj);
1000 struct gcpro gcpro1, gcpro2;
1001 GCPRO2 (obj, printcharfun);
1003 if (INTP (Vprint_length))
1005 int max = XINT (Vprint_length);
1006 if (max < len) last = max;
1009 write_c_string (start, printcharfun);
1010 for (i = 0; i < last; i++)
1012 Lisp_Object elt = XVECTOR_DATA (obj)[i];
1013 if (i != 0) write_char_internal (" ", printcharfun);
1014 print_internal (elt, printcharfun, escapeflag);
1018 write_c_string (" ...", printcharfun);
1019 write_c_string (end, printcharfun);
1023 print_cons (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1025 /* This function can GC */
1026 struct gcpro gcpro1, gcpro2;
1028 /* If print_readably is on, print (quote -foo-) as '-foo-
1029 (Yeah, this should really be what print-pretty does, but we
1030 don't have the rest of a pretty printer, and this actually
1031 has non-negligible impact on size/speed of .elc files.)
1033 if (print_readably &&
1034 EQ (XCAR (obj), Qquote) &&
1035 CONSP (XCDR (obj)) &&
1036 NILP (XCDR (XCDR (obj))))
1038 obj = XCAR (XCDR (obj));
1039 GCPRO2 (obj, printcharfun);
1040 write_char_internal ("\'", printcharfun);
1042 print_internal (obj, printcharfun, escapeflag);
1046 GCPRO2 (obj, printcharfun);
1047 write_char_internal ("(", printcharfun);
1051 int max = INTP (Vprint_length) ? XINT (Vprint_length) : INT_MAX;
1052 Lisp_Object tortoise;
1053 /* Use tortoise/hare to make sure circular lists don't infloop */
1055 for (tortoise = obj, len = 0;
1057 obj = XCDR (obj), len++)
1060 write_char_internal (" ", printcharfun);
1061 if (EQ (obj, tortoise) && len > 0)
1064 error ("printing unreadable circular list");
1066 write_c_string ("... <circular list>", printcharfun);
1070 tortoise = XCDR (tortoise);
1073 write_c_string ("...", printcharfun);
1076 print_internal (XCAR (obj), printcharfun, escapeflag);
1081 write_c_string (" . ", printcharfun);
1082 print_internal (obj, printcharfun, escapeflag);
1086 write_char_internal (")", printcharfun);
1091 print_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1093 print_vector_internal ("[", "]", obj, printcharfun, escapeflag);
1097 print_string (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1099 Lisp_String *s = XSTRING (obj);
1100 /* We distinguish between Bytecounts and Charcounts, to make
1101 Vprint_string_length work correctly under Mule. */
1102 Charcount size = string_char_length (s);
1103 Charcount max = size;
1104 Bytecount bcmax = string_length (s);
1105 struct gcpro gcpro1, gcpro2;
1106 GCPRO2 (obj, printcharfun);
1108 if (INTP (Vprint_string_length) &&
1109 XINT (Vprint_string_length) < max)
1111 max = XINT (Vprint_string_length);
1112 bcmax = charcount_to_bytecount (string_data (s), max);
1122 /* This deals with GC-relocation and Mule. */
1123 output_string (printcharfun, 0, obj, 0, bcmax);
1125 write_c_string (" ...", printcharfun);
1129 Bytecount i, last = 0;
1131 write_char_internal ("\"", printcharfun);
1132 for (i = 0; i < bcmax; i++)
1134 Bufbyte ch = string_byte (s, i);
1135 if (ch == '\"' || ch == '\\'
1136 || (ch == '\n' && print_escape_newlines))
1140 output_string (printcharfun, 0, obj, last,
1145 write_c_string ("\\n", printcharfun);
1149 write_char_internal ("\\", printcharfun);
1150 /* This is correct for Mule because the
1151 character is either \ or " */
1152 write_char_internal (string_data (s) + i, printcharfun);
1159 output_string (printcharfun, 0, obj, last,
1163 write_c_string (" ...", printcharfun);
1164 write_char_internal ("\"", printcharfun);
1170 default_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
1173 struct lcrecord_header *header =
1174 (struct lcrecord_header *) XPNTR (obj);
1178 error ("printing unreadable object #<%s 0x%x>",
1179 LHEADER_IMPLEMENTATION (&header->lheader)->name,
1182 sprintf (buf, "#<%s 0x%x>",
1183 LHEADER_IMPLEMENTATION (&header->lheader)->name,
1185 write_c_string (buf, printcharfun);
1189 internal_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
1193 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s) 0x%lx>",
1194 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
1195 (unsigned long) XPNTR (obj));
1196 write_c_string (buf, printcharfun);
1200 print_internal (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1202 /* This function can GC */
1206 /* Emacs won't print while GCing, but an external debugger might */
1207 if (gc_in_progress) return;
1210 /* #### Both input and output streams should have a flag associated
1211 with them indicating whether output to that stream, or strings
1212 read from the stream, get translated using Fgettext(). Such a
1213 stream is called a "translating stream". For the minibuffer and
1214 external-debugging-output this is always true on output, and
1215 with-output-to-temp-buffer sets the flag to true for the buffer
1216 it creates. This flag should also be user-settable. Perhaps it
1217 should be split up into two flags, one for input and one for
1221 /* Detect circularities and truncate them.
1222 No need to offer any alternative--this is better than an error. */
1223 if (CONSP (obj) || VECTORP (obj) || COMPILED_FUNCTIONP (obj))
1226 for (i = 0; i < print_depth; i++)
1227 if (EQ (obj, being_printed[i]))
1231 long_to_string (buf + 1, i);
1232 write_c_string (buf, printcharfun);
1237 being_printed[print_depth] = obj;
1240 if (print_depth > PRINT_CIRCLE)
1241 error ("Apparently circular structure being printed");
1243 switch (XTYPE (obj))
1245 case Lisp_Type_Int_Even:
1246 case Lisp_Type_Int_Odd:
1248 /* ASCII Decimal representation uses 2.4 times as many bits as
1250 char buf[3 * sizeof (EMACS_INT) + 5];
1251 long_to_string (buf, XINT (obj));
1252 write_c_string (buf, printcharfun);
1256 case Lisp_Type_Char:
1258 /* God intended that this be #\..., you know. */
1260 Emchar ch = XCHAR (obj);
1268 case '\t': *p++ = 't'; break;
1269 case '\n': *p++ = 'n'; break;
1270 case '\r': *p++ = 'r'; break;
1274 if ((ch + 64) == '\\')
1281 /* syntactically special characters should be escaped. */
1304 *p++ = '\\', *p++ = '^', *p++ = '?';
1308 *p++ = '\\', *p++ = '^';
1309 p += set_charptr_emchar ((Bufbyte *) p, ch + 64);
1313 p += set_charptr_emchar ((Bufbyte *) p, ch);
1316 output_string (printcharfun, (Bufbyte *) buf, Qnil, 0, p - buf);
1321 case Lisp_Type_Record:
1323 struct lrecord_header *lheader = XRECORD_LHEADER (obj);
1324 struct gcpro gcpro1, gcpro2;
1326 if (CONSP (obj) || VECTORP(obj))
1328 /* If deeper than spec'd depth, print placeholder. */
1329 if (INTP (Vprint_level)
1330 && print_depth > XINT (Vprint_level))
1332 GCPRO2 (obj, printcharfun);
1333 write_c_string ("...", printcharfun);
1339 GCPRO2 (obj, printcharfun);
1340 if (LHEADER_IMPLEMENTATION (lheader)->printer)
1341 ((LHEADER_IMPLEMENTATION (lheader)->printer)
1342 (obj, printcharfun, escapeflag));
1344 default_object_printer (obj, printcharfun, escapeflag);
1351 #ifdef ERROR_CHECK_TYPECHECK
1353 #else /* not ERROR_CHECK_TYPECHECK */
1355 /* We're in trouble if this happens! */
1357 error ("printing illegal data type #o%03o",
1359 write_c_string ("#<EMACS BUG: ILLEGAL DATATYPE ",
1361 sprintf (buf, "(#o%3o)", (int) XTYPE (obj));
1362 write_c_string (buf, printcharfun);
1364 (" Save your buffers immediately and please report this bug>",
1366 #endif /* not ERROR_CHECK_TYPECHECK */
1375 #ifdef LISP_FLOAT_TYPE
1377 print_float (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1379 char pigbuf[350]; /* see comments in float_to_string */
1381 float_to_string (pigbuf, XFLOAT_DATA (obj));
1382 write_c_string (pigbuf, printcharfun);
1384 #endif /* LISP_FLOAT_TYPE */
1387 print_symbol (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1389 /* This function can GC */
1390 /* #### Bug!! (intern "") isn't printed in some distinguished way */
1391 /* #### (the reader also loses on it) */
1392 Lisp_String *name = symbol_name (XSYMBOL (obj));
1393 Bytecount size = string_length (name);
1394 struct gcpro gcpro1, gcpro2;
1398 /* This deals with GC-relocation */
1399 Lisp_Object nameobj;
1400 XSETSTRING (nameobj, name);
1401 output_string (printcharfun, 0, nameobj, 0, size);
1404 GCPRO2 (obj, printcharfun);
1406 /* If we print an uninterned symbol as part of a complex object and
1407 the flag print-gensym is non-nil, prefix it with #n= to read the
1408 object back with the #n# reader syntax later if needed. */
1409 if (!NILP (Vprint_gensym)
1410 /* #### Test whether this produces a noticable slow-down for
1411 printing when print-gensym is non-nil. */
1412 && !EQ (obj, oblookup (Vobarray,
1413 string_data (symbol_name (XSYMBOL (obj))),
1414 string_length (symbol_name (XSYMBOL (obj))))))
1416 if (print_depth > 1)
1418 Lisp_Object tem = Fassq (obj, Vprint_gensym_alist);
1421 write_char_internal ("#", printcharfun);
1422 print_internal (XCDR (tem), printcharfun, escapeflag);
1423 write_char_internal ("#", printcharfun);
1428 if (CONSP (Vprint_gensym_alist))
1430 /* Vprint_gensym_alist is exposed to Lisp, so we
1431 have to be careful. */
1432 CHECK_CONS (XCAR (Vprint_gensym_alist));
1433 CHECK_INT (XCDR (XCAR (Vprint_gensym_alist)));
1434 XSETINT (tem, XINT (XCDR (XCAR (Vprint_gensym_alist))) + 1);
1438 Vprint_gensym_alist = Fcons (Fcons (obj, tem), Vprint_gensym_alist);
1440 write_char_internal ("#", printcharfun);
1441 print_internal (tem, printcharfun, escapeflag);
1442 write_char_internal ("=", printcharfun);
1445 write_c_string ("#:", printcharfun);
1448 /* Does it look like an integer or a float? */
1450 Bufbyte *data = string_data (name);
1451 Bytecount confusing = 0;
1454 goto not_yet_confused; /* Really confusing */
1455 else if (isdigit (data[0]))
1458 goto not_yet_confused;
1459 else if (data[0] == '-' || data[0] == '+')
1462 goto not_yet_confused;
1464 for (; confusing < size; confusing++)
1466 if (!isdigit (data[confusing]))
1474 #ifdef LISP_FLOAT_TYPE
1476 /* #### Ugh, this is needlessly complex and slow for what we
1477 need here. It might be a good idea to copy equivalent code
1478 from FSF. --hniksic */
1479 confusing = isfloat_string ((char *) data);
1482 write_char_internal ("\\", printcharfun);
1486 Lisp_Object nameobj;
1490 XSETSTRING (nameobj, name);
1491 for (i = 0; i < size; i++)
1493 switch (string_byte (name, i))
1495 case 0: case 1: case 2: case 3:
1496 case 4: case 5: case 6: case 7:
1497 case 8: case 9: case 10: case 11:
1498 case 12: case 13: case 14: case 15:
1499 case 16: case 17: case 18: case 19:
1500 case 20: case 21: case 22: case 23:
1501 case 24: case 25: case 26: case 27:
1502 case 28: case 29: case 30: case 31:
1503 case ' ': case '\"': case '\\': case '\'':
1504 case ';': case '#' : case '(' : case ')':
1505 case ',': case '.' : case '`' :
1506 case '[': case ']' : case '?' :
1508 output_string (printcharfun, 0, nameobj, last, i - last);
1509 write_char_internal ("\\", printcharfun);
1513 output_string (printcharfun, 0, nameobj, last, size - last);
1518 /* #ifdef DEBUG_XEMACS */
1520 /* I don't like seeing `Note: Strange doc (not fboundp) for function
1521 alternate-debugging-output @ 429542' -slb */
1522 /* #### Eek! Any clue how to get rid of it? In fact, how about
1523 getting rid of this function altogether? Does anything actually
1524 *use* it? --hniksic */
1526 static int alternate_do_pointer;
1527 static char alternate_do_string[5000];
1529 DEFUN ("alternate-debugging-output", Falternate_debugging_output, 1, 1, 0, /*
1530 Append CHARACTER to the array `alternate_do_string'.
1531 This can be used in place of `external-debugging-output' as a function
1532 to be passed to `print'. Before calling `print', set `alternate_do_pointer'
1537 Bufbyte str[MAX_EMCHAR_LEN];
1540 const Extbyte *extptr;
1542 CHECK_CHAR_COERCE_INT (character);
1543 len = set_charptr_emchar (str, XCHAR (character));
1544 TO_EXTERNAL_FORMAT (DATA, (str, len),
1545 ALLOCA, (extptr, extlen),
1547 memcpy (alternate_do_string + alternate_do_pointer, extptr, extlen);
1548 alternate_do_pointer += extlen;
1549 alternate_do_string[alternate_do_pointer] = 0;
1552 /* #endif / * DEBUG_XEMACS */
1554 DEFUN ("external-debugging-output", Fexternal_debugging_output, 1, 3, 0, /*
1555 Write CHAR-OR-STRING to stderr or stdout.
1556 If optional arg STDOUT-P is non-nil, write to stdout; otherwise, write
1557 to stderr. You can use this function to write directly to the terminal.
1558 This function can be used as the STREAM argument of Fprint() or the like.
1560 Under MS Windows, this writes output to the console window (which is
1561 created, if necessary), unless XEmacs is being run noninteractively
1562 (i.e. using the `-batch' argument).
1564 If you have opened a termscript file (using `open-termscript'), then
1565 the output also will be logged to this file.
1567 (char_or_string, stdout_p, device))
1570 struct console *con = 0;
1574 if (!NILP (stdout_p))
1581 CHECK_LIVE_DEVICE (device);
1582 if (!DEVICE_TTY_P (XDEVICE (device)) &&
1583 !DEVICE_STREAM_P (XDEVICE (device)))
1584 signal_simple_error ("Must be tty or stream device", device);
1585 con = XCONSOLE (DEVICE_CONSOLE (XDEVICE (device)));
1586 if (DEVICE_TTY_P (XDEVICE (device)))
1588 else if (!NILP (stdout_p))
1589 file = CONSOLE_STREAM_DATA (con)->out;
1591 file = CONSOLE_STREAM_DATA (con)->err;
1594 if (STRINGP (char_or_string))
1595 write_string_to_stdio_stream (file, con,
1596 XSTRING_DATA (char_or_string),
1597 0, XSTRING_LENGTH (char_or_string),
1601 Bufbyte str[MAX_EMCHAR_LEN];
1604 CHECK_CHAR_COERCE_INT (char_or_string);
1605 len = set_charptr_emchar (str, XCHAR (char_or_string));
1606 write_string_to_stdio_stream (file, con, str, 0, len, Qterminal, 1);
1609 return char_or_string;
1612 DEFUN ("open-termscript", Fopen_termscript, 1, 1, "FOpen termscript file: ", /*
1613 Start writing all terminal output to FILE as well as the terminal.
1614 FILE = nil means just close any termscript file currently open.
1618 /* This function can GC */
1619 if (termscript != 0)
1620 fclose (termscript);
1625 file = Fexpand_file_name (file, Qnil);
1626 termscript = fopen ((char *) XSTRING_DATA (file), "w");
1627 if (termscript == NULL)
1628 report_file_error ("Opening termscript", list1 (file));
1634 /* Debugging kludge -- unbuffered */
1635 static int debug_print_length = 50;
1636 static int debug_print_level = 15;
1637 static int debug_print_readably = -1;
1640 debug_print_no_newline (Lisp_Object debug_print_obj)
1642 /* This function can GC */
1643 int save_print_readably = print_readably;
1644 int save_print_depth = print_depth;
1645 Lisp_Object save_Vprint_length = Vprint_length;
1646 Lisp_Object save_Vprint_level = Vprint_level;
1647 Lisp_Object save_Vinhibit_quit = Vinhibit_quit;
1648 struct gcpro gcpro1, gcpro2, gcpro3;
1649 GCPRO3 (save_Vprint_level, save_Vprint_length, save_Vinhibit_quit);
1652 stderr_out ("** gc-in-progress! Bad idea to print anything! **\n");
1655 print_readably = debug_print_readably != -1 ? debug_print_readably : 0;
1657 /* Could use unwind-protect, but why bother? */
1658 if (debug_print_length > 0)
1659 Vprint_length = make_int (debug_print_length);
1660 if (debug_print_level > 0)
1661 Vprint_level = make_int (debug_print_level);
1663 print_internal (debug_print_obj, Qexternal_debugging_output, 1);
1665 Vinhibit_quit = save_Vinhibit_quit;
1666 Vprint_level = save_Vprint_level;
1667 Vprint_length = save_Vprint_length;
1668 print_depth = save_print_depth;
1669 print_readably = save_print_readably;
1675 debug_print (Lisp_Object debug_print_obj)
1677 debug_print_no_newline (debug_print_obj);
1681 /* Debugging kludge -- unbuffered */
1682 /* This function provided for the benefit of the debugger. */
1683 void debug_backtrace (void);
1685 debug_backtrace (void)
1687 /* This function can GC */
1688 int old_print_readably = print_readably;
1689 int old_print_depth = print_depth;
1690 Lisp_Object old_print_length = Vprint_length;
1691 Lisp_Object old_print_level = Vprint_level;
1692 Lisp_Object old_inhibit_quit = Vinhibit_quit;
1694 struct gcpro gcpro1, gcpro2, gcpro3;
1695 GCPRO3 (old_print_level, old_print_length, old_inhibit_quit);
1698 stderr_out ("** gc-in-progress! Bad idea to print anything! **\n");
1703 /* Could use unwind-protect, but why bother? */
1704 if (debug_print_length > 0)
1705 Vprint_length = make_int (debug_print_length);
1706 if (debug_print_level > 0)
1707 Vprint_level = make_int (debug_print_level);
1709 Fbacktrace (Qexternal_debugging_output, Qt);
1712 Vinhibit_quit = old_inhibit_quit;
1713 Vprint_level = old_print_level;
1714 Vprint_length = old_print_length;
1715 print_depth = old_print_depth;
1716 print_readably = old_print_readably;
1723 debug_short_backtrace (int length)
1726 struct backtrace *bt = backtrace_list;
1728 while (length > 0 && bt)
1734 if (COMPILED_FUNCTIONP (*bt->function))
1736 #if defined(COMPILED_FUNCTION_ANNOTATION_HACK)
1738 compiled_function_annotation (XCOMPILED_FUNCTION (*bt->function));
1740 Lisp_Object ann = Qnil;
1744 stderr_out ("<compiled-function from ");
1745 debug_print_no_newline (ann);
1750 stderr_out ("<compiled-function of unknown origin>");
1754 debug_print_no_newline (*bt->function);
1762 #endif /* debugging kludge */
1766 syms_of_print (void)
1768 defsymbol (&Qstandard_output, "standard-output");
1770 defsymbol (&Qprint_length, "print-length");
1772 defsymbol (&Qprint_string_length, "print-string-length");
1774 defsymbol (&Qdisplay_error, "display-error");
1775 defsymbol (&Qprint_message_label, "print-message-label");
1778 DEFSUBR (Fprin1_to_string);
1781 DEFSUBR (Ferror_message_string);
1782 DEFSUBR (Fdisplay_error);
1784 DEFSUBR (Fwrite_char);
1785 DEFSUBR (Falternate_debugging_output);
1786 DEFSUBR (Fexternal_debugging_output);
1787 DEFSUBR (Fopen_termscript);
1788 defsymbol (&Qexternal_debugging_output, "external-debugging-output");
1789 DEFSUBR (Fwith_output_to_temp_buffer);
1793 reinit_vars_of_print (void)
1795 alternate_do_pointer = 0;
1799 vars_of_print (void)
1801 reinit_vars_of_print ();
1803 DEFVAR_LISP ("standard-output", &Vstandard_output /*
1804 Output stream `print' uses by default for outputting a character.
1805 This may be any function of one argument.
1806 It may also be a buffer (output is inserted before point)
1807 or a marker (output is inserted and the marker is advanced)
1808 or the symbol t (output appears in the minibuffer line).
1810 Vstandard_output = Qt;
1812 #ifdef LISP_FLOAT_TYPE
1813 DEFVAR_LISP ("float-output-format", &Vfloat_output_format /*
1814 The format descriptor string that lisp uses to print floats.
1815 This is a %-spec like those accepted by `printf' in C,
1816 but with some restrictions. It must start with the two characters `%.'.
1817 After that comes an integer precision specification,
1818 and then a letter which controls the format.
1819 The letters allowed are `e', `f' and `g'.
1820 Use `e' for exponential notation "DIG.DIGITSeEXPT"
1821 Use `f' for decimal point notation "DIGITS.DIGITS".
1822 Use `g' to choose the shorter of those two formats for the number at hand.
1823 The precision in any of these cases is the number of digits following
1824 the decimal point. With `f', a precision of 0 means to omit the
1825 decimal point. 0 is not allowed with `f' or `g'.
1827 A value of nil means to use `%.16g'.
1829 Regardless of the value of `float-output-format', a floating point number
1830 will never be printed in such a way that it is ambiguous with an integer;
1831 that is, a floating-point number will always be printed with a decimal
1832 point and/or an exponent, even if the digits following the decimal point
1833 are all zero. This is to preserve read-equivalence.
1835 Vfloat_output_format = Qnil;
1836 #endif /* LISP_FLOAT_TYPE */
1838 DEFVAR_LISP ("print-length", &Vprint_length /*
1839 Maximum length of list or vector to print before abbreviating.
1840 A value of nil means no limit.
1842 Vprint_length = Qnil;
1844 DEFVAR_LISP ("print-string-length", &Vprint_string_length /*
1845 Maximum length of string to print before abbreviating.
1846 A value of nil means no limit.
1848 Vprint_string_length = Qnil;
1850 DEFVAR_LISP ("print-level", &Vprint_level /*
1851 Maximum depth of list nesting to print before abbreviating.
1852 A value of nil means no limit.
1854 Vprint_level = Qnil;
1856 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines /*
1857 Non-nil means print newlines in strings as backslash-n.
1859 print_escape_newlines = 0;
1861 DEFVAR_BOOL ("print-readably", &print_readably /*
1862 If non-nil, then all objects will be printed in a readable form.
1863 If an object has no readable representation, then an error is signalled.
1864 When print-readably is true, compiled-function objects will be written in
1865 #[...] form instead of in #<compiled-function [...]> form, and two-element
1866 lists of the form (quote object) will be written as the equivalent 'object.
1867 Do not SET this variable; bind it instead.
1871 /* #### I think this should default to t. But we'd better wait
1872 until we see that it works out. */
1873 DEFVAR_LISP ("print-gensym", &Vprint_gensym /*
1874 If non-nil, then uninterned symbols will be printed specially.
1875 Uninterned symbols are those which are not present in `obarray', that is,
1876 those which were made with `make-symbol' or by calling `intern' with a
1879 When print-gensym is true, such symbols will be preceded by "#:",
1880 which causes the reader to create a new symbol instead of interning
1881 and returning an existing one. Beware: the #: syntax creates a new
1882 symbol each time it is seen, so if you print an object which contains
1883 two pointers to the same uninterned symbol, `read' will not duplicate
1886 If the value of `print-gensym' is a cons cell, then in addition
1887 refrain from clearing `print-gensym-alist' on entry to and exit from
1888 printing functions, so that the use of #...# and #...= can carry over
1889 for several separately printed objects.
1891 Vprint_gensym = Qnil;
1893 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist /*
1894 Association list of elements (GENSYM . N) to guide use of #N# and #N=.
1895 In each element, GENSYM is an uninterned symbol that has been associated
1896 with #N= for the specified value of N.
1898 Vprint_gensym_alist = Qnil;
1900 DEFVAR_LISP ("print-message-label", &Vprint_message_label /*
1901 Label for minibuffer messages created with `print'. This should
1902 generally be bound with `let' rather than set. (See `display-message'.)
1904 Vprint_message_label = Qprint;