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"
46 /* Define if not in float.h */
51 Lisp_Object Vstandard_output, Qstandard_output;
53 /* The subroutine object for external-debugging-output is kept here
54 for the convenience of the debugger. */
55 Lisp_Object Qexternal_debugging_output, Qalternate_debugging_output;
57 #ifdef HAVE_MS_WINDOWS
58 Lisp_Object Qmswindows_debugging_output;
61 /* Avoid actual stack overflow in print. */
62 static int print_depth;
64 /* Detect most circularities to print finite output. */
65 #define PRINT_CIRCLE 200
66 static Lisp_Object being_printed[PRINT_CIRCLE];
68 /* Maximum length of list or vector to print in full; noninteger means
69 effectively infinity */
71 Lisp_Object Vprint_length;
72 Lisp_Object Qprint_length;
74 /* Maximum length of string to print in full; noninteger means
75 effectively infinity */
77 Lisp_Object Vprint_string_length;
78 Lisp_Object Qprint_string_length;
80 /* Maximum depth of list to print in full; noninteger means
81 effectively infinity. */
83 Lisp_Object Vprint_level;
85 /* Label to use when making echo-area messages. */
87 Lisp_Object Vprint_message_label;
89 /* Nonzero means print newlines in strings as \n. */
91 int print_escape_newlines;
94 /* Non-nil means print #: before uninterned symbols.
95 Neither t nor nil means so that and don't clear Vprint_gensym_alist
96 on entry to and exit from print functions. */
97 Lisp_Object Vprint_gensym;
98 Lisp_Object Vprint_gensym_alist;
100 Lisp_Object Qdisplay_error;
101 Lisp_Object Qprint_message_label;
103 /* Force immediate output of all printed data. Used for debugging. */
104 int print_unbuffered;
106 FILE *termscript; /* Stdio stream being used for copy of all output. */
110 int stdout_needs_newline;
113 std_handle_out_external (FILE *stream, Lisp_Object lstream,
114 const Extbyte *extptr, Extcount extlen,
115 /* is this really stdout/stderr?
116 (controls termscript writing) */
117 int output_is_std_handle,
123 HANDLE errhand = GetStdHandle (STD_INPUT_HANDLE);
124 int no_useful_stderr = errhand == 0 || errhand == INVALID_HANDLE_VALUE;
126 if (!no_useful_stderr)
127 no_useful_stderr = !PeekNamedPipe (errhand, 0, 0, 0, 0, 0);
128 /* we typically have no useful stdout/stderr under windows if we're
129 being invoked graphically. */
130 if (no_useful_stderr)
131 mswindows_output_console_string (extptr, extlen);
135 fwrite (extptr, 1, extlen, stream);
137 /* Q122442 says that pipes are "treated as files, not as
138 devices", and that this is a feature. Before I found that
139 article, I thought it was a bug. Thanks MS, I feel much
148 Lstream_write (XLSTREAM (lstream), extptr, extlen);
150 if (output_is_std_handle)
154 fwrite (extptr, 1, extlen, termscript);
157 stdout_needs_newline = (extptr[extlen - 1] != '\n');
161 /* #### The following function should be replaced a call to the
162 emacs_doprnt_*() functions. This is the only way to ensure that
163 I18N3 works properly (many implementations of the *printf()
164 functions, including the ones included in glibc, do not implement
165 the %###$ argument-positioning syntax).
167 Note, however, that to do this, we'd have to
169 1) pre-allocate all the lstreams and do whatever else was necessary
170 to make sure that no allocation occurs, since these functions may be
171 called from fatal_error_signal().
173 2) (to be really correct) make a new lstream that outputs using
174 mswindows_output_console_string(). */
177 std_handle_out_va (FILE *stream, const char *fmt, va_list args)
179 Bufbyte kludge[8192];
184 retval = vsprintf ((char *) kludge, fmt, args);
185 if (initialized && !fatal_error_in_progress)
186 TO_EXTERNAL_FORMAT (DATA, (kludge, strlen ((char *) kludge)),
187 ALLOCA, (extptr, extlen),
191 extptr = (Extbyte *) kludge;
192 extlen = (Extcount) strlen ((char *) kludge);
195 std_handle_out_external (stream, Qnil, extptr, extlen, 1, 1);
199 /* Output portably to stderr or its equivalent; call GETTEXT on the
200 format string. Automatically flush when done. */
203 stderr_out (const char *fmt, ...)
207 va_start (args, fmt);
210 (stderr, initialized && !fatal_error_in_progress ? GETTEXT (fmt) : fmt,
216 /* Output portably to stdout or its equivalent; call GETTEXT on the
217 format string. Automatically flush when done. */
220 stdout_out (const char *fmt, ...)
224 va_start (args, fmt);
227 (stdout, initialized && !fatal_error_in_progress ? GETTEXT (fmt) : fmt,
234 fatal (const char *fmt, ...)
237 va_start (args, fmt);
239 stderr_out ("\nXEmacs: ");
240 std_handle_out_va (stderr, GETTEXT (fmt), args);
247 /* Write a string (in internal format) to stdio stream STREAM. */
250 write_string_to_stdio_stream (FILE *stream, struct console *con,
252 Bytecount offset, Bytecount len,
253 Lisp_Object coding_system,
257 const Extbyte *extptr;
259 /* #### yuck! sometimes this function is called with string data,
260 and the following call may gc. */
262 Bufbyte *puta = (Bufbyte *) alloca (len);
263 memcpy (puta, str + offset, len);
264 TO_EXTERNAL_FORMAT (DATA, (puta, len),
265 ALLOCA, (extptr, extlen),
270 std_handle_out_external (stream, Qnil, extptr, extlen,
271 stream == stdout || stream == stderr, must_flush);
274 assert (CONSOLE_TTY_P (con));
275 std_handle_out_external (0, CONSOLE_TTY_DATA (con)->outstream,
277 CONSOLE_TTY_DATA (con)->is_stdio, must_flush);
281 /* Write a string to the output location specified in FUNCTION.
282 Arguments NONRELOC, RELOC, OFFSET, and LEN are as in
283 buffer_insert_string_1() in insdel.c. */
286 output_string (Lisp_Object function, const Bufbyte *nonreloc,
287 Lisp_Object reloc, Bytecount offset, Bytecount len)
289 /* This function can GC */
291 /* We change the value of nonreloc (fetching it from reloc as
292 necessary), but we don't want to pass this changed value on to
293 other functions that take both a nonreloc and a reloc, or things
294 may get confused and an assertion failure in
295 fixup_internal_substring() may get triggered. */
296 const Bufbyte *newnonreloc = nonreloc;
297 struct gcpro gcpro1, gcpro2;
299 /* Emacs won't print while GCing, but an external debugger might */
300 if (gc_in_progress) return;
302 /* Perhaps not necessary but probably safer. */
303 GCPRO2 (function, reloc);
305 fixup_internal_substring (newnonreloc, reloc, offset, &len);
308 newnonreloc = XSTRING_DATA (reloc);
310 cclen = bytecount_to_charcount (newnonreloc + offset, len);
312 if (LSTREAMP (function))
316 /* Protect against Lstream_write() causing a GC and
317 relocating the string. For small strings, we do it by
318 alloc'ing the string and using a copy; for large strings,
322 Bufbyte *copied = alloca_array (Bufbyte, len);
323 memcpy (copied, newnonreloc + offset, len);
324 Lstream_write (XLSTREAM (function), copied, len);
328 int speccount = specpdl_depth ();
329 record_unwind_protect (restore_gc_inhibit,
330 make_int (gc_currently_forbidden));
331 gc_currently_forbidden = 1;
332 Lstream_write (XLSTREAM (function), newnonreloc + offset, len);
333 unbind_to (speccount, Qnil);
337 Lstream_write (XLSTREAM (function), newnonreloc + offset, len);
339 if (print_unbuffered)
340 Lstream_flush (XLSTREAM (function));
342 else if (BUFFERP (function))
344 CHECK_LIVE_BUFFER (function);
345 buffer_insert_string (XBUFFER (function), nonreloc, reloc, offset, len);
347 else if (MARKERP (function))
349 /* marker_position() will err if marker doesn't point anywhere. */
350 Bufpos spoint = marker_position (function);
352 buffer_insert_string_1 (XMARKER (function)->buffer,
353 spoint, nonreloc, reloc, offset, len,
355 Fset_marker (function, make_int (spoint + cclen),
356 Fmarker_buffer (function));
358 else if (FRAMEP (function))
360 /* This gets used by functions not invoking print_prepare(),
361 such as Fwrite_char, Fterpri, etc.. */
362 struct frame *f = XFRAME (function);
363 CHECK_LIVE_FRAME (function);
365 if (!EQ (Vprint_message_label, echo_area_status (f)))
366 clear_echo_area_from_print (f, Qnil, 1);
367 echo_area_append (f, nonreloc, reloc, offset, len, Vprint_message_label);
369 else if (EQ (function, Qt) || EQ (function, Qnil))
371 write_string_to_stdio_stream (stdout, 0, newnonreloc, offset, len,
372 Qterminal, print_unbuffered);
376 Charcount ccoff = bytecount_to_charcount (newnonreloc, offset);
379 for (iii = ccoff; iii < cclen + ccoff; iii++)
382 make_char (charptr_emchar_n (newnonreloc, iii)));
384 newnonreloc = XSTRING_DATA (reloc);
391 #define RESET_PRINT_GENSYM do { \
392 if (!CONSP (Vprint_gensym)) \
393 Vprint_gensym_alist = Qnil; \
397 canonicalize_printcharfun (Lisp_Object printcharfun)
399 if (NILP (printcharfun))
400 printcharfun = Vstandard_output;
402 if (EQ (printcharfun, Qt) || NILP (printcharfun))
403 printcharfun = Fselected_frame (Qnil); /* print to minibuffer */
409 print_prepare (Lisp_Object printcharfun, Lisp_Object *frame_kludge)
411 /* Emacs won't print while GCing, but an external debugger might */
417 printcharfun = canonicalize_printcharfun (printcharfun);
419 /* Here we could safely return the canonicalized PRINTCHARFUN.
420 However, if PRINTCHARFUN is a frame, printing of complex
421 structures becomes very expensive, because `append-message'
422 (called by echo_area_append) gets called as many times as
423 output_string() is called (and that's a *lot*). append-message
424 tries to keep top of the message-stack in sync with the contents
425 of " *Echo Area" buffer, consing a new string for each component
426 of the printed structure. For instance, if you print (a a),
427 append-message will cons up the following strings:
435 and will use only the last one. With larger objects, this turns
436 into an O(n^2) consing frenzy that locks up XEmacs in incessant
439 We prevent this by creating a resizing_buffer stream and letting
440 the printer write into it. print_finish() will notice this
441 stream, and invoke echo_area_append() with the stream's buffer,
443 if (FRAMEP (printcharfun))
445 CHECK_LIVE_FRAME (printcharfun);
446 *frame_kludge = printcharfun;
447 printcharfun = make_resizing_buffer_output_stream ();
454 print_finish (Lisp_Object stream, Lisp_Object frame_kludge)
456 /* Emacs won't print while GCing, but an external debugger might */
462 /* See the comment in print_prepare(). */
463 if (FRAMEP (frame_kludge))
465 struct frame *f = XFRAME (frame_kludge);
466 Lstream *str = XLSTREAM (stream);
467 CHECK_LIVE_FRAME (frame_kludge);
470 if (!EQ (Vprint_message_label, echo_area_status (f)))
471 clear_echo_area_from_print (f, Qnil, 1);
472 echo_area_append (f, resizing_buffer_stream_ptr (str),
473 Qnil, 0, Lstream_byte_count (str),
474 Vprint_message_label);
475 Lstream_delete (str);
479 /* Used for printing a single-byte character (*not* any Emchar). */
480 #define write_char_internal(string_of_length_1, stream) \
481 output_string (stream, (const Bufbyte *) (string_of_length_1), \
484 /* NOTE: Do not call this with the data of a Lisp_String, as
485 printcharfun might cause a GC, which might cause the string's data
486 to be relocated. To princ a Lisp string, use:
488 print_internal (string, printcharfun, 0);
490 Also note that STREAM should be the result of
491 canonicalize_printcharfun() (i.e. Qnil means stdout, not
492 Vstandard_output, etc.) */
494 write_string_1 (const Bufbyte *str, Bytecount size, Lisp_Object stream)
496 /* This function can GC */
497 #ifdef ERROR_CHECK_BUFPOS
500 output_string (stream, str, Qnil, 0, size);
504 write_c_string (const char *str, Lisp_Object stream)
506 /* This function can GC */
507 write_string_1 ((const Bufbyte *) str, strlen (str), stream);
511 DEFUN ("write-char", Fwrite_char, 1, 2, 0, /*
512 Output character CHARACTER to stream STREAM.
513 STREAM defaults to the value of `standard-output' (which see).
517 /* This function can GC */
518 Bufbyte str[MAX_EMCHAR_LEN];
521 CHECK_CHAR_COERCE_INT (character);
522 len = set_charptr_emchar (str, XCHAR (character));
523 output_string (canonicalize_printcharfun (stream), str, Qnil, 0, len);
528 temp_output_buffer_setup (Lisp_Object bufname)
530 /* This function can GC */
531 struct buffer *old = current_buffer;
535 /* #### This function should accept a Lisp_Object instead of a char *,
536 so that proper translation on the buffer name can occur. */
539 Fset_buffer (Fget_buffer_create (bufname));
541 current_buffer->read_only = Qnil;
542 Ferase_buffer (Qnil);
544 XSETBUFFER (buf, current_buffer);
545 specbind (Qstandard_output, buf);
547 set_buffer_internal (old);
551 internal_with_output_to_temp_buffer (Lisp_Object bufname,
552 Lisp_Object (*function) (Lisp_Object arg),
554 Lisp_Object same_frame)
556 int speccount = specpdl_depth ();
557 struct gcpro gcpro1, gcpro2, gcpro3;
558 Lisp_Object buf = Qnil;
560 GCPRO3 (buf, arg, same_frame);
562 temp_output_buffer_setup (bufname);
563 buf = Vstandard_output;
565 arg = (*function) (arg);
567 temp_output_buffer_show (buf, same_frame);
570 return unbind_to (speccount, arg);
573 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, 1, UNEVALLED, 0, /*
574 Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
575 The buffer is cleared out initially, and marked as unmodified when done.
576 All output done by BODY is inserted in that buffer by default.
577 The buffer is displayed in another window, but not selected.
578 The value of the last form in BODY is returned.
579 If BODY does not finish normally, the buffer BUFNAME is not displayed.
581 If variable `temp-buffer-show-function' is non-nil, call it at the end
582 to get the buffer displayed. It gets one argument, the buffer to display.
586 /* This function can GC */
587 Lisp_Object name = Qnil;
588 int speccount = specpdl_depth ();
589 struct gcpro gcpro1, gcpro2;
590 Lisp_Object val = Qnil;
593 /* #### should set the buffer to be translating. See print_internal(). */
597 name = Feval (XCAR (args));
601 temp_output_buffer_setup (name);
604 val = Fprogn (XCDR (args));
606 temp_output_buffer_show (Vstandard_output, Qnil);
608 return unbind_to (speccount, val);
611 DEFUN ("terpri", Fterpri, 0, 1, 0, /*
612 Output a newline to STREAM.
613 If STREAM is omitted or nil, the value of `standard-output' is used.
617 /* This function can GC */
618 write_char_internal ("\n", canonicalize_printcharfun (stream));
622 DEFUN ("prin1", Fprin1, 1, 2, 0, /*
623 Output the printed representation of OBJECT, any Lisp object.
624 Quoting characters are printed when needed to make output that `read'
625 can handle, whenever this is possible.
626 Output stream is STREAM, or value of `standard-output' (which see).
630 /* This function can GC */
631 Lisp_Object frame = Qnil;
632 struct gcpro gcpro1, gcpro2;
633 GCPRO2 (object, stream);
636 stream = print_prepare (stream, &frame);
637 print_internal (object, stream, 1);
638 print_finish (stream, frame);
644 DEFUN ("prin1-to-string", Fprin1_to_string, 1, 2, 0, /*
645 Return a string containing the printed representation of OBJECT,
646 any Lisp object. Quoting characters are used when needed to make output
647 that `read' can handle, whenever this is possible, unless the optional
648 second argument NOESCAPE is non-nil.
652 /* This function can GC */
653 Lisp_Object result = Qnil;
654 Lisp_Object stream = make_resizing_buffer_output_stream ();
655 Lstream *str = XLSTREAM (stream);
656 /* gcpro OBJECT in case a caller forgot to do so */
657 struct gcpro gcpro1, gcpro2, gcpro3;
658 GCPRO3 (object, stream, result);
662 print_internal (object, stream, NILP (noescape));
666 result = make_string (resizing_buffer_stream_ptr (str),
667 Lstream_byte_count (str));
668 Lstream_delete (str);
672 DEFUN ("princ", Fprinc, 1, 2, 0, /*
673 Output the printed representation of OBJECT, any Lisp object.
674 No quoting characters are used; no delimiters are printed around
675 the contents of strings.
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 print_internal (object, stream, 0);
688 print_finish (stream, frame);
693 DEFUN ("print", Fprint, 1, 2, 0, /*
694 Output the printed representation of OBJECT, with newlines around it.
695 Quoting characters are printed when needed to make output that `read'
696 can handle, whenever this is possible.
697 Output stream is STREAM, or value of `standard-output' (which see).
701 /* This function can GC */
702 Lisp_Object frame = Qnil;
703 struct gcpro gcpro1, gcpro2;
705 GCPRO2 (object, stream);
706 stream = print_prepare (stream, &frame);
708 write_char_internal ("\n", stream);
709 print_internal (object, stream, 1);
710 write_char_internal ("\n", stream);
711 print_finish (stream, frame);
716 /* Print an error message for the error DATA to STREAM. This is a
717 complete implementation of `display-error', which used to be in
718 Lisp (see prim/cmdloop.el). It was ported to C so it can be used
719 efficiently by Ferror_message_string. Fdisplay_error and
720 Ferror_message_string are trivial wrappers around this function.
722 STREAM should be the result of canonicalize_printcharfun(). */
724 print_error_message (Lisp_Object error_object, Lisp_Object stream)
726 /* This function can GC */
727 Lisp_Object type = Fcar_safe (error_object);
728 Lisp_Object method = Qnil;
731 /* No need to GCPRO anything under the assumption that ERROR_OBJECT
734 if (! (CONSP (error_object) && SYMBOLP (type)
735 && CONSP (Fget (type, Qerror_conditions, Qnil))))
738 tail = XCDR (error_object);
746 tail = Fget (type, Qerror_conditions, Qnil);
749 if (!(CONSP (tail) && SYMBOLP (XCAR (tail))))
751 else if (!NILP (Fget (XCAR (tail), Qdisplay_error, Qnil)))
753 method = Fget (XCAR (tail), Qdisplay_error, Qnil);
762 int speccount = specpdl_depth ();
763 Lisp_Object frame = Qnil;
767 specbind (Qprint_message_label, Qerror);
768 stream = print_prepare (stream, &frame);
770 tail = Fcdr (error_object);
771 if (EQ (type, Qerror))
773 print_internal (Fcar (tail), stream, 0);
778 Lisp_Object errmsg = Fget (type, Qerror_message, Qnil);
780 print_internal (type, stream, 0);
782 print_internal (LISP_GETTEXT (errmsg), stream, 0);
786 write_c_string (first ? ": " : ", ", stream);
787 print_internal (Fcar (tail), stream, 1);
791 print_finish (stream, frame);
793 unbind_to (speccount, Qnil);
801 write_c_string (GETTEXT ("Peculiar error "), stream);
802 print_internal (error_object, stream, 1);
807 call2 (method, error_object, stream);
811 DEFUN ("error-message-string", Ferror_message_string, 1, 1, 0, /*
812 Convert ERROR-OBJECT to an error message, and return it.
814 The format of ERROR-OBJECT should be (ERROR-SYMBOL . DATA). The
815 message is equivalent to the one that would be issued by
816 `display-error' with the same argument.
820 /* This function can GC */
821 Lisp_Object result = Qnil;
822 Lisp_Object stream = make_resizing_buffer_output_stream ();
826 print_error_message (error_object, stream);
827 Lstream_flush (XLSTREAM (stream));
828 result = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
829 Lstream_byte_count (XLSTREAM (stream)));
830 Lstream_delete (XLSTREAM (stream));
836 DEFUN ("display-error", Fdisplay_error, 2, 2, 0, /*
837 Display ERROR-OBJECT on STREAM in a user-friendly way.
839 (error_object, stream))
841 /* This function can GC */
842 print_error_message (error_object, canonicalize_printcharfun (stream));
847 #ifdef LISP_FLOAT_TYPE
849 Lisp_Object Vfloat_output_format;
852 * This buffer should be at least as large as the max string size of the
853 * largest float, printed in the biggest notation. This is undoubtedly
854 * 20d float_output_format, with the negative of the C-constant "HUGE"
857 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
859 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
860 * case of -1e307 in 20d float_output_format. What is one to do (short of
861 * re-writing _doprnt to be more sane)?
865 float_to_string (char *buf, double data)
870 if (NILP (Vfloat_output_format)
871 || !STRINGP (Vfloat_output_format))
873 sprintf (buf, "%.16g", data);
876 /* Check that the spec we have is fully valid.
877 This means not only valid for printf,
878 but meant for floats, and reasonable. */
879 cp = XSTRING_DATA (Vfloat_output_format);
887 for (width = 0; (c = *cp, isdigit (c)); cp++)
893 if (*cp != 'e' && *cp != 'f' && *cp != 'g' && *cp != 'E' && *cp != 'G')
896 if (width < (int) (*cp != 'e' && *cp != 'E') || width > DBL_DIG)
902 sprintf (buf, (char *) XSTRING_DATA (Vfloat_output_format),
906 /* added by jwz: don't allow "1.0" to print as "1"; that destroys
907 the read-equivalence of lisp objects. (* x 1) and (* x 1.0) do
908 not do the same thing, so it's important that the printed
909 representation of that form not be corrupted by the printer.
912 Bufbyte *s = (Bufbyte *) buf; /* don't use signed chars here!
913 isdigit() can't hack them! */
916 /* if there's a non-digit, then there is a decimal point, or
917 it's in exponential notation, both of which are ok. */
920 /* otherwise, we need to hack it. */
927 /* Some machines print "0.4" as ".4". I don't like that. */
928 if (buf [0] == '.' || (buf [0] == '-' && buf [1] == '.'))
931 for (i = strlen (buf) + 1; i >= 0; i--)
933 buf [(buf [0] == '-' ? 1 : 0)] = '0';
936 #endif /* LISP_FLOAT_TYPE */
938 /* Print NUMBER to BUFFER.
939 This is equivalent to sprintf (buffer, "%ld", number), only much faster.
941 BUFFER should accept 24 bytes. This should suffice for the longest
942 numbers on 64-bit machines, including the `-' sign and the trailing
943 '\0'. Returns a pointer to the trailing '\0'. */
945 long_to_string (char *buffer, long number)
947 #if (SIZEOF_LONG != 4) && (SIZEOF_LONG != 8)
949 sprintf (buffer, "%ld", number);
950 return buffer + strlen (buffer);
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 */
989 #endif /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
993 print_vector_internal (const char *start, const char *end,
995 Lisp_Object printcharfun, int escapeflag)
997 /* This function can GC */
999 int len = XVECTOR_LENGTH (obj);
1001 struct gcpro gcpro1, gcpro2;
1002 GCPRO2 (obj, printcharfun);
1004 if (INTP (Vprint_length))
1006 int max = XINT (Vprint_length);
1007 if (max < len) last = max;
1010 write_c_string (start, printcharfun);
1011 for (i = 0; i < last; i++)
1013 Lisp_Object elt = XVECTOR_DATA (obj)[i];
1014 if (i != 0) write_char_internal (" ", printcharfun);
1015 print_internal (elt, printcharfun, escapeflag);
1019 write_c_string (" ...", printcharfun);
1020 write_c_string (end, printcharfun);
1024 print_cons (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1026 /* This function can GC */
1027 struct gcpro gcpro1, gcpro2;
1029 /* If print_readably is on, print (quote -foo-) as '-foo-
1030 (Yeah, this should really be what print-pretty does, but we
1031 don't have the rest of a pretty printer, and this actually
1032 has non-negligible impact on size/speed of .elc files.)
1034 if (print_readably &&
1035 EQ (XCAR (obj), Qquote) &&
1036 CONSP (XCDR (obj)) &&
1037 NILP (XCDR (XCDR (obj))))
1039 obj = XCAR (XCDR (obj));
1040 GCPRO2 (obj, printcharfun);
1041 write_char_internal ("\'", printcharfun);
1043 print_internal (obj, printcharfun, escapeflag);
1047 GCPRO2 (obj, printcharfun);
1048 write_char_internal ("(", printcharfun);
1052 int max = INTP (Vprint_length) ? XINT (Vprint_length) : INT_MAX;
1053 Lisp_Object tortoise;
1054 /* Use tortoise/hare to make sure circular lists don't infloop */
1056 for (tortoise = obj, len = 0;
1058 obj = XCDR (obj), len++)
1061 write_char_internal (" ", printcharfun);
1062 if (EQ (obj, tortoise) && len > 0)
1065 error ("printing unreadable circular list");
1067 write_c_string ("... <circular list>", printcharfun);
1071 tortoise = XCDR (tortoise);
1074 write_c_string ("...", printcharfun);
1077 print_internal (XCAR (obj), printcharfun, escapeflag);
1082 write_c_string (" . ", printcharfun);
1083 print_internal (obj, printcharfun, escapeflag);
1087 write_char_internal (")", printcharfun);
1092 print_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1094 print_vector_internal ("[", "]", obj, printcharfun, escapeflag);
1098 print_string (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1100 Lisp_String *s = XSTRING (obj);
1101 /* We distinguish between Bytecounts and Charcounts, to make
1102 Vprint_string_length work correctly under Mule. */
1103 Charcount size = string_char_length (s);
1104 Charcount max = size;
1105 Bytecount bcmax = string_length (s);
1106 struct gcpro gcpro1, gcpro2;
1107 GCPRO2 (obj, printcharfun);
1109 if (INTP (Vprint_string_length) &&
1110 XINT (Vprint_string_length) < max)
1112 max = XINT (Vprint_string_length);
1113 bcmax = charcount_to_bytecount (string_data (s), max);
1123 /* This deals with GC-relocation and Mule. */
1124 output_string (printcharfun, 0, obj, 0, bcmax);
1126 write_c_string (" ...", printcharfun);
1130 Bytecount i, last = 0;
1132 write_char_internal ("\"", printcharfun);
1133 for (i = 0; i < bcmax; i++)
1135 Bufbyte ch = string_byte (s, i);
1136 if (ch == '\"' || ch == '\\'
1137 || (ch == '\n' && print_escape_newlines))
1141 output_string (printcharfun, 0, obj, last,
1146 write_c_string ("\\n", printcharfun);
1150 write_char_internal ("\\", printcharfun);
1151 /* This is correct for Mule because the
1152 character is either \ or " */
1153 write_char_internal (string_data (s) + i, printcharfun);
1160 output_string (printcharfun, 0, obj, last,
1164 write_c_string (" ...", printcharfun);
1165 write_char_internal ("\"", printcharfun);
1171 default_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
1174 struct lcrecord_header *header =
1175 (struct lcrecord_header *) XPNTR (obj);
1179 error ("printing unreadable object #<%s 0x%x>",
1180 LHEADER_IMPLEMENTATION (&header->lheader)->name,
1183 sprintf (buf, "#<%s 0x%x>",
1184 LHEADER_IMPLEMENTATION (&header->lheader)->name,
1186 write_c_string (buf, printcharfun);
1190 internal_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
1194 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s) 0x%lx>",
1195 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
1196 (unsigned long) XPNTR (obj));
1197 write_c_string (buf, printcharfun);
1201 print_internal (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1203 /* This function can GC */
1207 /* Emacs won't print while GCing, but an external debugger might */
1208 if (gc_in_progress) return;
1211 /* #### Both input and output streams should have a flag associated
1212 with them indicating whether output to that stream, or strings
1213 read from the stream, get translated using Fgettext(). Such a
1214 stream is called a "translating stream". For the minibuffer and
1215 external-debugging-output this is always true on output, and
1216 with-output-to-temp-buffer sets the flag to true for the buffer
1217 it creates. This flag should also be user-settable. Perhaps it
1218 should be split up into two flags, one for input and one for
1222 /* Detect circularities and truncate them.
1223 No need to offer any alternative--this is better than an error. */
1224 if (CONSP (obj) || VECTORP (obj) || COMPILED_FUNCTIONP (obj))
1227 for (i = 0; i < print_depth; i++)
1228 if (EQ (obj, being_printed[i]))
1232 long_to_string (buf + 1, i);
1233 write_c_string (buf, printcharfun);
1238 being_printed[print_depth] = obj;
1241 if (print_depth > PRINT_CIRCLE)
1242 error ("Apparently circular structure being printed");
1244 switch (XTYPE (obj))
1246 case Lisp_Type_Int_Even:
1247 case Lisp_Type_Int_Odd:
1249 /* ASCII Decimal representation uses 2.4 times as many bits as
1251 char buf[3 * sizeof (EMACS_INT) + 5];
1252 long_to_string (buf, XINT (obj));
1253 write_c_string (buf, printcharfun);
1257 case Lisp_Type_Char:
1259 /* God intended that this be #\..., you know. */
1261 Emchar ch = XCHAR (obj);
1269 case '\t': *p++ = 't'; break;
1270 case '\n': *p++ = 'n'; break;
1271 case '\r': *p++ = 'r'; break;
1275 if ((ch + 64) == '\\')
1282 /* syntactically special characters should be escaped. */
1305 *p++ = '\\', *p++ = '^', *p++ = '?';
1309 *p++ = '\\', *p++ = '^';
1310 p += set_charptr_emchar ((Bufbyte *) p, ch + 64);
1314 p += set_charptr_emchar ((Bufbyte *) p, ch);
1317 output_string (printcharfun, (Bufbyte *) buf, Qnil, 0, p - buf);
1322 case Lisp_Type_Record:
1324 struct lrecord_header *lheader = XRECORD_LHEADER (obj);
1325 struct gcpro gcpro1, gcpro2;
1327 if (CONSP (obj) || VECTORP(obj))
1329 /* If deeper than spec'd depth, print placeholder. */
1330 if (INTP (Vprint_level)
1331 && print_depth > XINT (Vprint_level))
1333 GCPRO2 (obj, printcharfun);
1334 write_c_string ("...", printcharfun);
1340 GCPRO2 (obj, printcharfun);
1341 if (LHEADER_IMPLEMENTATION (lheader)->printer)
1342 ((LHEADER_IMPLEMENTATION (lheader)->printer)
1343 (obj, printcharfun, escapeflag));
1345 default_object_printer (obj, printcharfun, escapeflag);
1352 #ifdef ERROR_CHECK_TYPECHECK
1354 #else /* not ERROR_CHECK_TYPECHECK */
1356 /* We're in trouble if this happens! */
1358 error ("printing illegal data type #o%03o",
1360 write_c_string ("#<EMACS BUG: ILLEGAL DATATYPE ",
1362 sprintf (buf, "(#o%3o)", (int) XTYPE (obj));
1363 write_c_string (buf, printcharfun);
1365 (" Save your buffers immediately and please report this bug>",
1367 #endif /* not ERROR_CHECK_TYPECHECK */
1376 #ifdef LISP_FLOAT_TYPE
1378 print_float (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1380 char pigbuf[350]; /* see comments in float_to_string */
1382 float_to_string (pigbuf, XFLOAT_DATA (obj));
1383 write_c_string (pigbuf, printcharfun);
1385 #endif /* LISP_FLOAT_TYPE */
1388 print_symbol (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1390 /* This function can GC */
1391 /* #### Bug!! (intern "") isn't printed in some distinguished way */
1392 /* #### (the reader also loses on it) */
1393 Lisp_String *name = symbol_name (XSYMBOL (obj));
1394 Bytecount size = string_length (name);
1395 struct gcpro gcpro1, gcpro2;
1399 /* This deals with GC-relocation */
1400 Lisp_Object nameobj;
1401 XSETSTRING (nameobj, name);
1402 output_string (printcharfun, 0, nameobj, 0, size);
1405 GCPRO2 (obj, printcharfun);
1407 /* If we print an uninterned symbol as part of a complex object and
1408 the flag print-gensym is non-nil, prefix it with #n= to read the
1409 object back with the #n# reader syntax later if needed. */
1410 if (!NILP (Vprint_gensym)
1411 /* #### Test whether this produces a noticeable slow-down for
1412 printing when print-gensym is non-nil. */
1413 && !EQ (obj, oblookup (Vobarray,
1414 string_data (symbol_name (XSYMBOL (obj))),
1415 string_length (symbol_name (XSYMBOL (obj))))))
1417 if (print_depth > 1)
1419 Lisp_Object tem = Fassq (obj, Vprint_gensym_alist);
1422 write_char_internal ("#", printcharfun);
1423 print_internal (XCDR (tem), printcharfun, escapeflag);
1424 write_char_internal ("#", printcharfun);
1430 if (CONSP (Vprint_gensym_alist))
1432 /* Vprint_gensym_alist is exposed to Lisp, so we
1433 have to be careful. */
1434 CHECK_CONS (XCAR (Vprint_gensym_alist));
1435 CHECK_INT (XCDR (XCAR (Vprint_gensym_alist)));
1436 XSETINT (tem, XINT (XCDR (XCAR (Vprint_gensym_alist))) + 1);
1440 Vprint_gensym_alist = Fcons (Fcons (obj, tem), Vprint_gensym_alist);
1442 write_char_internal ("#", printcharfun);
1443 print_internal (tem, printcharfun, escapeflag);
1444 write_char_internal ("=", printcharfun);
1447 write_c_string ("#:", printcharfun);
1450 /* Does it look like an integer or a float? */
1452 Bufbyte *data = string_data (name);
1453 Bytecount confusing = 0;
1456 goto not_yet_confused; /* Really confusing */
1457 else if (isdigit (data[0]))
1460 goto not_yet_confused;
1461 else if (data[0] == '-' || data[0] == '+')
1464 goto not_yet_confused;
1466 for (; confusing < size; confusing++)
1468 if (!isdigit (data[confusing]))
1476 #ifdef LISP_FLOAT_TYPE
1478 /* #### Ugh, this is needlessly complex and slow for what we
1479 need here. It might be a good idea to copy equivalent code
1480 from FSF. --hniksic */
1481 confusing = isfloat_string ((char *) data);
1484 write_char_internal ("\\", printcharfun);
1488 Lisp_Object nameobj;
1492 XSETSTRING (nameobj, name);
1493 for (i = 0; i < size; i++)
1495 switch (string_byte (name, i))
1497 case 0: case 1: case 2: case 3:
1498 case 4: case 5: case 6: case 7:
1499 case 8: case 9: case 10: case 11:
1500 case 12: case 13: case 14: case 15:
1501 case 16: case 17: case 18: case 19:
1502 case 20: case 21: case 22: case 23:
1503 case 24: case 25: case 26: case 27:
1504 case 28: case 29: case 30: case 31:
1505 case ' ': case '\"': case '\\': case '\'':
1506 case ';': case '#' : case '(' : case ')':
1507 case ',': case '.' : case '`' :
1508 case '[': case ']' : case '?' :
1510 output_string (printcharfun, 0, nameobj, last, i - last);
1511 write_char_internal ("\\", printcharfun);
1515 output_string (printcharfun, 0, nameobj, last, size - last);
1521 /* Useful on systems or in places where writing to stdout is unavailable or
1524 static int alternate_do_pointer;
1525 static char alternate_do_string[5000];
1527 DEFUN ("alternate-debugging-output", Falternate_debugging_output, 1, 1, 0, /*
1528 Append CHARACTER to the array `alternate_do_string'.
1529 This can be used in place of `external-debugging-output' as a function
1530 to be passed to `print'. Before calling `print', set `alternate_do_pointer'
1535 Bufbyte str[MAX_EMCHAR_LEN];
1538 const Extbyte *extptr;
1540 CHECK_CHAR_COERCE_INT (character);
1541 len = set_charptr_emchar (str, XCHAR (character));
1542 TO_EXTERNAL_FORMAT (DATA, (str, len),
1543 ALLOCA, (extptr, extlen),
1545 memcpy (alternate_do_string + alternate_do_pointer, extptr, extlen);
1546 alternate_do_pointer += extlen;
1547 alternate_do_string[alternate_do_pointer] = 0;
1551 DEFUN ("external-debugging-output", Fexternal_debugging_output, 1, 3, 0, /*
1552 Write CHAR-OR-STRING to stderr or stdout.
1553 If optional arg STDOUT-P is non-nil, write to stdout; otherwise, write
1554 to stderr. You can use this function to write directly to the terminal.
1555 This function can be used as the STREAM argument of Fprint() or the like.
1557 Under MS Windows, this writes output to the console window (which is
1558 created, if necessary), unless XEmacs is being run noninteractively
1559 \(i.e. using the `-batch' argument).
1561 If you have opened a termscript file (using `open-termscript'), then
1562 the output also will be logged to this file.
1564 (char_or_string, stdout_p, device))
1567 struct console *con = 0;
1571 if (!NILP (stdout_p))
1578 CHECK_LIVE_DEVICE (device);
1579 if (!DEVICE_TTY_P (XDEVICE (device)) &&
1580 !DEVICE_STREAM_P (XDEVICE (device)))
1581 signal_simple_error ("Must be tty or stream device", device);
1582 con = XCONSOLE (DEVICE_CONSOLE (XDEVICE (device)));
1583 if (DEVICE_TTY_P (XDEVICE (device)))
1585 else if (!NILP (stdout_p))
1586 file = CONSOLE_STREAM_DATA (con)->out;
1588 file = CONSOLE_STREAM_DATA (con)->err;
1591 if (STRINGP (char_or_string))
1592 write_string_to_stdio_stream (file, con,
1593 XSTRING_DATA (char_or_string),
1594 0, XSTRING_LENGTH (char_or_string),
1598 Bufbyte str[MAX_EMCHAR_LEN];
1601 CHECK_CHAR_COERCE_INT (char_or_string);
1602 len = set_charptr_emchar (str, XCHAR (char_or_string));
1603 write_string_to_stdio_stream (file, con, str, 0, len, Qterminal, 1);
1606 return char_or_string;
1609 DEFUN ("open-termscript", Fopen_termscript, 1, 1, "FOpen termscript file: ", /*
1610 Start writing all terminal output to FILENAME as well as the terminal.
1611 FILENAME = nil means just close any termscript file currently open.
1615 /* This function can GC */
1616 if (termscript != 0)
1618 fclose (termscript);
1622 if (! NILP (filename))
1624 filename = Fexpand_file_name (filename, Qnil);
1625 termscript = fopen ((char *) XSTRING_DATA (filename), "w");
1626 if (termscript == NULL)
1627 report_file_error ("Opening termscript", list1 (filename));
1633 /* Debugging kludge -- unbuffered */
1634 static int debug_print_length = 50;
1635 static int debug_print_level = 15;
1636 static int debug_print_readably = -1;
1639 debug_print_no_newline (Lisp_Object debug_print_obj)
1641 /* This function can GC */
1642 int save_print_readably = print_readably;
1643 int save_print_depth = print_depth;
1644 Lisp_Object save_Vprint_length = Vprint_length;
1645 Lisp_Object save_Vprint_level = Vprint_level;
1646 Lisp_Object save_Vinhibit_quit = Vinhibit_quit;
1647 struct gcpro gcpro1, gcpro2, gcpro3;
1648 GCPRO3 (save_Vprint_level, save_Vprint_length, save_Vinhibit_quit);
1651 stderr_out ("** gc-in-progress! Bad idea to print anything! **\n");
1654 print_readably = debug_print_readably != -1 ? debug_print_readably : 0;
1656 /* Could use unwind-protect, but why bother? */
1657 if (debug_print_length > 0)
1658 Vprint_length = make_int (debug_print_length);
1659 if (debug_print_level > 0)
1660 Vprint_level = make_int (debug_print_level);
1662 print_internal (debug_print_obj, Qexternal_debugging_output, 1);
1663 alternate_do_pointer = 0;
1664 print_internal (debug_print_obj, Qalternate_debugging_output, 1);
1666 /* Write out to the debugger, as well */
1667 print_internal (debug_print_obj, Qmswindows_debugging_output, 1);
1670 Vinhibit_quit = save_Vinhibit_quit;
1671 Vprint_level = save_Vprint_level;
1672 Vprint_length = save_Vprint_length;
1673 print_depth = save_print_depth;
1674 print_readably = save_print_readably;
1680 debug_print (Lisp_Object debug_print_obj)
1682 debug_print_no_newline (debug_print_obj);
1686 /* Debugging kludge -- unbuffered */
1687 /* This function provided for the benefit of the debugger. */
1688 void debug_backtrace (void);
1690 debug_backtrace (void)
1692 /* This function can GC */
1693 int old_print_readably = print_readably;
1694 int old_print_depth = print_depth;
1695 Lisp_Object old_print_length = Vprint_length;
1696 Lisp_Object old_print_level = Vprint_level;
1697 Lisp_Object old_inhibit_quit = Vinhibit_quit;
1699 struct gcpro gcpro1, gcpro2, gcpro3;
1700 GCPRO3 (old_print_level, old_print_length, old_inhibit_quit);
1703 stderr_out ("** gc-in-progress! Bad idea to print anything! **\n");
1708 /* Could use unwind-protect, but why bother? */
1709 if (debug_print_length > 0)
1710 Vprint_length = make_int (debug_print_length);
1711 if (debug_print_level > 0)
1712 Vprint_level = make_int (debug_print_level);
1714 Fbacktrace (Qexternal_debugging_output, Qt);
1717 Vinhibit_quit = old_inhibit_quit;
1718 Vprint_level = old_print_level;
1719 Vprint_length = old_print_length;
1720 print_depth = old_print_depth;
1721 print_readably = old_print_readably;
1728 debug_short_backtrace (int length)
1731 struct backtrace *bt = backtrace_list;
1733 while (length > 0 && bt)
1739 if (COMPILED_FUNCTIONP (*bt->function))
1741 #if defined(COMPILED_FUNCTION_ANNOTATION_HACK)
1743 compiled_function_annotation (XCOMPILED_FUNCTION (*bt->function));
1745 Lisp_Object ann = Qnil;
1749 stderr_out ("<compiled-function from ");
1750 debug_print_no_newline (ann);
1755 stderr_out ("<compiled-function of unknown origin>");
1759 debug_print_no_newline (*bt->function);
1767 #endif /* debugging kludge */
1771 syms_of_print (void)
1773 defsymbol (&Qstandard_output, "standard-output");
1775 defsymbol (&Qprint_length, "print-length");
1777 defsymbol (&Qprint_string_length, "print-string-length");
1779 defsymbol (&Qdisplay_error, "display-error");
1780 defsymbol (&Qprint_message_label, "print-message-label");
1783 DEFSUBR (Fprin1_to_string);
1786 DEFSUBR (Ferror_message_string);
1787 DEFSUBR (Fdisplay_error);
1789 DEFSUBR (Fwrite_char);
1790 DEFSUBR (Falternate_debugging_output);
1791 DEFSUBR (Fexternal_debugging_output);
1792 DEFSUBR (Fopen_termscript);
1793 defsymbol (&Qexternal_debugging_output, "external-debugging-output");
1794 defsymbol (&Qalternate_debugging_output, "alternate-debugging-output");
1795 #ifdef HAVE_MS_WINDOWS
1796 defsymbol (&Qmswindows_debugging_output, "mswindows-debugging-output");
1798 DEFSUBR (Fwith_output_to_temp_buffer);
1802 reinit_vars_of_print (void)
1804 alternate_do_pointer = 0;
1808 vars_of_print (void)
1810 reinit_vars_of_print ();
1812 DEFVAR_LISP ("standard-output", &Vstandard_output /*
1813 Output stream `print' uses by default for outputting a character.
1814 This may be any function of one argument.
1815 It may also be a buffer (output is inserted before point)
1816 or a marker (output is inserted and the marker is advanced)
1817 or the symbol t (output appears in the minibuffer line).
1819 Vstandard_output = Qt;
1821 #ifdef LISP_FLOAT_TYPE
1822 DEFVAR_LISP ("float-output-format", &Vfloat_output_format /*
1823 The format descriptor string that lisp uses to print floats.
1824 This is a %-spec like those accepted by `printf' in C,
1825 but with some restrictions. It must start with the two characters `%.'.
1826 After that comes an integer precision specification,
1827 and then a letter which controls the format.
1828 The letters allowed are `e', `f' and `g'.
1829 Use `e' for exponential notation "DIG.DIGITSeEXPT"
1830 Use `f' for decimal point notation "DIGITS.DIGITS".
1831 Use `g' to choose the shorter of those two formats for the number at hand.
1832 The precision in any of these cases is the number of digits following
1833 the decimal point. With `f', a precision of 0 means to omit the
1834 decimal point. 0 is not allowed with `f' or `g'.
1836 A value of nil means to use `%.16g'.
1838 Regardless of the value of `float-output-format', a floating point number
1839 will never be printed in such a way that it is ambiguous with an integer;
1840 that is, a floating-point number will always be printed with a decimal
1841 point and/or an exponent, even if the digits following the decimal point
1842 are all zero. This is to preserve read-equivalence.
1844 Vfloat_output_format = Qnil;
1845 #endif /* LISP_FLOAT_TYPE */
1847 DEFVAR_LISP ("print-length", &Vprint_length /*
1848 Maximum length of list or vector to print before abbreviating.
1849 A value of nil means no limit.
1851 Vprint_length = Qnil;
1853 DEFVAR_LISP ("print-string-length", &Vprint_string_length /*
1854 Maximum length of string to print before abbreviating.
1855 A value of nil means no limit.
1857 Vprint_string_length = Qnil;
1859 DEFVAR_LISP ("print-level", &Vprint_level /*
1860 Maximum depth of list nesting to print before abbreviating.
1861 A value of nil means no limit.
1863 Vprint_level = Qnil;
1865 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines /*
1866 Non-nil means print newlines in strings as backslash-n.
1868 print_escape_newlines = 0;
1870 DEFVAR_BOOL ("print-readably", &print_readably /*
1871 If non-nil, then all objects will be printed in a readable form.
1872 If an object has no readable representation, then an error is signalled.
1873 When print-readably is true, compiled-function objects will be written in
1874 #[...] form instead of in #<compiled-function [...]> form, and two-element
1875 lists of the form (quote object) will be written as the equivalent 'object.
1876 Do not SET this variable; bind it instead.
1880 /* #### I think this should default to t. But we'd better wait
1881 until we see that it works out. */
1882 DEFVAR_LISP ("print-gensym", &Vprint_gensym /*
1883 If non-nil, then uninterned symbols will be printed specially.
1884 Uninterned symbols are those which are not present in `obarray', that is,
1885 those which were made with `make-symbol' or by calling `intern' with a
1888 When print-gensym is true, such symbols will be preceded by "#:",
1889 which causes the reader to create a new symbol instead of interning
1890 and returning an existing one. Beware: the #: syntax creates a new
1891 symbol each time it is seen, so if you print an object which contains
1892 two pointers to the same uninterned symbol, `read' will not duplicate
1895 If the value of `print-gensym' is a cons cell, then in addition
1896 refrain from clearing `print-gensym-alist' on entry to and exit from
1897 printing functions, so that the use of #...# and #...= can carry over
1898 for several separately printed objects.
1900 Vprint_gensym = Qnil;
1902 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist /*
1903 Association list of elements (GENSYM . N) to guide use of #N# and #N=.
1904 In each element, GENSYM is an uninterned symbol that has been associated
1905 with #N= for the specified value of N.
1907 Vprint_gensym_alist = Qnil;
1909 DEFVAR_LISP ("print-message-label", &Vprint_message_label /*
1910 Label for minibuffer messages created with `print'. This should
1911 generally be bound with `let' rather than set. (See `display-message'.)
1913 Vprint_message_label = Qprint;