1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 1986, 1988, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995, 1996 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"
43 /* Define if not in float.h */
48 Lisp_Object Vstandard_output, Qstandard_output;
50 /* The subroutine object for external-debugging-output is kept here
51 for the convenience of the debugger. */
52 Lisp_Object Qexternal_debugging_output;
53 Lisp_Object Qalternate_debugging_output;
55 /* Avoid actual stack overflow in print. */
56 static int print_depth;
58 /* Detect most circularities to print finite output. */
59 #define PRINT_CIRCLE 200
60 Lisp_Object being_printed[PRINT_CIRCLE];
62 /* Maximum length of list or vector to print in full; noninteger means
63 effectively infinity */
65 Lisp_Object Vprint_length;
66 Lisp_Object Qprint_length;
68 /* Maximum length of string to print in full; noninteger means
69 effectively infinity */
71 Lisp_Object Vprint_string_length;
72 Lisp_Object Qprint_string_length;
74 /* Maximum depth of list to print in full; noninteger means
75 effectively infinity. */
77 Lisp_Object Vprint_level;
79 /* Label to use when making echo-area messages. */
81 Lisp_Object Vprint_message_label;
83 /* Nonzero means print newlines in strings as \n. */
85 int print_escape_newlines;
88 /* Non-nil means print #: before uninterned symbols.
89 Neither t nor nil means so that and don't clear Vprint_gensym_alist
90 on entry to and exit from print functions. */
91 Lisp_Object Vprint_gensym;
92 Lisp_Object Vprint_gensym_alist;
94 Lisp_Object Qprint_escape_newlines;
95 Lisp_Object Qprint_readably;
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;
109 /* Write a string (in internal format) to stdio stream STREAM. */
112 write_string_to_stdio_stream (FILE *stream, struct console *con,
114 Bytecount offset, Bytecount len,
115 enum external_data_format fmt)
118 CONST Extbyte *extptr;
120 GET_CHARPTR_EXT_DATA_ALLOCA (str + offset, len, fmt, extptr, extlen);
123 fwrite (extptr, 1, extlen, stream);
125 /* Q122442 says that pipes are "treated as files, not as
126 devices", and that this is a feature. Before I found that
127 article, I thought it was a bug. Thanks MS, I feel much
129 if (stream == stdout || stream == stderr)
135 assert (CONSOLE_TTY_P (con));
136 Lstream_write (XLSTREAM (CONSOLE_TTY_DATA (con)->outstream),
139 if (stream == stdout || stream == stderr ||
140 (!stream && CONSOLE_TTY_DATA (con)->is_stdio))
144 fwrite (extptr, 1, extlen, termscript);
147 stdout_needs_newline = (extptr[extlen - 1] != '\n');
151 /* Write a string to the output location specified in FUNCTION.
152 Arguments NONRELOC, RELOC, OFFSET, and LEN are as in
153 buffer_insert_string_1() in insdel.c. */
156 output_string (Lisp_Object function, CONST Bufbyte *nonreloc,
157 Lisp_Object reloc, Bytecount offset, Bytecount len)
159 /* This function can GC */
161 /* We change the value of nonreloc (fetching it from reloc as
162 necessary), but we don't want to pass this changed value on to
163 other functions that take both a nonreloc and a reloc, or things
164 may get confused and an assertion failure in
165 fixup_internal_substring() may get triggered. */
166 CONST Bufbyte *newnonreloc = nonreloc;
167 struct gcpro gcpro1, gcpro2;
169 /* Emacs won't print whilst GCing, but an external debugger might */
170 if (gc_in_progress) return;
172 /* Perhaps not necessary but probably safer. */
173 GCPRO2 (function, reloc);
175 fixup_internal_substring (newnonreloc, reloc, offset, &len);
178 newnonreloc = XSTRING_DATA (reloc);
180 cclen = bytecount_to_charcount (newnonreloc + offset, len);
182 if (LSTREAMP (function))
186 /* Protect against Lstream_write() causing a GC and
187 relocating the string. For small strings, we do it by
188 alloc'ing the string and using a copy; for large strings,
192 Bufbyte *copied = alloca_array (Bufbyte, len);
193 memcpy (copied, newnonreloc + offset, len);
194 Lstream_write (XLSTREAM (function), copied, len);
198 int speccount = specpdl_depth ();
199 record_unwind_protect (restore_gc_inhibit,
200 make_int (gc_currently_forbidden));
201 gc_currently_forbidden = 1;
202 Lstream_write (XLSTREAM (function), newnonreloc + offset, len);
203 unbind_to (speccount, Qnil);
207 Lstream_write (XLSTREAM (function), newnonreloc + offset, len);
209 if (print_unbuffered)
210 Lstream_flush (XLSTREAM (function));
212 else if (BUFFERP (function))
214 CHECK_LIVE_BUFFER (function);
215 buffer_insert_string (XBUFFER (function), nonreloc, reloc, offset, len);
217 else if (MARKERP (function))
219 /* marker_position() will err if marker doesn't point anywhere. */
220 Bufpos spoint = marker_position (function);
222 buffer_insert_string_1 (XMARKER (function)->buffer,
223 spoint, nonreloc, reloc, offset, len,
225 Fset_marker (function, make_int (spoint + cclen),
226 Fmarker_buffer (function));
228 else if (FRAMEP (function))
230 /* This gets used by functions not invoking print_prepare(),
231 such as Fwrite_char, Fterpri, etc.. */
232 struct frame *f = XFRAME (function);
233 CHECK_LIVE_FRAME (function);
235 if (!EQ (Vprint_message_label, echo_area_status (f)))
236 clear_echo_area_from_print (f, Qnil, 1);
237 echo_area_append (f, nonreloc, reloc, offset, len, Vprint_message_label);
239 else if (EQ (function, Qt) || EQ (function, Qnil))
241 write_string_to_stdio_stream (stdout, 0, newnonreloc, offset, len,
246 Charcount ccoff = bytecount_to_charcount (newnonreloc, offset);
249 for (iii = ccoff; iii < cclen + ccoff; iii++)
252 make_char (charptr_emchar_n (newnonreloc, iii)));
254 newnonreloc = XSTRING_DATA (reloc);
261 #define RESET_PRINT_GENSYM do { \
262 if (!CONSP (Vprint_gensym)) \
263 Vprint_gensym_alist = Qnil; \
267 canonicalize_printcharfun (Lisp_Object printcharfun)
269 if (NILP (printcharfun))
270 printcharfun = Vstandard_output;
272 if (EQ (printcharfun, Qt) || NILP (printcharfun))
273 printcharfun = Fselected_frame (Qnil); /* print to minibuffer */
279 print_prepare (Lisp_Object printcharfun, Lisp_Object *frame_kludge)
281 /* Emacs won't print whilst GCing, but an external debugger might */
287 printcharfun = canonicalize_printcharfun (printcharfun);
289 /* Here we could safely return the canonicalized PRINTCHARFUN.
290 However, if PRINTCHARFUN is a frame, printing of complex
291 structures becomes very expensive, because `append-message'
292 (called by echo_area_append) gets called as many times as
293 output_string() is called (and that's a *lot*). append-message
294 tries to keep top of the message-stack in sync with the contents
295 of " *Echo Area" buffer, consing a new string for each component
296 of the printed structure. For instance, if you print (a a),
297 append-message will cons up the following strings:
305 and will use only the last one. With larger objects, this turns
306 into an O(n^2) consing frenzy that locks up XEmacs in incessant
309 We prevent this by creating a resizing_buffer stream and letting
310 the printer write into it. print_finish() will notice this
311 stream, and invoke echo_area_append() with the stream's buffer,
313 if (FRAMEP (printcharfun))
315 CHECK_LIVE_FRAME (printcharfun);
316 *frame_kludge = printcharfun;
317 printcharfun = make_resizing_buffer_output_stream ();
324 print_finish (Lisp_Object stream, Lisp_Object frame_kludge)
326 /* Emacs won't print whilst GCing, but an external debugger might */
332 /* See the comment in print_prepare(). */
333 if (FRAMEP (frame_kludge))
335 struct frame *f = XFRAME (frame_kludge);
336 Lstream *str = XLSTREAM (stream);
337 CHECK_LIVE_FRAME (frame_kludge);
340 if (!EQ (Vprint_message_label, echo_area_status (f)))
341 clear_echo_area_from_print (f, Qnil, 1);
342 echo_area_append (f, resizing_buffer_stream_ptr (str),
343 Qnil, 0, Lstream_byte_count (str),
344 Vprint_message_label);
345 Lstream_delete (str);
349 /* Used for printing a single-byte character (*not* any Emchar). */
350 #define write_char_internal(string_of_length_1, stream) \
351 output_string (stream, (CONST Bufbyte *) (string_of_length_1), \
354 /* NOTE: Do not call this with the data of a Lisp_String, as
355 printcharfun might cause a GC, which might cause the string's data
356 to be relocated. To princ a Lisp string, use:
358 print_internal (string, printcharfun, 0);
360 Also note that STREAM should be the result of
361 canonicalize_printcharfun() (i.e. Qnil means stdout, not
362 Vstandard_output, etc.) */
364 write_string_1 (CONST Bufbyte *str, Bytecount size, Lisp_Object stream)
366 /* This function can GC */
367 #ifdef ERROR_CHECK_BUFPOS
370 output_string (stream, str, Qnil, 0, size);
374 write_c_string (CONST char *str, Lisp_Object stream)
376 /* This function can GC */
377 write_string_1 ((CONST Bufbyte *) str, strlen (str), stream);
381 DEFUN ("write-char", Fwrite_char, 1, 2, 0, /*
382 Output character CH to stream STREAM.
383 STREAM defaults to the value of `standard-output' (which see).
387 /* This function can GC */
388 Bufbyte str[MAX_EMCHAR_LEN];
391 CHECK_CHAR_COERCE_INT (ch);
392 len = set_charptr_emchar (str, XCHAR (ch));
393 output_string (canonicalize_printcharfun (stream), str, Qnil, 0, len);
398 temp_output_buffer_setup (CONST char *bufname)
400 /* This function can GC */
401 struct buffer *old = current_buffer;
405 /* #### This function should accept a Lisp_Object instead of a char *,
406 so that proper translation on the buffer name can occur. */
409 Fset_buffer (Fget_buffer_create (build_string (bufname)));
411 current_buffer->read_only = Qnil;
412 Ferase_buffer (Qnil);
414 XSETBUFFER (buf, current_buffer);
415 specbind (Qstandard_output, buf);
417 set_buffer_internal (old);
421 internal_with_output_to_temp_buffer (CONST char *bufname,
422 Lisp_Object (*function) (Lisp_Object arg),
424 Lisp_Object same_frame)
426 int speccount = specpdl_depth ();
427 struct gcpro gcpro1, gcpro2, gcpro3;
428 Lisp_Object buf = Qnil;
430 GCPRO3 (buf, arg, same_frame);
432 temp_output_buffer_setup (GETTEXT (bufname));
433 buf = Vstandard_output;
435 arg = (*function) (arg);
437 temp_output_buffer_show (buf, same_frame);
440 return unbind_to (speccount, arg);
443 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, 1, UNEVALLED, 0, /*
444 Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
445 The buffer is cleared out initially, and marked as unmodified when done.
446 All output done by BODY is inserted in that buffer by default.
447 The buffer is displayed in another window, but not selected.
448 The value of the last form in BODY is returned.
449 If BODY does not finish normally, the buffer BUFNAME is not displayed.
451 If variable `temp-buffer-show-function' is non-nil, call it at the end
452 to get the buffer displayed. It gets one argument, the buffer to display.
456 /* This function can GC */
459 int speccount = specpdl_depth ();
463 /* #### should set the buffer to be translating. See print_internal(). */
467 name = Feval (XCAR (args));
471 temp_output_buffer_setup ((char *) XSTRING_DATA (name));
473 val = Fprogn (XCDR (args));
475 temp_output_buffer_show (Vstandard_output, Qnil);
477 return unbind_to (speccount, val);
480 DEFUN ("terpri", Fterpri, 0, 1, 0, /*
481 Output a newline to STREAM.
482 If STREAM is omitted or nil, the value of `standard-output' is used.
486 /* This function can GC */
487 write_char_internal ("\n", canonicalize_printcharfun (stream));
491 DEFUN ("prin1", Fprin1, 1, 2, 0, /*
492 Output the printed representation of OBJECT, any Lisp object.
493 Quoting characters are printed when needed to make output that `read'
494 can handle, whenever this is possible.
495 Output stream is STREAM, or value of `standard-output' (which see).
499 /* This function can GC */
500 Lisp_Object frame = Qnil;
501 struct gcpro gcpro1, gcpro2;
502 GCPRO2 (object, stream);
505 stream = print_prepare (stream, &frame);
506 print_internal (object, stream, 1);
507 print_finish (stream, frame);
513 DEFUN ("prin1-to-string", Fprin1_to_string, 1, 2, 0, /*
514 Return a string containing the printed representation of OBJECT,
515 any Lisp object. Quoting characters are used when needed to make output
516 that `read' can handle, whenever this is possible, unless the optional
517 second argument NOESCAPE is non-nil.
521 /* This function can GC */
522 Lisp_Object result = Qnil;
523 Lisp_Object stream = make_resizing_buffer_output_stream ();
524 Lstream *str = XLSTREAM (stream);
525 /* gcpro OBJECT in case a caller forgot to do so */
526 struct gcpro gcpro1, gcpro2, gcpro3;
527 GCPRO3 (object, stream, result);
531 print_internal (object, stream, NILP (noescape));
535 result = make_string (resizing_buffer_stream_ptr (str),
536 Lstream_byte_count (str));
537 Lstream_delete (str);
541 DEFUN ("princ", Fprinc, 1, 2, 0, /*
542 Output the printed representation of OBJECT, any Lisp object.
543 No quoting characters are used; no delimiters are printed around
544 the contents of strings.
545 Output stream is STREAM, or value of standard-output (which see).
549 /* This function can GC */
550 Lisp_Object frame = Qnil;
551 struct gcpro gcpro1, gcpro2;
553 GCPRO2 (object, stream);
554 stream = print_prepare (stream, &frame);
556 print_internal (object, stream, 0);
557 print_finish (stream, frame);
562 DEFUN ("print", Fprint, 1, 2, 0, /*
563 Output the printed representation of OBJECT, with newlines around it.
564 Quoting characters are printed when needed to make output that `read'
565 can handle, whenever this is possible.
566 Output stream is STREAM, or value of `standard-output' (which see).
570 /* This function can GC */
571 Lisp_Object frame = Qnil;
572 struct gcpro gcpro1, gcpro2;
574 GCPRO2 (object, stream);
575 stream = print_prepare (stream, &frame);
577 write_char_internal ("\n", stream);
578 print_internal (object, stream, 1);
579 write_char_internal ("\n", stream);
580 print_finish (stream, frame);
585 /* Print an error message for the error DATA to STREAM. This is a
586 complete implementation of `display-error', which used to be in
587 Lisp (see prim/cmdloop.el). It was ported to C so it can be used
588 efficiently by Ferror_message_string. Fdisplay_error and
589 Ferror_message_string are trivial wrappers around this function.
591 STREAM should be the result of canonicalize_printcharfun(). */
593 print_error_message (Lisp_Object error_object, Lisp_Object stream)
595 /* This function can GC */
596 Lisp_Object type = Fcar_safe (error_object);
597 Lisp_Object method = Qnil;
600 /* No need to GCPRO anything under the assumption that ERROR_OBJECT
603 if (! (CONSP (error_object) && SYMBOLP (type)
604 && CONSP (Fget (type, Qerror_conditions, Qnil))))
607 tail = XCDR (error_object);
615 tail = Fget (type, Qerror_conditions, Qnil);
618 if (!(CONSP (tail) && SYMBOLP (XCAR (tail))))
620 else if (!NILP (Fget (XCAR (tail), Qdisplay_error, Qnil)))
622 method = Fget (XCAR (tail), Qdisplay_error, Qnil);
631 int speccount = specpdl_depth ();
633 specbind (Qprint_message_label, Qerror);
634 tail = Fcdr (error_object);
635 if (EQ (type, Qerror))
637 print_internal (Fcar (tail), stream, 0);
642 Lisp_Object errmsg = Fget (type, Qerror_message, Qnil);
644 print_internal (type, stream, 0);
646 print_internal (LISP_GETTEXT (errmsg), stream, 0);
650 write_c_string (first ? ": " : ", ", stream);
651 print_internal (Fcar (tail), stream, 1);
655 unbind_to (speccount, Qnil);
663 write_c_string (GETTEXT ("Peculiar error "), stream);
664 print_internal (error_object, stream, 1);
669 call2 (method, error_object, stream);
673 DEFUN ("error-message-string", Ferror_message_string, 1, 1, 0, /*
674 Convert ERROR-OBJECT to an error message, and return it.
676 The format of ERROR-OBJECT should be (ERROR-SYMBOL . DATA). The
677 message is equivalent to the one that would be issued by
678 `display-error' with the same argument.
682 /* This function can GC */
683 Lisp_Object result = Qnil;
684 Lisp_Object stream = make_resizing_buffer_output_stream ();
688 print_error_message (error_object, stream);
689 Lstream_flush (XLSTREAM (stream));
690 result = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
691 Lstream_byte_count (XLSTREAM (stream)));
692 Lstream_delete (XLSTREAM (stream));
698 DEFUN ("display-error", Fdisplay_error, 2, 2, 0, /*
699 Display ERROR-OBJECT on STREAM in a user-friendly way.
701 (error_object, stream))
703 /* This function can GC */
704 print_error_message (error_object, canonicalize_printcharfun (stream));
709 #ifdef LISP_FLOAT_TYPE
711 Lisp_Object Vfloat_output_format;
712 Lisp_Object Qfloat_output_format;
715 * This buffer should be at least as large as the max string size of the
716 * largest float, printed in the biggest notation. This is undoubtably
717 * 20d float_output_format, with the negative of the C-constant "HUGE"
720 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
722 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
723 * case of -1e307 in 20d float_output_format. What is one to do (short of
724 * re-writing _doprnt to be more sane)?
728 float_to_string (char *buf, double data)
733 if (NILP (Vfloat_output_format)
734 || !STRINGP (Vfloat_output_format))
736 sprintf (buf, "%.16g", data);
739 /* Check that the spec we have is fully valid.
740 This means not only valid for printf,
741 but meant for floats, and reasonable. */
742 cp = XSTRING_DATA (Vfloat_output_format);
750 for (width = 0; (c = *cp, isdigit (c)); cp++)
756 if (*cp != 'e' && *cp != 'f' && *cp != 'g' && *cp != 'E' && *cp != 'G')
759 if (width < (int) (*cp != 'e' && *cp != 'E') || width > DBL_DIG)
765 sprintf (buf, (char *) XSTRING_DATA (Vfloat_output_format),
769 /* added by jwz: don't allow "1.0" to print as "1"; that destroys
770 the read-equivalence of lisp objects. (* x 1) and (* x 1.0) do
771 not do the same thing, so it's important that the printed
772 representation of that form not be corrupted by the printer.
775 Bufbyte *s = (Bufbyte *) buf; /* don't use signed chars here!
776 isdigit() can't hack them! */
779 /* if there's a non-digit, then there is a decimal point, or
780 it's in exponential notation, both of which are ok. */
783 /* otherwise, we need to hack it. */
790 /* Some machines print "0.4" as ".4". I don't like that. */
791 if (buf [0] == '.' || (buf [0] == '-' && buf [1] == '.'))
794 for (i = strlen (buf) + 1; i >= 0; i--)
796 buf [(buf [0] == '-' ? 1 : 0)] = '0';
799 #endif /* LISP_FLOAT_TYPE */
801 /* Print NUMBER to BUFFER. The digits are first written in reverse
802 order (the least significant digit first), and are then reversed.
803 This is equivalent to sprintf(buffer, "%ld", number), only much
806 BUFFER should accept 24 bytes. This should suffice for the longest
807 numbers on 64-bit machines. */
809 long_to_string (char *buffer, long number)
821 /* Print the digits to the string. */
824 *p++ = number % 10 + '0';
829 /* And reverse them. */
830 len = p - buffer - 1;
831 for (i = len / 2; i >= 0; i--)
834 buffer[i] = buffer[len - i];
837 buffer[len + 1] = '\0';
841 print_vector_internal (CONST char *start, CONST char *end,
843 Lisp_Object printcharfun, int escapeflag)
845 /* This function can GC */
847 int len = XVECTOR_LENGTH (obj);
849 struct gcpro gcpro1, gcpro2;
850 GCPRO2 (obj, printcharfun);
852 if (INTP (Vprint_length))
854 int max = XINT (Vprint_length);
855 if (max < len) last = max;
858 write_c_string (start, printcharfun);
859 for (i = 0; i < last; i++)
861 Lisp_Object elt = XVECTOR_DATA (obj)[i];
862 if (i != 0) write_char_internal (" ", printcharfun);
863 print_internal (elt, printcharfun, escapeflag);
867 write_c_string (" ...", printcharfun);
868 write_c_string (end, printcharfun);
872 print_cons (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
874 /* This function can GC */
875 struct gcpro gcpro1, gcpro2;
877 /* If print_readably is on, print (quote -foo-) as '-foo-
878 (Yeah, this should really be what print-pretty does, but we
879 don't have the rest of a pretty printer, and this actually
880 has non-negligible impact on size/speed of .elc files.)
882 if (print_readably &&
883 EQ (XCAR (obj), Qquote) &&
884 CONSP (XCDR (obj)) &&
885 NILP (XCDR (XCDR (obj))))
887 obj = XCAR (XCDR (obj));
888 GCPRO2 (obj, printcharfun);
889 write_char_internal ("\'", printcharfun);
891 print_internal (obj, printcharfun, escapeflag);
895 GCPRO2 (obj, printcharfun);
896 write_char_internal ("(", printcharfun);
902 if (INTP (Vprint_length))
903 max = XINT (Vprint_length);
907 write_char_internal (" ", printcharfun);
910 write_c_string ("...", printcharfun);
913 print_internal (XCAR (obj), printcharfun,
920 write_c_string (" . ", printcharfun);
921 print_internal (obj, printcharfun, escapeflag);
924 write_char_internal (")", printcharfun);
929 print_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
931 print_vector_internal ("[", "]", obj, printcharfun, escapeflag);
935 print_string (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
937 struct Lisp_String *s = XSTRING (obj);
938 /* We distinguish between Bytecounts and Charcounts, to make
939 Vprint_string_length work correctly under Mule. */
940 Charcount size = string_char_length (s);
941 Charcount max = size;
942 Bytecount bcmax = string_length (s);
943 struct gcpro gcpro1, gcpro2;
944 GCPRO2 (obj, printcharfun);
946 if (INTP (Vprint_string_length) &&
947 XINT (Vprint_string_length) < max)
949 max = XINT (Vprint_string_length);
950 bcmax = charcount_to_bytecount (string_data (s), max);
960 /* This deals with GC-relocation and Mule. */
961 output_string (printcharfun, 0, obj, 0, bcmax);
963 write_c_string (" ...", printcharfun);
967 Bytecount i, last = 0;
969 write_char_internal ("\"", printcharfun);
970 for (i = 0; i < bcmax; i++)
972 Bufbyte ch = string_byte (s, i);
973 if (ch == '\"' || ch == '\\'
974 || (ch == '\n' && print_escape_newlines))
978 output_string (printcharfun, 0, obj, last,
983 write_c_string ("\\n", printcharfun);
987 write_char_internal ("\\", printcharfun);
988 /* This is correct for Mule because the
989 character is either \ or " */
990 write_char_internal (string_data (s) + i, printcharfun);
997 output_string (printcharfun, 0, obj, last,
1001 write_c_string (" ...", printcharfun);
1002 write_char_internal ("\"", printcharfun);
1008 default_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
1011 struct lcrecord_header *header =
1012 (struct lcrecord_header *) XPNTR (obj);
1016 error ("printing unreadable object #<%s 0x%x>",
1017 LHEADER_IMPLEMENTATION (&header->lheader)->name,
1020 sprintf (buf, "#<%s 0x%x>",
1021 LHEADER_IMPLEMENTATION (&header->lheader)->name,
1023 write_c_string (buf, printcharfun);
1027 internal_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
1031 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s) 0x%lx>",
1032 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
1033 (unsigned long) XPNTR (obj));
1034 write_c_string (buf, printcharfun);
1038 print_internal (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1040 /* This function can GC */
1044 /* Emacs won't print whilst GCing, but an external debugger might */
1045 if (gc_in_progress) return;
1048 /* #### Both input and output streams should have a flag associated
1049 with them indicating whether output to that stream, or strings
1050 read from the stream, get translated using Fgettext(). Such a
1051 stream is called a "translating stream". For the minibuffer and
1052 external-debugging-output this is always true on output, and
1053 with-output-to-temp-buffer sets the flag to true for the buffer
1054 it creates. This flag should also be user-settable. Perhaps it
1055 should be split up into two flags, one for input and one for
1059 /* Detect circularities and truncate them.
1060 No need to offer any alternative--this is better than an error. */
1061 if (CONSP (obj) || VECTORP (obj) || COMPILED_FUNCTIONP (obj))
1064 for (i = 0; i < print_depth; i++)
1065 if (EQ (obj, being_printed[i]))
1069 long_to_string (buf + 1, i);
1070 write_c_string (buf, printcharfun);
1075 being_printed[print_depth] = obj;
1078 if (print_depth > PRINT_CIRCLE)
1079 error ("Apparently circular structure being printed");
1081 switch (XTYPE (obj))
1083 #ifdef USE_MINIMAL_TAGBITS
1084 case Lisp_Type_Int_Even:
1085 case Lisp_Type_Int_Odd:
1091 long_to_string (buf, XINT (obj));
1092 write_c_string (buf, printcharfun);
1096 case Lisp_Type_Char:
1098 /* God intended that this be #\..., you know. */
1100 Emchar ch = XCHAR (obj);
1104 *p++ = '\\', *p++ = 'n';
1105 else if (ch == '\r')
1106 *p++ = '\\', *p++ = 'r';
1107 else if (ch == '\t')
1108 *p++ = '\\', *p++ = 't';
1111 *p++ = '\\', *p++ = '^';
1113 if ((ch + 64) == '\\')
1117 *p++ = '\\', *p++ = '^', *p++ = '?';
1118 else if (ch >= 128 && ch < 160)
1120 *p++ = '\\', *p++ = '^';
1121 p += set_charptr_emchar ((Bufbyte *)p, ch + 64);
1126 && ch != '^') /* must not backslash this or it will
1127 be interpreted as the start of a
1129 *p++ = '\\', *p++ = ch;
1131 p += set_charptr_emchar ((Bufbyte *)p, ch);
1132 output_string (printcharfun, (Bufbyte *)buf, Qnil, 0, p - buf);
1136 #ifndef LRECORD_STRING
1137 case Lisp_Type_String:
1139 print_string (obj, printcharfun, escapeflag);
1142 #endif /* ! LRECORD_STRING */
1144 #ifndef LRECORD_CONS
1145 case Lisp_Type_Cons:
1147 struct gcpro gcpro1, gcpro2;
1149 /* If deeper than spec'd depth, print placeholder. */
1150 if (INTP (Vprint_level)
1151 && print_depth > XINT (Vprint_level))
1153 GCPRO2 (obj, printcharfun);
1154 write_c_string ("...", printcharfun);
1159 print_cons (obj, printcharfun, escapeflag);
1162 #endif /* ! LRECORD_CONS */
1164 #ifndef LRECORD_VECTOR
1165 case Lisp_Type_Vector:
1167 /* If deeper than spec'd depth, print placeholder. */
1168 if (INTP (Vprint_level)
1169 && print_depth > XINT (Vprint_level))
1171 struct gcpro gcpro1, gcpro2;
1172 GCPRO2 (obj, printcharfun);
1173 write_c_string ("...", printcharfun);
1178 /* God intended that this be #(...), you know. */
1179 print_vector_internal ("[", "]", obj, printcharfun, escapeflag);
1182 #endif /* !LRECORD_VECTOR */
1184 #ifndef LRECORD_SYMBOL
1185 case Lisp_Type_Symbol:
1187 print_symbol (obj, printcharfun, escapeflag);
1190 #endif /* !LRECORD_SYMBOL */
1192 case Lisp_Type_Record:
1194 struct lrecord_header *lheader = XRECORD_LHEADER (obj);
1195 struct gcpro gcpro1, gcpro2;
1197 #if defined(LRECORD_CONS) || defined(LRECORD_VECTOR)
1198 if (CONSP (obj) || VECTORP(obj))
1200 /* If deeper than spec'd depth, print placeholder. */
1201 if (INTP (Vprint_level)
1202 && print_depth > XINT (Vprint_level))
1204 GCPRO2 (obj, printcharfun);
1205 write_c_string ("...", printcharfun);
1212 GCPRO2 (obj, printcharfun);
1213 if (LHEADER_IMPLEMENTATION (lheader)->printer)
1214 ((LHEADER_IMPLEMENTATION (lheader)->printer)
1215 (obj, printcharfun, escapeflag));
1217 default_object_printer (obj, printcharfun, escapeflag);
1224 #ifdef ERROR_CHECK_TYPECHECK
1226 #else /* not ERROR_CHECK_TYPECHECK */
1228 /* We're in trouble if this happens! */
1230 error ("printing illegal data type #o%03o",
1232 write_c_string ("#<EMACS BUG: ILLEGAL DATATYPE ",
1234 sprintf (buf, "(#o%3o)", (int) XTYPE (obj));
1235 write_c_string (buf, printcharfun);
1237 (" Save your buffers immediately and please report this bug>",
1239 #endif /* not ERROR_CHECK_TYPECHECK */
1248 print_compiled_function_internal (CONST char *start, CONST char *end,
1250 Lisp_Object printcharfun, int escapeflag)
1252 /* This function can GC */
1253 struct Lisp_Compiled_Function *b =
1254 XCOMPILED_FUNCTION (obj); /* GC doesn't relocate */
1255 int docp = b->flags.documentationp;
1256 int intp = b->flags.interactivep;
1257 struct gcpro gcpro1, gcpro2;
1259 GCPRO2 (obj, printcharfun);
1261 write_c_string (start, printcharfun);
1262 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1263 if (!print_readably)
1265 Lisp_Object ann = compiled_function_annotation (b);
1268 write_c_string ("(from ", printcharfun);
1269 print_internal (ann, printcharfun, 1);
1270 write_c_string (") ", printcharfun);
1273 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
1274 /* COMPILED_ARGLIST = 0 */
1275 print_internal (b->arglist, printcharfun, escapeflag);
1276 /* COMPILED_BYTECODE = 1 */
1277 write_char_internal (" ", printcharfun);
1278 /* we don't really want to see that junk in the bytecode instructions. */
1279 if (STRINGP (b->bytecodes) && !print_readably)
1281 sprintf (buf, "\"...(%ld)\"", (long) XSTRING_LENGTH (b->bytecodes));
1282 write_c_string (buf, printcharfun);
1285 print_internal (b->bytecodes, printcharfun, escapeflag);
1286 /* COMPILED_CONSTANTS = 2 */
1287 write_char_internal (" ", printcharfun);
1288 print_internal (b->constants, printcharfun, escapeflag);
1289 /* COMPILED_STACK_DEPTH = 3 */
1290 sprintf (buf, " %d", b->maxdepth);
1291 write_c_string (buf, printcharfun);
1292 /* COMPILED_DOC_STRING = 4 */
1295 write_char_internal (" ", printcharfun);
1296 print_internal (compiled_function_documentation (b), printcharfun,
1299 /* COMPILED_INTERACTIVE = 5 */
1302 write_char_internal (" ", printcharfun);
1303 print_internal (compiled_function_interactive (b), printcharfun,
1307 write_c_string (end, printcharfun);
1311 print_compiled_function (Lisp_Object obj, Lisp_Object printcharfun,
1314 /* This function can GC */
1315 print_compiled_function_internal (((print_readably) ? "#[" :
1316 "#<compiled-function "),
1317 ((print_readably) ? "]" : ">"),
1318 obj, printcharfun, escapeflag);
1321 #ifdef LISP_FLOAT_TYPE
1323 print_float (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1325 char pigbuf[350]; /* see comments in float_to_string */
1327 float_to_string (pigbuf, float_data (XFLOAT (obj)));
1328 write_c_string (pigbuf, printcharfun);
1330 #endif /* LISP_FLOAT_TYPE */
1333 print_symbol (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1335 /* This function can GC */
1336 /* #### Bug!! (intern "") isn't printed in some distinguished way */
1337 /* #### (the reader also loses on it) */
1338 struct Lisp_String *name = symbol_name (XSYMBOL (obj));
1339 Bytecount size = string_length (name);
1340 struct gcpro gcpro1, gcpro2;
1344 /* This deals with GC-relocation */
1345 Lisp_Object nameobj;
1346 XSETSTRING (nameobj, name);
1347 output_string (printcharfun, 0, nameobj, 0, size);
1350 GCPRO2 (obj, printcharfun);
1352 /* If we print an uninterned symbol as part of a complex object and
1353 the flag print-gensym is non-nil, prefix it with #n= to read the
1354 object back with the #n# reader syntax later if needed. */
1355 if (!NILP (Vprint_gensym) && NILP (XSYMBOL (obj)->obarray))
1357 if (print_depth > 1)
1359 Lisp_Object tem = Fassq (obj, Vprint_gensym_alist);
1362 write_char_internal ("#", printcharfun);
1363 print_internal (XCDR (tem), printcharfun, escapeflag);
1364 write_char_internal ("#", printcharfun);
1369 if (CONSP (Vprint_gensym_alist))
1371 /* Vprint_gensym_alist is exposed to Lisp, so we
1372 have to be careful. */
1373 CHECK_CONS (XCAR (Vprint_gensym_alist));
1374 CHECK_INT (XCDR (XCAR (Vprint_gensym_alist)));
1375 XSETINT (tem, XINT (XCDR (XCAR (Vprint_gensym_alist))) + 1);
1379 Vprint_gensym_alist = Fcons (Fcons (obj, tem), Vprint_gensym_alist);
1381 write_char_internal ("#", printcharfun);
1382 print_internal (tem, printcharfun, escapeflag);
1383 write_char_internal ("=", printcharfun);
1386 write_c_string ("#:", printcharfun);
1389 /* Does it look like an integer or a float? */
1391 Bufbyte *data = string_data (name);
1392 Bytecount confusing = 0;
1395 goto not_yet_confused; /* Really confusing */
1396 else if (isdigit (data[0]))
1399 goto not_yet_confused;
1400 else if (data[0] == '-' || data[0] == '+')
1403 goto not_yet_confused;
1405 for (; confusing < size; confusing++)
1407 if (!isdigit (data[confusing]))
1415 #ifdef LISP_FLOAT_TYPE
1417 /* #### Ugh, this is needlessly complex and slow for what we
1418 need here. It might be a good idea to copy equivalent code
1419 from FSF. --hniksic */
1420 confusing = isfloat_string ((char *) data);
1423 write_char_internal ("\\", printcharfun);
1427 Lisp_Object nameobj;
1431 XSETSTRING (nameobj, name);
1432 for (i = 0; i < size; i++)
1434 Bufbyte c = string_byte (name, i);
1436 if (c == '\"' || c == '\\' || c == '\'' || c == ';' || c == '#' ||
1437 c == '(' || c == ')' || c == ',' || c =='.' || c == '`' ||
1438 c == '[' || c == ']' || c == '?' || c <= 040)
1442 output_string (printcharfun, 0, nameobj, last,
1445 write_char_internal ("\\", printcharfun);
1449 output_string (printcharfun, 0, nameobj, last, size - last);
1454 /* #ifdef DEBUG_XEMACS */
1456 /* I don't like seeing `Note: Strange doc (not fboundp) for function
1457 alternate-debugging-output @ 429542' -slb */
1458 /* #### Eek! Any clue how to get rid of it? In fact, how about
1459 getting rid of this function altogether? Does anything actually
1460 *use* it? --hniksic */
1462 int alternate_do_pointer;
1463 char alternate_do_string[5000];
1465 DEFUN ("alternate-debugging-output", Falternate_debugging_output, 1, 1, 0, /*
1466 Append CHARACTER to the array `alternate_do_string'.
1467 This can be used in place of `external-debugging-output' as a function
1468 to be passed to `print'. Before calling `print', set `alternate_do_pointer'
1473 Bufbyte str[MAX_EMCHAR_LEN];
1476 CONST Extbyte *extptr;
1478 CHECK_CHAR_COERCE_INT (character);
1479 len = set_charptr_emchar (str, XCHAR (character));
1480 GET_CHARPTR_EXT_DATA_ALLOCA (str, len, FORMAT_TERMINAL, extptr, extlen);
1481 memcpy (alternate_do_string + alternate_do_pointer, extptr, extlen);
1482 alternate_do_pointer += extlen;
1483 alternate_do_string[alternate_do_pointer] = 0;
1486 /* #endif / * DEBUG_XEMACS */
1488 DEFUN ("external-debugging-output", Fexternal_debugging_output, 1, 3, 0, /*
1489 Write CHAR-OR-STRING to stderr or stdout.
1490 If optional arg STDOUT-P is non-nil, write to stdout; otherwise, write
1491 to stderr. You can use this function to write directly to the terminal.
1492 This function can be used as the STREAM argument of Fprint() or the like.
1494 If you have opened a termscript file (using `open-termscript'), then
1495 the output also will be logged to this file.
1497 (char_or_string, stdout_p, device))
1500 struct console *con = 0;
1504 if (!NILP (stdout_p))
1511 CHECK_LIVE_DEVICE (device);
1512 if (!DEVICE_TTY_P (XDEVICE (device)) &&
1513 !DEVICE_STREAM_P (XDEVICE (device)))
1514 signal_simple_error ("Must be tty or stream device", device);
1515 con = XCONSOLE (DEVICE_CONSOLE (XDEVICE (device)));
1516 if (DEVICE_TTY_P (XDEVICE (device)))
1518 else if (!NILP (stdout_p))
1519 file = CONSOLE_STREAM_DATA (con)->outfd;
1521 file = CONSOLE_STREAM_DATA (con)->errfd;
1524 if (STRINGP (char_or_string))
1525 write_string_to_stdio_stream (file, con,
1526 XSTRING_DATA (char_or_string),
1527 0, XSTRING_LENGTH (char_or_string),
1531 Bufbyte str[MAX_EMCHAR_LEN];
1534 CHECK_CHAR_COERCE_INT (char_or_string);
1535 len = set_charptr_emchar (str, XCHAR (char_or_string));
1536 write_string_to_stdio_stream (file, con, str, 0, len, FORMAT_TERMINAL);
1539 return char_or_string;
1542 DEFUN ("open-termscript", Fopen_termscript, 1, 1, "FOpen termscript file: ", /*
1543 Start writing all terminal output to FILE as well as the terminal.
1544 FILE = nil means just close any termscript file currently open.
1548 /* This function can GC */
1549 if (termscript != 0)
1550 fclose (termscript);
1555 file = Fexpand_file_name (file, Qnil);
1556 termscript = fopen ((char *) XSTRING_DATA (file), "w");
1557 if (termscript == NULL)
1558 report_file_error ("Opening termscript", list1 (file));
1564 /* Debugging kludge -- unbuffered */
1565 static int debug_print_length = 50;
1566 static int debug_print_level = 15;
1567 Lisp_Object debug_temp;
1570 debug_print_no_newline (Lisp_Object debug_print_obj)
1572 /* This function can GC */
1573 int old_print_readably = print_readably;
1574 int old_print_depth = print_depth;
1575 Lisp_Object old_print_length = Vprint_length;
1576 Lisp_Object old_print_level = Vprint_level;
1577 Lisp_Object old_inhibit_quit = Vinhibit_quit;
1578 struct gcpro gcpro1, gcpro2, gcpro3;
1579 GCPRO3 (old_print_level, old_print_length, old_inhibit_quit);
1582 stderr_out ("** gc-in-progress! Bad idea to print anything! **\n");
1587 /* Could use unwind-protect, but why bother? */
1588 if (debug_print_length > 0)
1589 Vprint_length = make_int (debug_print_length);
1590 if (debug_print_level > 0)
1591 Vprint_level = make_int (debug_print_level);
1592 print_internal (debug_print_obj, Qexternal_debugging_output, 1);
1593 Vinhibit_quit = old_inhibit_quit;
1594 Vprint_level = old_print_level;
1595 Vprint_length = old_print_length;
1596 print_depth = old_print_depth;
1597 print_readably = old_print_readably;
1603 debug_print (Lisp_Object debug_print_obj)
1605 debug_print_no_newline (debug_print_obj);
1610 /* Debugging kludge -- unbuffered */
1611 /* This function provided for the benefit of the debugger. */
1612 void debug_backtrace (void);
1614 debug_backtrace (void)
1616 /* This function can GC */
1617 int old_print_readably = print_readably;
1618 int old_print_depth = print_depth;
1619 Lisp_Object old_print_length = Vprint_length;
1620 Lisp_Object old_print_level = Vprint_level;
1621 Lisp_Object old_inhibit_quit = Vinhibit_quit;
1622 struct gcpro gcpro1, gcpro2, gcpro3;
1623 GCPRO3 (old_print_level, old_print_length, old_inhibit_quit);
1626 stderr_out ("** gc-in-progress! Bad idea to print anything! **\n");
1631 /* Could use unwind-protect, but why bother? */
1632 if (debug_print_length > 0)
1633 Vprint_length = make_int (debug_print_length);
1634 if (debug_print_level > 0)
1635 Vprint_level = make_int (debug_print_level);
1636 Fbacktrace (Qexternal_debugging_output, Qt);
1639 Vinhibit_quit = old_inhibit_quit;
1640 Vprint_level = old_print_level;
1641 Vprint_length = old_print_length;
1642 print_depth = old_print_depth;
1643 print_readably = old_print_readably;
1649 debug_short_backtrace (int length)
1652 struct backtrace *bt = backtrace_list;
1655 while (length > 0 && bt)
1662 if (COMPILED_FUNCTIONP (*bt->function))
1664 #if defined(COMPILED_FUNCTION_ANNOTATION_HACK)
1665 Lisp_Object ann = Fcompiled_function_annotation (*bt->function);
1667 Lisp_Object ann = Qnil;
1671 stderr_out ("<compiled-function from ");
1673 debug_print_no_newline (ann);
1679 stderr_out ("<compiled-function of unknown origin>");
1684 debug_print_no_newline (*bt->function);
1693 #endif /* debugging kludge */
1697 syms_of_print (void)
1699 defsymbol (&Qprint_escape_newlines, "print-escape-newlines");
1700 defsymbol (&Qprint_readably, "print-readably");
1702 defsymbol (&Qstandard_output, "standard-output");
1704 #ifdef LISP_FLOAT_TYPE
1705 defsymbol (&Qfloat_output_format, "float-output-format");
1708 defsymbol (&Qprint_length, "print-length");
1710 defsymbol (&Qprint_string_length, "print-string-length");
1712 defsymbol (&Qdisplay_error, "display-error");
1713 defsymbol (&Qprint_message_label, "print-message-label");
1716 DEFSUBR (Fprin1_to_string);
1719 DEFSUBR (Ferror_message_string);
1720 DEFSUBR (Fdisplay_error);
1722 DEFSUBR (Fwrite_char);
1723 DEFSUBR (Falternate_debugging_output);
1724 defsymbol (&Qalternate_debugging_output, "alternate-debugging-output");
1725 DEFSUBR (Fexternal_debugging_output);
1726 DEFSUBR (Fopen_termscript);
1727 defsymbol (&Qexternal_debugging_output, "external-debugging-output");
1728 DEFSUBR (Fwith_output_to_temp_buffer);
1732 vars_of_print (void)
1734 alternate_do_pointer = 0;
1736 DEFVAR_LISP ("standard-output", &Vstandard_output /*
1737 Output stream `print' uses by default for outputting a character.
1738 This may be any function of one argument.
1739 It may also be a buffer (output is inserted before point)
1740 or a marker (output is inserted and the marker is advanced)
1741 or the symbol t (output appears in the minibuffer line).
1743 Vstandard_output = Qt;
1745 #ifdef LISP_FLOAT_TYPE
1746 DEFVAR_LISP ("float-output-format", &Vfloat_output_format /*
1747 The format descriptor string that lisp uses to print floats.
1748 This is a %-spec like those accepted by `printf' in C,
1749 but with some restrictions. It must start with the two characters `%.'.
1750 After that comes an integer precision specification,
1751 and then a letter which controls the format.
1752 The letters allowed are `e', `f' and `g'.
1753 Use `e' for exponential notation "DIG.DIGITSeEXPT"
1754 Use `f' for decimal point notation "DIGITS.DIGITS".
1755 Use `g' to choose the shorter of those two formats for the number at hand.
1756 The precision in any of these cases is the number of digits following
1757 the decimal point. With `f', a precision of 0 means to omit the
1758 decimal point. 0 is not allowed with `f' or `g'.
1760 A value of nil means to use `%.16g'.
1762 Regardless of the value of `float-output-format', a floating point number
1763 will never be printed in such a way that it is ambiguous with an integer;
1764 that is, a floating-point number will always be printed with a decimal
1765 point and/or an exponent, even if the digits following the decimal point
1766 are all zero. This is to preserve read-equivalence.
1768 Vfloat_output_format = Qnil;
1769 #endif /* LISP_FLOAT_TYPE */
1771 DEFVAR_LISP ("print-length", &Vprint_length /*
1772 Maximum length of list or vector to print before abbreviating.
1773 A value of nil means no limit.
1775 Vprint_length = Qnil;
1777 DEFVAR_LISP ("print-string-length", &Vprint_string_length /*
1778 Maximum length of string to print before abbreviating.
1779 A value of nil means no limit.
1781 Vprint_string_length = Qnil;
1783 DEFVAR_LISP ("print-level", &Vprint_level /*
1784 Maximum depth of list nesting to print before abbreviating.
1785 A value of nil means no limit.
1787 Vprint_level = Qnil;
1789 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines /*
1790 Non-nil means print newlines in strings as backslash-n.
1792 print_escape_newlines = 0;
1794 DEFVAR_BOOL ("print-readably", &print_readably /*
1795 If non-nil, then all objects will be printed in a readable form.
1796 If an object has no readable representation, then an error is signalled.
1797 When print-readably is true, compiled-function objects will be written in
1798 #[...] form instead of in #<compiled-function [...]> form, and two-element
1799 lists of the form (quote object) will be written as the equivalent 'object.
1800 Do not SET this variable; bind it instead.
1804 /* #### I think this should default to t. But we'd better wait
1805 until we see that it works out. */
1806 DEFVAR_LISP ("print-gensym", &Vprint_gensym /*
1807 If non-nil, then uninterned symbols will be printed specially.
1808 Uninterned symbols are those which are not present in `obarray', that is,
1809 those which were made with `make-symbol' or by calling `intern' with a
1812 When print-gensym is true, such symbols will be preceded by "#:",
1813 which causes the reader to create a new symbol instead of interning
1814 and returning an existing one. Beware: the #: syntax creates a new
1815 symbol each time it is seen, so if you print an object which contains
1816 two pointers to the same uninterned symbol, `read' will not duplicate
1819 If the value of `print-gensym' is a cons cell, then in addition
1820 refrain from clearing `print-gensym-alist' on entry to and exit from
1821 printing functions, so that the use of #...# and #...= can carry over
1822 for several separately printed objects.
1824 Vprint_gensym = Qnil;
1826 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist /*
1827 Association list of elements (GENSYM . N) to guide use of #N# and #N=.
1828 In each element, GENSYM is an uninterned symbol that has been associated
1829 with #N= for the specified value of N.
1831 Vprint_gensym_alist = Qnil;
1833 DEFVAR_LISP ("print-message-label", &Vprint_message_label /*
1834 Label for minibuffer messages created with `print'. This should
1835 generally be bound with `let' rather than set. (See `display-message'.)
1837 Vprint_message_label = Qprint;