Coverity: UNINIT: CID 393
[sxemacs] / src / print.c
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, 2002 Ben Wing.
4
5 This file is part of SXEmacs
6
7 SXEmacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
11
12 SXEmacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
19
20
21 /* Synched up with: Not synched with FSF. */
22
23 /* This file has been Mule-ized. */
24
25 /* Seriously hacked on by Ben Wing for Mule. */
26
27 #include <config.h>
28 #include "lisp.h"
29
30 #include "backtrace.h"
31 #include "buffer.h"
32 #include "bytecode.h"
33 #include "ui/TTY/console-tty.h" /* for stuff in
34                                    write_string_to_stdio_stream. Needs
35                                    refacturing */
36 #include "ui/console-stream.h"
37 #include "extents.h"
38 #include "ui/frame.h"
39 #include "ui/insdel.h"
40 #include "lstream.h"
41 #include "sysfile.h"
42
43 #include <float.h>
44 /* Define if not in float.h */
45 #ifndef DBL_DIG
46 #define DBL_DIG 16
47 #endif
48
49 Lisp_Object Vstandard_output, Qstandard_output;
50
51 /* The subroutine object for external-debugging-output is kept here
52    for the convenience of the debugger.  */
53 Lisp_Object Qexternal_debugging_output, Qalternate_debugging_output;
54
55 /* Avoid actual stack overflow in print.  */
56 static int print_depth;
57
58 /* Detect most circularities to print finite output.  */
59 #define PRINT_CIRCLE 200
60 static Lisp_Object being_printed[PRINT_CIRCLE];
61
62 /* Maximum length of list or vector to print in full; noninteger means
63    effectively infinity */
64
65 Lisp_Object Vprint_length;
66 Lisp_Object Qprint_length;
67
68 /* Maximum length of string to print in full; noninteger means
69    effectively infinity */
70
71 Lisp_Object Vprint_string_length;
72 Lisp_Object Qprint_string_length;
73
74 /* Maximum depth of list to print in full; noninteger means
75    effectively infinity.  */
76
77 Lisp_Object Vprint_level;
78
79 /* Label to use when making echo-area messages. */
80
81 Lisp_Object Vprint_message_label;
82
83 /* Nonzero means print newlines in strings as \n.  */
84
85 int print_escape_newlines;
86 int print_readably;
87
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;
93
94 Lisp_Object Qdisplay_error;
95 Lisp_Object Qprint_message_label;
96
97 Lisp_Object Vcustom_object_printer;
98
99 /* Force immediate output of all printed data.  Used for debugging. */
100 int print_unbuffered;
101
102 FILE *termscript;               /* Stdio stream being used for copy of all output.  */
103 \f
104 int stdout_needs_newline;
105
106 void debug_backtrace(void);
107
108 static void
109 std_handle_out_external(FILE * stream, Lisp_Object lstream,
110                         const Extbyte * extptr, Extcount extlen,
111                         /* is this really stdout/stderr?
112                            (controls termscript writing) */
113                         int output_is_std_handle, int must_flush)
114 {
115         assert(extptr != NULL);
116
117         if ( extlen == 0 ) {
118                 stdout_needs_newline = 1;
119                 return;
120         }
121         if (stream) {
122                 fwrite(extptr, 1, extlen, stream);
123                 if (must_flush) fflush(stream);
124         } else
125                 Lstream_write(XLSTREAM(lstream), extptr, extlen);
126
127         if (output_is_std_handle) {
128                 if (termscript) {
129                         fwrite(extptr, 1, extlen, termscript);
130                         fflush(termscript);
131                 }
132                 stdout_needs_newline = extptr[extlen - 1] != '\n';
133         }
134 }
135
136
137 #define SXE_VSNPRINT_VA(ret__,sbuf__,buf__,size__,spec__,tries__,type__,fmt__,args__) \
138         do {                                                            \
139                 --tries__;                                              \
140                 ret__ = vsnprintf((char*)buf__,size__,fmt__,args__);    \
141                 if ( ret__ == 0 ) {                                     \
142                         /* Nothing to write */                          \
143                         break;                                          \
144                 } else if ( ret__ < 0 ) {                               \
145                         XMALLOC_UNBIND(buf__,size__,spec__);            \
146                         size__ *= 2;                                    \
147                         XMALLOC_OR_ALLOCA(buf__,size__,type__);         \
148                 } else if ( (size_t)ret__ > (size_t)size__ ) {          \
149                     /* We need more space, so we need to allocate it */ \
150                         XMALLOC_UNBIND(buf__,size__,spec__);            \
151                         size__ = ret__ + 1;                             \
152                         XMALLOC_OR_ALLOCA(buf__,size__,type__);         \
153                         ret__ = -1;                                     \
154                 }                                                       \
155         } while( ret__ < 0 && tries__ > 0 )
156
157
158 int write_fmt_str(Lisp_Object stream, const char* fmt, ...)
159 {
160         char   *kludge;
161         va_list args;
162         int     bufsize, retval, tries = 3;
163         /* write_fmt_str is used for small prints usually... */
164         char    buffer[64+1];   
165         int speccount = specpdl_depth();
166
167         va_start(args, fmt);
168         kludge = buffer;
169         bufsize = sizeof(buffer);
170
171         SXE_VSNPRINT_VA(retval,buffer,kludge,bufsize,speccount,tries,char,fmt,args);
172
173         if (retval>0)
174                 write_c_string(kludge,stream);
175
176         XMALLOC_UNBIND(kludge, bufsize, speccount);
177         va_end(args);
178
179         if (retval < 0)
180                 error("Error attempting to write write format string '%s'",
181                       fmt);
182         return retval;
183 }
184
185 int write_fmt_string(Lisp_Object stream, const char *fmt, ...)
186 {
187         char   *kludge;
188         va_list args;
189         int     bufsize, retval, tries = 3;
190         /* write_va is used for small prints usually... */
191         char    buffer[128+1];
192         int speccount = specpdl_depth();
193
194         va_start(args, fmt);
195         kludge = buffer;
196         bufsize = sizeof(buffer);
197
198         SXE_VSNPRINT_VA(retval,buffer,kludge,bufsize,speccount,tries,char,fmt,args);
199         if (retval>0)
200                 write_c_string(kludge,stream);
201         XMALLOC_UNBIND(kludge, bufsize, speccount);
202         va_end(args);
203
204         if (retval < 0)
205                 error("Error attempting to write write format string '%s'",
206                       fmt);
207         return retval;
208 }
209
210 /* #### The following function should be replaced a call to the
211    emacs_doprnt_*() functions.  This is the only way to ensure that
212    I18N3 works properly (many implementations of the *printf()
213    functions, including the ones included in glibc, do not implement
214    the %###$ argument-positioning syntax).
215
216    Note, however, that to do this, we'd have to
217
218    1) pre-allocate all the lstreams and do whatever else was necessary
219    to make sure that no allocation occurs, since these functions may be
220    called from fatal_error_signal().
221
222    2) (to be really correct) make a new lstream that outputs using
223    mswindows_output_console_string().  */
224
225 static int std_handle_out_va(FILE * stream, const char *fmt, va_list args)
226 {
227         int      retval, tries = 3;
228         size_t   bufsize;
229         int      use_fprintf;
230         Bufbyte *kludge;
231         Bufbyte  buffer[1024]; /* Tax stack lightly, used to be 16KiB */
232         int      speccount = specpdl_depth();
233
234         bufsize = sizeof(buffer);
235         kludge = buffer;
236
237         SXE_VSNPRINT_VA(retval,buffer,kludge,bufsize,speccount,tries,Bufbyte,fmt,args);
238         
239         if (retval == 0)
240                 /* nothing to write */
241                 return retval;
242
243         use_fprintf = ! initialized ||fatal_error_in_progress || 
244                 inhibit_non_essential_printing_operations;
245
246         if (retval > 0) {
247                 if (use_fprintf) {
248                         fprintf(stream,"%s",(char*)kludge);
249                 } else {
250                         Extbyte  *extptr = NULL;
251                         Extcount extlen = retval;
252
253                         TO_EXTERNAL_FORMAT(DATA, (kludge, strlen((char *)kludge)),
254                                            ALLOCA, (extptr, extlen), Qnative);
255                         std_handle_out_external(stream, Qnil, extptr, extlen, 1, 1);
256                 }
257         } else {
258                 if (use_fprintf) {
259                         fprintf(stream,"Error attempting to write format string '%s'",
260                                 fmt);
261                 } else {
262                         const Extbyte *msg = "Error attempting to write format string";
263                         std_handle_out_external(stream, Qnil, msg, strlen(msg), 1, 1);
264                 }
265         }
266         XMALLOC_UNBIND(kludge, bufsize, speccount);
267         return retval;
268 }
269
270
271 /* Output portably to stderr or its equivalent; call GETTEXT on the
272    format string.  Automatically flush when done. */
273
274 int stderr_out(const char *fmt, ...)
275 {
276         int retval;
277         va_list args;
278         va_start(args, fmt);
279         retval =
280             std_handle_out_va
281             (stderr, initialized
282              && !fatal_error_in_progress ? GETTEXT(fmt) : fmt, args);
283         va_end(args);
284         return retval;
285 }
286
287 /* Output portably to stdout or its equivalent; call GETTEXT on the
288    format string.  Automatically flush when done. */
289
290 int stdout_out(const char *fmt, ...)
291 {
292         int retval;
293         va_list args;
294         va_start(args, fmt);
295         retval = std_handle_out_va(stdout, 
296                                    (initialized && !fatal_error_in_progress 
297                                     ? GETTEXT(fmt) : fmt), 
298                                    args);
299         va_end(args);
300         return retval;
301 }
302
303 DOESNT_RETURN fatal(const char *fmt, ...)
304 {
305         va_list args;
306         va_start(args, fmt);
307
308         stderr_out("\nSXEmacs: ");
309         std_handle_out_va(stderr, 
310                           (initialized && !fatal_error_in_progress 
311                            ? GETTEXT(fmt) : fmt), 
312                           args);
313         stderr_out("\n");
314
315         va_end(args);
316         exit(1);
317 }
318
319 /* Write a string (in internal format) to stdio stream STREAM. */
320
321 void
322 write_string_to_stdio_stream(FILE * stream, struct console *con,
323                              const Bufbyte * str,
324                              Bytecount offset, Bytecount len,
325                              Lisp_Object coding_system, int must_flush)
326 {
327         Extcount extlen;
328         const Extbyte *extptr = NULL;
329
330         /* #### yuck! sometimes this function is called with string data,
331            and the following call may gc. */
332         {
333                 Bufbyte *puta = (Bufbyte *) alloca(len);
334                 memcpy(puta, str + offset, len);
335
336                 if (initialized && !inhibit_non_essential_printing_operations) {
337                         TO_EXTERNAL_FORMAT(DATA, (puta, len),
338                                            ALLOCA, (extptr, extlen),
339                                            coding_system);
340                 }
341                 if( extptr == NULL ) {
342                         extptr = (Extbyte *) puta;
343                         extlen = (Bytecount) len;
344                 }
345         }
346
347         
348         if (stream) {
349                 std_handle_out_external(stream, Qnil, extptr, extlen,
350                                         stream == stdout
351                                         || stream == stderr, must_flush);
352         } else if(con != NULL) {
353                 assert(CONSOLE_TTY_P(con));
354                 std_handle_out_external(0, CONSOLE_TTY_DATA(con)->outstream,
355                                         extptr, extlen,
356                                         CONSOLE_TTY_DATA(con)->is_stdio,
357                                         must_flush);
358         } else {
359                 error("Error attempting to write write '%s' with no stream nor console", str);
360                 debug_backtrace();
361                 abort();
362         }
363 }
364
365 /* Write a string to the output location specified in FUNCTION.
366    Arguments NONRELOC, RELOC, OFFSET, and LEN are as in
367    buffer_insert_string_1() in insdel.c. */
368
369 static void
370 output_string(Lisp_Object function, const Bufbyte * nonreloc,
371               Lisp_Object reloc, Bytecount offset, Bytecount len)
372 {
373         /* This function can GC */
374         Charcount cclen;
375         /* We change the value of nonreloc (fetching it from reloc as
376            necessary), but we don't want to pass this changed value on to
377            other functions that take both a nonreloc and a reloc, or things
378            may get confused and an assertion failure in
379            fixup_internal_substring() may get triggered. */
380         const Bufbyte *newnonreloc = nonreloc;
381         struct gcpro gcpro1, gcpro2;
382
383         /* Emacs won't print while GCing, but an external debugger might */
384         if (gc_in_progress)
385                 return;
386
387         /* Perhaps not necessary but probably safer. */
388         GCPRO2(function, reloc);
389
390         fixup_internal_substring(newnonreloc, reloc, offset, &len);
391
392         if (STRINGP(reloc))
393                 newnonreloc = XSTRING_DATA(reloc);
394
395         cclen = bytecount_to_charcount(newnonreloc + offset, len);
396
397         if (LSTREAMP(function)) {
398                 if (STRINGP(reloc)) {
399                         /* Protect against Lstream_write() causing a GC and
400                            relocating the string.  For small strings, we do it by
401                            alloc'ing the string and using a copy; for large strings,
402                            we inhibit GC.  */
403                         if (len < 65536) {
404                                 Bufbyte *copied = alloca_array(Bufbyte, len);
405                                 memcpy(copied, newnonreloc + offset, len);
406                                 Lstream_write(XLSTREAM(function), copied, len);
407                         } else {
408                                 int speccount = specpdl_depth();
409                                 record_unwind_protect(restore_gc_inhibit,
410                                                       make_int
411                                                       (gc_currently_forbidden));
412                                 gc_currently_forbidden = 1;
413                                 Lstream_write(XLSTREAM(function),
414                                               newnonreloc + offset, len);
415                                 unbind_to(speccount, Qnil);
416                         }
417                 } else
418                         Lstream_write(XLSTREAM(function), newnonreloc + offset,
419                                       len);
420
421                 if (print_unbuffered)
422                         Lstream_flush(XLSTREAM(function));
423         } else if (BUFFERP(function)) {
424                 CHECK_LIVE_BUFFER(function);
425                 buffer_insert_string(XBUFFER(function), nonreloc, reloc, offset,
426                                      len);
427         } else if (MARKERP(function)) {
428                 /* marker_position() will err if marker doesn't point anywhere.  */
429                 Bufpos spoint = marker_position(function);
430
431                 buffer_insert_string_1(XMARKER(function)->buffer,
432                                        spoint, nonreloc, reloc, offset, len, 0);
433                 Fset_marker(function, make_int(spoint + cclen),
434                             Fmarker_buffer(function));
435         } else if (FRAMEP(function)) {
436                 /* This gets used by functions not invoking print_prepare(),
437                    such as Fwrite_char, Fterpri, etc..  */
438                 struct frame *f = XFRAME(function);
439                 CHECK_LIVE_FRAME(function);
440
441                 if (!EQ(Vprint_message_label, echo_area_status(f)))
442                         clear_echo_area_from_print(f, Qnil, 1);
443                 echo_area_append(f, nonreloc, reloc, offset, len,
444                                  Vprint_message_label);
445         } else if (EQ(function, Qt) || EQ(function, Qnil)) {
446                 write_string_to_stdio_stream(stdout, 0, newnonreloc, offset,
447                                              len, Qterminal, print_unbuffered);
448         } else {
449                 Charcount ccoff = bytecount_to_charcount(newnonreloc, offset);
450                 Charcount iii;
451
452                 for (iii = ccoff; iii < cclen + ccoff; iii++) {
453                         call1(function,
454                               make_char(charptr_emchar_n(newnonreloc, iii)));
455                         if (STRINGP(reloc))
456                                 newnonreloc = XSTRING_DATA(reloc);
457                 }
458         }
459
460         UNGCPRO;
461 }
462 \f
463 #define RESET_PRINT_GENSYM do {                 \
464   if (!CONSP (Vprint_gensym))                   \
465     Vprint_gensym_alist = Qnil;                 \
466 } while (0)
467
468 static Lisp_Object canonicalize_printcharfun(Lisp_Object printcharfun)
469 {
470         if (NILP(printcharfun))
471                 printcharfun = Vstandard_output;
472
473         if (EQ(printcharfun, Qt) || NILP(printcharfun))
474                 printcharfun = Fselected_frame(Qnil);   /* print to minibuffer */
475
476         return printcharfun;
477 }
478
479 static Lisp_Object
480 print_prepare(Lisp_Object printcharfun, Lisp_Object * frame_kludge)
481 {
482         /* Emacs won't print while GCing, but an external debugger might */
483         if (gc_in_progress)
484                 return Qnil;
485
486         RESET_PRINT_GENSYM;
487
488         printcharfun = canonicalize_printcharfun(printcharfun);
489
490         /* Here we could safely return the canonicalized PRINTCHARFUN.
491            However, if PRINTCHARFUN is a frame, printing of complex
492            structures becomes very expensive, because `append-message'
493            (called by echo_area_append) gets called as many times as
494            output_string() is called (and that's a *lot*).  append-message
495            tries to keep top of the message-stack in sync with the contents
496            of " *Echo Area" buffer, consing a new string for each component
497            of the printed structure.  For instance, if you print (a a),
498            append-message will cons up the following strings:
499
500            "("
501            "(a"
502            "(a "
503            "(a a"
504            "(a a)"
505
506            and will use only the last one.  With larger objects, this turns
507            into an O(n^2) consing frenzy that locks up SXEmacs in incessant
508            garbage collection.
509
510            We prevent this by creating a resizing_buffer stream and letting
511            the printer write into it.  print_finish() will notice this
512            stream, and invoke echo_area_append() with the stream's buffer,
513            only once.  */
514         if (FRAMEP(printcharfun)) {
515                 CHECK_LIVE_FRAME(printcharfun);
516                 *frame_kludge = printcharfun;
517                 printcharfun = make_resizing_buffer_output_stream();
518         }
519
520         return printcharfun;
521 }
522
523 static void print_finish(Lisp_Object stream, Lisp_Object frame_kludge)
524 {
525         /* Emacs won't print while GCing, but an external debugger might */
526         if (gc_in_progress)
527                 return;
528
529         RESET_PRINT_GENSYM;
530
531         /* See the comment in print_prepare().  */
532         if (FRAMEP(frame_kludge)) {
533                 struct frame *f = XFRAME(frame_kludge);
534                 Lstream *str = XLSTREAM(stream);
535                 CHECK_LIVE_FRAME(frame_kludge);
536
537                 Lstream_flush(str);
538                 if (!EQ(Vprint_message_label, echo_area_status(f)))
539                         clear_echo_area_from_print(f, Qnil, 1);
540                 echo_area_append(f, resizing_buffer_stream_ptr(str),
541                                  Qnil, 0, Lstream_byte_count(str),
542                                  Vprint_message_label);
543                 Lstream_delete(str);
544         }
545 }
546 \f
547 /* Used for printing a single-byte character (*not* any Emchar).  */
548 #define write_char_internal(string_of_length_1, stream)                 \
549   output_string (stream, (const Bufbyte *) (string_of_length_1),        \
550                  Qnil, 0, 1)
551
552 /* NOTE: Do not call this with the data of a Lisp_String, as
553    printcharfun might cause a GC, which might cause the string's data
554    to be relocated.  To princ a Lisp string, use:
555
556        print_internal (string, printcharfun, 0);
557
558    Also note that STREAM should be the result of
559    canonicalize_printcharfun() (i.e. Qnil means stdout, not
560    Vstandard_output, etc.)  */
561 void write_string_1(const Bufbyte * str, Bytecount size, Lisp_Object stream)
562 {
563         /* This function can GC */
564 #ifdef ERROR_CHECK_BUFPOS
565         assert(size >= 0);
566 #endif
567         output_string(stream, str, Qnil, 0, size);
568 }
569
570
571 void write_hex_ptr(void* value, Lisp_Object stream)
572 {
573         char buf[sizeof(value)*2+1];
574         int n = snprintf(buf,sizeof(buf),"0x%p",value);
575         assert(n>=0 && (size_t)n<sizeof(buf));
576         write_c_string(buf,stream);
577 }
578
579 void write_c_string(const char *str, Lisp_Object stream)
580 {
581         /* This function can GC */
582         write_string_1((const Bufbyte *)str, strlen(str), stream);
583 }
584
585 \f
586 DEFUN("write-char", Fwrite_char, 1, 2, 0,       /*
587 Output character CHARACTER to stream STREAM.
588 STREAM defaults to the value of `standard-output' (which see).
589 */
590       (character, stream))
591 {
592         /* This function can GC */
593         Bufbyte str[MAX_EMCHAR_LEN];
594         Bytecount len;
595
596         CHECK_CHAR_COERCE_INT(character);
597         len = set_charptr_emchar(str, XCHAR(character));
598         output_string(canonicalize_printcharfun(stream), str, Qnil, 0, len);
599         return character;
600 }
601
602 void temp_output_buffer_setup(Lisp_Object bufname)
603 {
604         /* This function can GC */
605         struct buffer *old = current_buffer;
606         Lisp_Object buf;
607
608 #ifdef I18N3
609         /* #### This function should accept a Lisp_Object instead of a char *,
610            so that proper translation on the buffer name can occur. */
611 #endif
612
613         Fset_buffer(Fget_buffer_create(bufname));
614
615         current_buffer->read_only = Qnil;
616         Ferase_buffer(Qnil);
617
618         XSETBUFFER(buf, current_buffer);
619         specbind(Qstandard_output, buf);
620
621         set_buffer_internal(old);
622 }
623
624 Lisp_Object
625 internal_with_output_to_temp_buffer(Lisp_Object bufname,
626                                     Lisp_Object(*function) (Lisp_Object arg),
627                                     Lisp_Object arg, Lisp_Object same_frame)
628 {
629         int speccount = specpdl_depth();
630         struct gcpro gcpro1, gcpro2, gcpro3;
631         Lisp_Object buf = Qnil;
632
633         GCPRO3(buf, arg, same_frame);
634
635         temp_output_buffer_setup(bufname);
636         buf = Vstandard_output;
637
638         arg = (*function) (arg);
639
640         temp_output_buffer_show(buf, same_frame);
641         UNGCPRO;
642
643         return unbind_to(speccount, arg);
644 }
645
646 DEFUN("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, 1, UNEVALLED, 0,       /*
647 Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
648 The buffer is cleared out initially, and marked as unmodified when done.
649 All output done by BODY is inserted in that buffer by default.
650 The buffer is displayed in another window, but not selected.
651 The value of the last form in BODY is returned.
652 If BODY does not finish normally, the buffer BUFNAME is not displayed.
653
654 If variable `temp-buffer-show-function' is non-nil, call it at the end
655 to get the buffer displayed.  It gets one argument, the buffer to display.
656 */
657       (args))
658 {
659         /* This function can GC */
660         Lisp_Object name = Qnil;
661         int speccount = specpdl_depth();
662         struct gcpro gcpro1, gcpro2;
663         Lisp_Object val = Qnil;
664
665 #ifdef I18N3
666         /* #### should set the buffer to be translating.  See print_internal(). */
667 #endif
668
669         GCPRO2(name, val);
670         name = Feval(XCAR(args));
671
672         CHECK_STRING(name);
673
674         temp_output_buffer_setup(name);
675         UNGCPRO;
676
677         val = Fprogn(XCDR(args));
678
679         temp_output_buffer_show(Vstandard_output, Qnil);
680
681         return unbind_to(speccount, val);
682 }
683 \f
684 DEFUN("terpri", Fterpri, 0, 1, 0,       /*
685 Output a newline to STREAM.
686 If STREAM is omitted or nil, the value of `standard-output' is used.
687 */
688       (stream))
689 {
690         /* This function can GC */
691         write_char_internal("\n", canonicalize_printcharfun(stream));
692         return Qt;
693 }
694
695 DEFUN("prin1", Fprin1, 1, 2, 0, /*
696 Output the printed representation of OBJECT, any Lisp object.
697 Quoting characters are printed when needed to make output that `read'
698 can handle, whenever this is possible.
699 Output stream is STREAM, or value of `standard-output' (which see).
700 */
701       (object, stream))
702 {
703         /* This function can GC */
704         Lisp_Object frame = Qnil;
705         struct gcpro gcpro1, gcpro2;
706         GCPRO2(object, stream);
707
708         print_depth = 0;
709         stream = print_prepare(stream, &frame);
710         print_internal(object, stream, 1);
711         print_finish(stream, frame);
712
713         UNGCPRO;
714         return object;
715 }
716
717 DEFUN("prin1-to-string", Fprin1_to_string, 1, 2, 0,     /*
718 Return a string containing the printed representation of OBJECT,
719 any Lisp object.  Quoting characters are used when needed to make output
720 that `read' can handle, whenever this is possible, unless the optional
721 second argument NOESCAPE is non-nil.
722 */
723       (object, noescape))
724 {
725         /* This function can GC */
726         Lisp_Object result = Qnil;
727         Lisp_Object stream = make_resizing_buffer_output_stream();
728         Lstream *str = XLSTREAM(stream);
729         /* gcpro OBJECT in case a caller forgot to do so */
730         struct gcpro gcpro1, gcpro2, gcpro3;
731         GCPRO3(object, stream, result);
732
733         print_depth = 0;
734         RESET_PRINT_GENSYM;
735         print_internal(object, stream, NILP(noescape));
736         RESET_PRINT_GENSYM;
737         Lstream_flush(str);
738         UNGCPRO;
739         result = make_string(resizing_buffer_stream_ptr(str),
740                              Lstream_byte_count(str));
741         Lstream_delete(str);
742         return result;
743 }
744
745 DEFUN("princ", Fprinc, 1, 2, 0, /*
746 Output the printed representation of OBJECT, any Lisp object.
747 No quoting characters are used; no delimiters are printed around
748 the contents of strings.
749 Output stream is STREAM, or value of `standard-output' (which see).
750 */
751       (object, stream))
752 {
753         /* This function can GC */
754         Lisp_Object frame = Qnil;
755         struct gcpro gcpro1, gcpro2;
756
757         GCPRO2(object, stream);
758         stream = print_prepare(stream, &frame);
759         print_depth = 0;
760         print_internal(object, stream, 0);
761         print_finish(stream, frame);
762         UNGCPRO;
763         return object;
764 }
765
766 DEFUN("print", Fprint, 1, 2, 0, /*
767 Output the printed representation of OBJECT, with newlines around it.
768 Quoting characters are printed when needed to make output that `read'
769 can handle, whenever this is possible.
770 Output stream is STREAM, or value of `standard-output' (which see).
771 */
772       (object, stream))
773 {
774         /* This function can GC */
775         Lisp_Object frame = Qnil;
776         struct gcpro gcpro1, gcpro2;
777
778         GCPRO2(object, stream);
779         stream = print_prepare(stream, &frame);
780         print_depth = 0;
781         write_char_internal("\n", stream);
782         print_internal(object, stream, 1);
783         write_char_internal("\n", stream);
784         print_finish(stream, frame);
785         UNGCPRO;
786         return object;
787 }
788 \f
789 /* Print an error message for the error DATA to STREAM.  This is a
790    complete implementation of `display-error', which used to be in
791    Lisp (see prim/cmdloop.el).  It was ported to C so it can be used
792    efficiently by Ferror_message_string.  Fdisplay_error and
793    Ferror_message_string are trivial wrappers around this function.
794
795    STREAM should be the result of canonicalize_printcharfun().  */
796 static void
797 print_error_message(Lisp_Object error_object, Lisp_Object stream)
798 {
799         /* This function can GC */
800         Lisp_Object type = Fcar_safe(error_object);
801         Lisp_Object method = Qnil;
802         Lisp_Object tail;
803
804         /* No need to GCPRO anything under the assumption that ERROR_OBJECT
805            is GCPRO'd.  */
806
807         if (!(CONSP(error_object) && SYMBOLP(type))) {
808                 Lisp_Object foo = Fget(type, Qerror_conditions, Qnil);
809                 if (CONSP(foo)) {
810                         goto error_throw;
811                 }
812         }
813
814         tail = XCDR(error_object);
815         while (!NILP(tail)) {
816                 if (CONSP(tail))
817                         tail = XCDR(tail);
818                 else
819                         goto error_throw;
820         }
821         tail = Fget(type, Qerror_conditions, Qnil);
822         while (!NILP(tail)) {
823                 if (!(CONSP(tail) && SYMBOLP(XCAR(tail))))
824                         goto error_throw;
825                 else if (!NILP(Fget(XCAR(tail), Qdisplay_error, Qnil))) {
826                         method = Fget(XCAR(tail), Qdisplay_error, Qnil);
827                         goto error_throw;
828                 } else
829                         tail = XCDR(tail);
830         }
831         /* Default method */
832         {
833                 int first = 1;
834                 int speccount = specpdl_depth();
835                 Lisp_Object frame = Qnil;
836                 struct gcpro gcpro1;
837                 GCPRO1(stream);
838
839                 specbind(Qprint_message_label, Qerror);
840                 stream = print_prepare(stream, &frame);
841
842                 tail = Fcdr(error_object);
843                 if (EQ(type, Qerror)) {
844                         print_internal(Fcar(tail), stream, 0);
845                         tail = Fcdr(tail);
846                 } else {
847                         Lisp_Object errmsg = Fget(type, Qerror_message, Qnil);
848                         if (NILP(errmsg))
849                                 print_internal(type, stream, 0);
850                         else
851                                 print_internal(LISP_GETTEXT(errmsg), stream, 0);
852                 }
853                 while (!NILP(tail)) {
854                         write_c_string(first ? ": " : ", ", stream);
855                         print_internal(Fcar(tail), stream, 1);
856                         tail = Fcdr(tail);
857                         first = 0;
858                 }
859                 print_finish(stream, frame);
860                 UNGCPRO;
861                 unbind_to(speccount, Qnil);
862                 return;
863                 /* not reached */
864         }
865
866 error_throw:
867         if (NILP(method)) {
868                 write_c_string(GETTEXT("Peculiar error "), stream);
869                 print_internal(error_object, stream, 1);
870                 return;
871         } else {
872                 call2(method, error_object, stream);
873         }
874 }
875
876 DEFUN("error-message-string", Ferror_message_string, 1, 1, 0,   /*
877 Convert ERROR-OBJECT to an error message, and return it.
878
879 The format of ERROR-OBJECT should be (ERROR-SYMBOL . DATA).  The
880 message is equivalent to the one that would be issued by
881 `display-error' with the same argument.
882 */
883       (error_object))
884 {
885         /* This function can GC */
886         Lisp_Object result = Qnil;
887         Lisp_Object stream = make_resizing_buffer_output_stream();
888         struct gcpro gcpro1;
889         GCPRO1(stream);
890
891         print_error_message(error_object, stream);
892         Lstream_flush(XLSTREAM(stream));
893         result = make_string(resizing_buffer_stream_ptr(XLSTREAM(stream)),
894                              Lstream_byte_count(XLSTREAM(stream)));
895         Lstream_delete(XLSTREAM(stream));
896
897         UNGCPRO;
898         return result;
899 }
900
901 DEFUN("display-error", Fdisplay_error, 2, 2, 0, /*
902 Display ERROR-OBJECT on STREAM in a user-friendly way.
903 */
904       (error_object, stream))
905 {
906         /* This function can GC */
907         print_error_message(error_object, canonicalize_printcharfun(stream));
908         return Qnil;
909 }
910 \f
911 #ifdef HAVE_FPFLOAT
912
913 Lisp_Object Vfloat_output_format;
914
915 /*
916  * This buffer should be at least as large as the max string size of the
917  * largest float, printed in the biggest notation.  This is undoubtedly
918  * 20d float_output_format, with the negative of the C-constant "HUGE"
919  * from <math.h>.
920  *
921  * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
922  *
923  * I assume that IEEE-754 format numbers can take 329 bytes for the worst
924  * case of -1e307 in 20d float_output_format. What is one to do (short of
925  * re-writing _doprnt to be more sane)?
926  *                      -wsr
927  */
928 void float_to_string(char *buf, fpfloat data, int maxlen)
929 {
930         Bufbyte *cp, c;
931         int width, sz;
932
933         if (NILP(Vfloat_output_format) || !STRINGP(Vfloat_output_format)) {
934         lose:
935 #if fpfloat_double_p
936                 sz = snprintf(buf, maxlen, "%.16g", data);
937 #elif fpfloat_long_double_p
938                 sz = snprintf(buf, maxlen, "%.16Lg", data);
939 #endif
940                 assert(sz>=0 && sz<maxlen);
941         } else {                        /* oink oink */
942
943                 /* Check that the spec we have is fully valid.
944                    This means not only valid for printf,
945                    but meant for floats, and reasonable.  */
946                 cp = XSTRING_DATA(Vfloat_output_format);
947
948                 if (cp[0] != '%')
949                         goto lose;
950                 if (cp[1] != '.')
951                         goto lose;
952
953                 cp += 2;
954                 for (width = 0; (c = *cp, isdigit(c)); cp++) {
955                         width *= 10;
956                         width += c - '0';
957                 }
958
959                 if (*cp != 'e' && *cp != 'f' && *cp != 'g' && *cp != 'E'
960                     && *cp != 'G')
961                         goto lose;
962
963                 if (width < (int)(*cp != 'e' && *cp != 'E') || width > DBL_DIG)
964                         goto lose;
965
966                 if (cp[1] != 0)
967                         goto lose;
968
969                 sz = snprintf(buf, maxlen,
970                               (char *)XSTRING_DATA(Vfloat_output_format), data);
971                 assert(sz>=0 && sz < maxlen);
972         }
973
974         /* added by jwz: don't allow "1.0" to print as "1"; that destroys
975            the read-equivalence of lisp objects.  (* x 1) and (* x 1.0) do
976            not do the same thing, so it's important that the printed
977            representation of that form not be corrupted by the printer.
978          */
979         {
980                 Bufbyte *s = (Bufbyte *) buf;   /* don't use signed chars here!
981                                                    isdigit() can't hack them! */
982                 if (*s == '-') {
983                         s++;
984                         maxlen--;
985                         assert(maxlen>0);
986                 }
987                 for (; *s; s++)
988                         /* if there's a non-digit, then there is a decimal point, or
989                            it's in exponential notation, both of which are ok. */
990                         if (!isdigit(*s))
991                                 goto DONE_LABEL;
992                 /* otherwise, we need to hack it. */
993                 maxlen-=2;
994                 assert(maxlen>0);
995                 *s++ = '.';
996                 *s++ = '0';
997                 *s = 0;
998         }
999       DONE_LABEL:
1000
1001         /* Some machines print "0.4" as ".4".  I don't like that. */
1002         if (buf[0] == '.' || (buf[0] == '-' && buf[1] == '.')) {
1003                 assert(maxlen>0);
1004                 int i;
1005                 for (i = strlen(buf) + 1; i >= 0; i--)
1006                         buf[i + 1] = buf[i];
1007                 buf[(buf[0] == '-' ? 1 : 0)] = '0';
1008         }
1009 }
1010 #endif                          /* HAVE_FPFLOAT */
1011
1012 /* Print NUMBER to BUFFER.
1013    This is equivalent to snprintf (buffer, maxlen, "%ld", number), only much faster.
1014
1015    BUFFER should accept 24 bytes.  This should suffice for the longest
1016    numbers on 64-bit machines, including the `-' sign and the trailing
1017    '\0'.  Returns a pointer to the trailing '\0'. */
1018 char *long_to_string(char *buffer, long number, int maxlen)
1019 {
1020 #if (SIZEOF_LONG != 4) && (SIZEOF_LONG != 8)
1021         /* Huh? */
1022         int sz = snprintf(buffer, maxlen, "%ld", number);
1023         assert(sz>=0 && sz < maxlen);
1024         return buffer + strlen(buffer);
1025 #else                           /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
1026         char *p = buffer;
1027         int force = 0;
1028
1029         if (number < 0) {
1030                 *p++ = '-';
1031                 number = -number;
1032         }
1033 #define FROB(figure) \
1034         do {                                                            \
1035                 if (force || number >= figure) {                        \
1036                         *p++ = number / figure + '0';                   \
1037                         number %= figure;                               \
1038                         force = 1;                                      \
1039                         --maxlen;                                       \
1040                         assert(maxlen>0);                               \
1041                 }                                                       \
1042         } while (0)
1043 #if SIZEOF_LONG == 8
1044         FROB(1000000000000000000L);
1045         FROB(100000000000000000L);
1046         FROB(10000000000000000L);
1047         FROB(1000000000000000L);
1048         FROB(100000000000000L);
1049         FROB(10000000000000L);
1050         FROB(1000000000000L);
1051         FROB(100000000000L);
1052         FROB(10000000000L);
1053 #endif                          /* SIZEOF_LONG == 8 */
1054         FROB(1000000000);
1055         FROB(100000000);
1056         FROB(10000000);
1057         FROB(1000000);
1058         FROB(100000);
1059         FROB(10000);
1060         FROB(1000);
1061         FROB(100);
1062         FROB(10);
1063 #undef FROB
1064         *p++ = number + '0';
1065         *p = '\0';
1066         return p;
1067 #endif                          /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
1068 }
1069 \f
1070 static void
1071 print_vector_internal(const char *start, const char *end,
1072                       Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1073 {
1074         /* This function can GC */
1075         int i;
1076         int len = XVECTOR_LENGTH(obj);
1077         int last = len;
1078         struct gcpro gcpro1, gcpro2;
1079         GCPRO2(obj, printcharfun);
1080
1081         if (INTP(Vprint_length)) {
1082                 int max = XINT(Vprint_length);
1083                 if (max < len)
1084                         last = max;
1085         }
1086
1087         write_c_string(start, printcharfun);
1088         for (i = 0; i < last; i++) {
1089                 Lisp_Object elt = XVECTOR_DATA(obj)[i];
1090                 if (i != 0)
1091                         write_char_internal(" ", printcharfun);
1092                 print_internal(elt, printcharfun, escapeflag);
1093         }
1094         UNGCPRO;
1095         if (last != len)
1096                 write_c_string(" ...", printcharfun);
1097         write_c_string(end, printcharfun);
1098 }
1099
1100 void print_cons(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1101 {
1102         /* This function can GC */
1103         struct gcpro gcpro1, gcpro2;
1104
1105         /* If print_readably is on, print (quote -foo-) as '-foo-
1106            (Yeah, this should really be what print-pretty does, but we
1107            don't have the rest of a pretty printer, and this actually
1108            has non-negligible impact on size/speed of .elc files.)
1109          */
1110         if (print_readably &&
1111             EQ(XCAR(obj), Qquote) &&
1112             CONSP(XCDR(obj)) && NILP(XCDR(XCDR(obj)))) {
1113                 obj = XCAR(XCDR(obj));
1114                 GCPRO2(obj, printcharfun);
1115                 write_char_internal("\'", printcharfun);
1116                 UNGCPRO;
1117                 print_internal(obj, printcharfun, escapeflag);
1118                 return;
1119         }
1120
1121         GCPRO2(obj, printcharfun);
1122         write_char_internal("(", printcharfun);
1123
1124         {
1125                 int len;
1126                 int max = INTP(Vprint_length) ? XINT(Vprint_length) : INT_MAX;
1127                 Lisp_Object tortoise;
1128                 /* Use tortoise/hare to make sure circular lists don't infloop */
1129
1130                 for (tortoise = obj, len = 0;
1131                      CONSP(obj); obj = XCDR(obj), len++) {
1132                         if (len > 0)
1133                                 write_char_internal(" ", printcharfun);
1134                         if (EQ(obj, tortoise) && len > 0) {
1135                                 if (print_readably)
1136                                         error
1137                                             ("printing unreadable circular list");
1138                                 else
1139                                         write_c_string("... <circular list>",
1140                                                        printcharfun);
1141                                 break;
1142                         }
1143                         if (len & 1)
1144                                 tortoise = XCDR(tortoise);
1145                         if (len > max) {
1146                                 write_c_string("...", printcharfun);
1147                                 break;
1148                         }
1149                         print_internal(XCAR(obj), printcharfun, escapeflag);
1150                 }
1151         }
1152         if (!LISTP(obj)) {
1153                 write_c_string(" . ", printcharfun);
1154                 print_internal(obj, printcharfun, escapeflag);
1155         }
1156         UNGCPRO;
1157
1158         write_char_internal(")", printcharfun);
1159         return;
1160 }
1161
1162 void print_vector(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1163 {
1164         print_vector_internal("[", "]", obj, printcharfun, escapeflag);
1165 }
1166
1167 void print_string(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1168 {
1169         Lisp_String *s = XSTRING(obj);
1170         /* We distinguish between Bytecounts and Charcounts, to make
1171            Vprint_string_length work correctly under Mule.  */
1172         Charcount size = string_char_length(s);
1173         Charcount max = size;
1174         Bytecount bcmax = string_length(s);
1175         struct gcpro gcpro1, gcpro2;
1176         GCPRO2(obj, printcharfun);
1177
1178         if (INTP(Vprint_string_length) && XINT(Vprint_string_length) < max) {
1179                 max = XINT(Vprint_string_length);
1180                 bcmax = charcount_to_bytecount(string_data(s), max);
1181         }
1182         if (max < 0) {
1183                 max = 0;
1184                 bcmax = 0;
1185         }
1186
1187         if (!escapeflag) {
1188                 /* This deals with GC-relocation and Mule. */
1189                 output_string(printcharfun, 0, obj, 0, bcmax);
1190                 if (max < size)
1191                         write_c_string(" ...", printcharfun);
1192         } else {
1193                 Bytecount i, last = 0;
1194
1195                 write_char_internal("\"", printcharfun);
1196                 for (i = 0; i < bcmax; i++) {
1197                         Bufbyte ch = string_byte(s, i);
1198                         if (ch == '\"' || ch == '\\'
1199                             || (ch == '\n' && print_escape_newlines)) {
1200                                 if (i > last) {
1201                                         output_string(printcharfun, 0, obj,
1202                                                       last, i - last);
1203                                 }
1204                                 if (ch == '\n') {
1205                                         write_c_string("\\n", printcharfun);
1206                                 } else {
1207                                         write_char_internal("\\", printcharfun);
1208                                         /* This is correct for Mule because the
1209                                            character is either \ or " */
1210                                         write_char_internal(string_data(s) + i,
1211                                                             printcharfun);
1212                                 }
1213                                 last = i + 1;
1214                         }
1215                 }
1216                 if (bcmax > last) {
1217                         output_string(printcharfun, 0, obj, last, bcmax - last);
1218                 }
1219                 if (max < size)
1220                         write_c_string(" ...", printcharfun);
1221                 write_char_internal("\"", printcharfun);
1222         }
1223         UNGCPRO;
1224 }
1225
1226 static void
1227 default_object_printer(Lisp_Object obj, Lisp_Object printcharfun,
1228                        int escapeflag)
1229 {
1230         struct lcrecord_header *header = (struct lcrecord_header *)XPNTR(obj);
1231
1232         if (print_readably)
1233                 error("printing unreadable object #<%s 0x%x>",
1234                       LHEADER_IMPLEMENTATION(&header->lheader)->name,
1235                       header->uid);
1236
1237         write_fmt_string(printcharfun, "#<%s 0x%x>",
1238                          LHEADER_IMPLEMENTATION(&header->lheader)->name, header->uid);
1239 }
1240
1241 void
1242 internal_object_printer(Lisp_Object obj, Lisp_Object printcharfun,
1243                         int escapeflag)
1244 {
1245         write_fmt_string(printcharfun, "#<INTERNAL OBJECT (SXEmacs bug?) (%s) 0x%lx>",
1246                          XRECORD_LHEADER_IMPLEMENTATION(obj)->name,
1247                          (unsigned long)XPNTR(obj));
1248 }
1249
1250 enum printing_badness {
1251         BADNESS_INTEGER_OBJECT,
1252         BADNESS_POINTER_OBJECT,
1253         BADNESS_NO_TYPE
1254 };
1255
1256 static void
1257 printing_major_badness(Lisp_Object printcharfun,
1258                        Char_ASCII * badness_string, int type, void *val,
1259                        enum printing_badness badness)
1260 {
1261         char buf[666];
1262         ssize_t len;
1263
1264         switch (badness) {
1265         case BADNESS_INTEGER_OBJECT:
1266                 len = snprintf(buf, sizeof(buf), "%s %d object %ld", badness_string, type,
1267                                (EMACS_INT) val);
1268                 break;
1269
1270         case BADNESS_POINTER_OBJECT:
1271                 len = snprintf(buf, sizeof(buf), "%s %d object %p", badness_string, type, val);
1272                 break;
1273
1274         case BADNESS_NO_TYPE:
1275                 len = snprintf(buf, sizeof(buf), "%s object %p", badness_string, val);
1276                 break;
1277         default:
1278                 len = snprintf(buf, sizeof(buf), "%s unknown badness %d", 
1279                                badness_string, badness);
1280                 break;
1281         }
1282         assert(len >= 0 && (size_t)len < sizeof(buf));
1283
1284         /* Don't abort or signal if called from debug_print() or already
1285            crashing */
1286         if (!inhibit_non_essential_printing_operations) {
1287 #ifdef ERROR_CHECK_TYPES
1288                 abort();
1289 #else                           /* not ERROR_CHECK_TYPES */
1290                 if (print_readably)
1291                         type_error(Qinternal_error, "printing %s", buf);
1292 #endif                          /* not ERROR_CHECK_TYPES */
1293         }
1294         write_fmt_string(printcharfun,
1295                          "#<EMACS BUG: %s Save your buffers immediately and "
1296                          "please report this bug>", buf);
1297 }
1298
1299 void
1300 print_internal(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1301 {
1302         /* This function can GC */
1303         /* defined in emacs.c */
1304         extern int inhibit_autoloads, nodumpfile;
1305
1306         QUIT;
1307
1308         /* Emacs won't print while GCing, but an external debugger might */
1309         if (gc_in_progress)
1310                 return;
1311
1312 #ifdef I18N3
1313         /* #### Both input and output streams should have a flag associated
1314            with them indicating whether output to that stream, or strings
1315            read from the stream, get translated using Fgettext().  Such a
1316            stream is called a "translating stream".  For the minibuffer and
1317            external-debugging-output this is always true on output, and
1318            with-output-to-temp-buffer sets the flag to true for the buffer
1319            it creates.  This flag should also be user-settable.  Perhaps it
1320            should be split up into two flags, one for input and one for
1321            output. */
1322 #endif
1323
1324         /* Try out custom printing */
1325         if (UNLIKELY(!(bool)inhibit_autoloads && !(bool)nodumpfile) &&
1326             !EQ(Qnil, Vcustom_object_printer) &&
1327             !EQ(Qnil, apply1(Vcustom_object_printer,
1328                              Fcons(obj, Fcons(printcharfun, Qnil))))) {
1329                 return;
1330         }
1331
1332         /* Detect circularities and truncate them.
1333            No need to offer any alternative--this is better than an error.  */
1334         if (CONSP(obj) || VECTORP(obj) || COMPILED_FUNCTIONP(obj)) {
1335                 int i;
1336                 for (i = 0; i < print_depth; i++)
1337                         if (EQ(obj, being_printed[i])) {
1338                                 char buf[32];
1339                                 *buf = '#';
1340                                 long_to_string(buf + 1, i, sizeof(buf)-1);
1341                                 write_c_string(buf, printcharfun);
1342                                 return;
1343                         }
1344         }
1345
1346         being_printed[print_depth] = obj;
1347         print_depth++;
1348
1349         if (print_depth > PRINT_CIRCLE) {
1350                 error("Apparently circular structure being printed");
1351         }
1352
1353         switch (XTYPE(obj)) {
1354         case Lisp_Type_Int_Even:
1355         case Lisp_Type_Int_Odd: {
1356                 /* ASCII Decimal representation uses 2.4 times as many bits as
1357                    machine binary.  */
1358                 char buf[3 * sizeof(EMACS_INT) + 5];
1359                 long_to_string(buf, XINT(obj),sizeof(buf));
1360                 write_c_string(buf, printcharfun);
1361                 break;
1362         }
1363
1364         case Lisp_Type_Char: {
1365                 /* God intended that this be #\..., you know. */
1366                 char buf[16];
1367                 memset(buf, 0, sizeof(buf));
1368                 Emchar ch = XCHAR(obj);
1369                 char *p = buf;
1370                 *p++ = '?';
1371                 if (ch < 32) {
1372                         *p++ = '\\';
1373                         switch (ch) {
1374                         case '\t':
1375                                 *p++ = 't';
1376                                 break;
1377                         case '\n':
1378                                 *p++ = 'n';
1379                                 break;
1380                         case '\r':
1381                                 *p++ = 'r';
1382                                 break;
1383                         default:
1384                                 *p++ = '^';
1385                                 *p++ = ch + 64;
1386                                 if ((ch + 64) == '\\')
1387                                         *p++ = '\\';
1388                                 break;
1389                         }
1390                 } else if (ch < 127) {
1391                         /* syntactically special characters should be
1392                            escaped. */
1393                         switch (ch) {
1394                         case ' ':
1395                         case '"':
1396                         case '#':
1397                         case '\'':
1398                         case '(':
1399                         case ')':
1400                         case ',':
1401                         case '.':
1402                         case ';':
1403                         case '?':
1404                         case '[':
1405                         case '\\':
1406                         case ']':
1407                         case '`':
1408                                 *p++ = '\\';
1409                         default:
1410                                 break;
1411                         }
1412                         *p++ = ch;
1413                 } else if (ch == 127) {
1414                         *p++ = '\\', *p++ = '^', *p++ = '?';
1415                 } else if (ch < 160) {
1416                         *p++ = '\\', *p++ = '^';
1417                         p += set_charptr_emchar((Bufbyte *) p, ch + 64);
1418                 } else {
1419                         p += set_charptr_emchar((Bufbyte *) p, ch);
1420                 }
1421
1422                 output_string(printcharfun, (Bufbyte *) buf, Qnil, 0,
1423                               p - buf);
1424
1425                 break;
1426         }
1427
1428         case Lisp_Type_Record: {
1429                 struct lrecord_header *lheader = XRECORD_LHEADER(obj);
1430
1431                 /* Try to check for various sorts of bogus pointers if we're in
1432                    a situation where it may be likely -- i.e. called from
1433                    debug_print() or we're already crashing.  In such cases,
1434                    (further) crashing is counterproductive. */
1435
1436                 if (inhibit_non_essential_printing_operations &&
1437                     !debug_can_access_memory(lheader, sizeof(*lheader))) {
1438                         write_fmt_string(printcharfun,
1439                                          "#<EMACS BUG: BAD MEMORY ACCESS %p>",
1440                                          lheader);
1441                         break;
1442                 }
1443
1444                 if (CONSP(obj) || VECTORP(obj)) {
1445                         /* If deeper than spec'd depth, print placeholder.  */
1446                         if (INTP(Vprint_level)
1447                             && print_depth > XINT(Vprint_level)) {
1448                                 write_c_string("...", printcharfun);
1449                                 break;
1450                         }
1451                 }
1452
1453                 if (lheader->type == lrecord_type_free) {
1454                         printing_major_badness(printcharfun,
1455                                                "freed lrecord", 0,
1456                                                lheader,
1457                                                BADNESS_NO_TYPE);
1458                         break;
1459                 } else if (lheader->type == lrecord_type_undefined) {
1460                         printing_major_badness(printcharfun,
1461                                                "lrecord_type_undefined",
1462                                                0, lheader,
1463                                                BADNESS_NO_TYPE);
1464                         break;
1465                 } else if (lheader->type >= lrecord_type_count) {
1466                         printing_major_badness(printcharfun,
1467                                                "illegal lrecord type",
1468                                                (int)(lheader->type),
1469                                                lheader,
1470                                                BADNESS_POINTER_OBJECT);
1471                         break;
1472                 }
1473
1474                 /* Further checks for bad memory in critical situations.  We
1475                    don't normally do these because they may be expensive or
1476                    weird (e.g. under Unix we typically have to set a SIGSEGV
1477                    handler and try to trigger a seg fault). */
1478
1479                 if (inhibit_non_essential_printing_operations) {
1480                         const struct lrecord_implementation *imp =
1481                                 LHEADER_IMPLEMENTATION(lheader);
1482
1483                         if (!debug_can_access_memory
1484                             (lheader, imp->size_in_bytes_method ?
1485                              imp->size_in_bytes_method(lheader) :
1486                              imp->static_size)) {
1487                                 write_fmt_string(
1488                                         printcharfun,
1489                                         "#<EMACS BUG: type %s "
1490                                         "BAD MEMORY ACCESS %p>",
1491                                         LHEADER_IMPLEMENTATION
1492                                         (lheader)->name, lheader);
1493                                 break;
1494                         }
1495
1496                         if (STRINGP(obj)) {
1497                                 Lisp_String *l = (Lisp_String *)lheader;
1498                                 if (!debug_can_access_memory(
1499                                             l->data, l->size)) {
1500                                         write_fmt_string(
1501                                                 printcharfun,
1502                                                 "#<EMACS BUG: %p "
1503                                                 "(CAN'T ACCESS STRING "
1504                                                 "DATA %p)>", lheader, l->data);
1505                                         break;
1506                                 }
1507                         }
1508                 }
1509
1510                 if (LHEADER_IMPLEMENTATION(lheader)->printer) {
1511                         ((LHEADER_IMPLEMENTATION(lheader)->printer)
1512                          (obj, printcharfun, escapeflag));
1513                 } else {
1514                         default_object_printer(obj, printcharfun, escapeflag);
1515                 }
1516                 break;
1517         }
1518
1519         default: {
1520                 /* We're in trouble if this happens! */
1521                 printing_major_badness(printcharfun,
1522                                        "illegal data type", XTYPE(obj),
1523                                        LISP_TO_VOID(obj),
1524                                        BADNESS_INTEGER_OBJECT);
1525                 break;
1526         }
1527         }
1528
1529         print_depth--;
1530         return;
1531 }
1532
1533 void print_symbol(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1534 {
1535         /* This function can GC */
1536         /* #### Bug!! (intern "") isn't printed in some distinguished way */
1537         /* ####  (the reader also loses on it) */
1538         Lisp_String *name = symbol_name(XSYMBOL(obj));
1539         Bytecount size = string_length(name);
1540         struct gcpro gcpro1, gcpro2;
1541
1542         if (!escapeflag) {
1543                 /* This deals with GC-relocation */
1544                 Lisp_Object nameobj;
1545                 XSETSTRING(nameobj, name);
1546                 output_string(printcharfun, 0, nameobj, 0, size);
1547                 return;
1548         }
1549         GCPRO2(obj, printcharfun);
1550
1551         /* If we print an uninterned symbol as part of a complex object and
1552            the flag print-gensym is non-nil, prefix it with #n= to read the
1553            object back with the #n# reader syntax later if needed.  */
1554         if (!NILP(Vprint_gensym)
1555             /* #### Test whether this produces a noticeable slow-down for
1556                printing when print-gensym is non-nil.  */
1557             && !EQ(obj, oblookup(Vobarray,
1558                                  string_data(symbol_name(XSYMBOL(obj))),
1559                                  string_length(symbol_name(XSYMBOL(obj)))))) {
1560                 if (print_depth > 1) {
1561                         Lisp_Object tem = Fassq(obj, Vprint_gensym_alist);
1562                         if (CONSP(tem)) {
1563                                 write_char_internal("#", printcharfun);
1564                                 print_internal(XCDR(tem), printcharfun,
1565                                                escapeflag);
1566                                 write_char_internal("#", printcharfun);
1567                                 UNGCPRO;
1568                                 return;
1569                         } else {
1570                                 if (CONSP(Vprint_gensym_alist)) {
1571                                         /* Vprint_gensym_alist is exposed to Lisp, so we
1572                                            have to be careful.  */
1573                                         CHECK_CONS(XCAR(Vprint_gensym_alist));
1574                                         CHECK_INT(XCDR
1575                                                   (XCAR(Vprint_gensym_alist)));
1576                                         XSETINT(tem,
1577                                                 XINT(XCDR
1578                                                      (XCAR
1579                                                       (Vprint_gensym_alist))) +
1580                                                 1);
1581                                 } else
1582                                         XSETINT(tem, 1);
1583                                 Vprint_gensym_alist =
1584                                     Fcons(Fcons(obj, tem), Vprint_gensym_alist);
1585
1586                                 write_char_internal("#", printcharfun);
1587                                 print_internal(tem, printcharfun, escapeflag);
1588                                 write_char_internal("=", printcharfun);
1589                         }
1590                 }
1591                 write_c_string("#:", printcharfun);
1592         }
1593
1594         /* Does it look like an integer or a float? */
1595         {
1596                 Bufbyte *data = string_data(name);
1597                 Bytecount confusing = 0;
1598
1599                 if (size == 0)
1600                         goto not_yet_confused;  /* Really confusing */
1601                 else if (isdigit(data[0]))
1602                         confusing = 0;
1603                 else if (size == 1)
1604                         goto not_yet_confused;
1605                 else if (data[0] == '-' || data[0] == '+')
1606                         confusing = 1;
1607                 else
1608                         goto not_yet_confused;
1609
1610                 for (; confusing < size; confusing++) {
1611                         if (!isdigit(data[confusing])) {
1612                                 confusing = 0;
1613                                 break;
1614                         }
1615                 }
1616               not_yet_confused:
1617
1618 #ifdef HAVE_FPFLOAT
1619                 if (!confusing)
1620                         /* #### Ugh, this is needlessly complex and slow for what we
1621                            need here.  It might be a good idea to copy equivalent code
1622                            from FSF.  --hniksic */
1623                         confusing = isfloat_string((char *)data);
1624 #endif
1625                 if (confusing)
1626                         write_char_internal("\\", printcharfun);
1627         }
1628
1629         {
1630                 Lisp_Object nameobj;
1631                 Bytecount i;
1632                 Bytecount last = 0;
1633
1634                 XSETSTRING(nameobj, name);
1635                 for (i = 0; i < size; i++) {
1636                         switch (string_byte(name, i)) {
1637                         case 0:
1638                         case 1:
1639                         case 2:
1640                         case 3:
1641                         case 4:
1642                         case 5:
1643                         case 6:
1644                         case 7:
1645                         case 8:
1646                         case 9:
1647                         case 10:
1648                         case 11:
1649                         case 12:
1650                         case 13:
1651                         case 14:
1652                         case 15:
1653                         case 16:
1654                         case 17:
1655                         case 18:
1656                         case 19:
1657                         case 20:
1658                         case 21:
1659                         case 22:
1660                         case 23:
1661                         case 24:
1662                         case 25:
1663                         case 26:
1664                         case 27:
1665                         case 28:
1666                         case 29:
1667                         case 30:
1668                         case 31:
1669                         case ' ':
1670                         case '\"':
1671                         case '\\':
1672                         case '\'':
1673                         case ';':
1674                         case '#':
1675                         case '(':
1676                         case ')':
1677                         case ',':
1678                         case '.':
1679                         case '`':
1680                         case '[':
1681                         case ']':
1682                         case '?':
1683                                 if (i > last)
1684                                         output_string(printcharfun, 0, nameobj,
1685                                                       last, i - last);
1686                                 write_char_internal("\\", printcharfun);
1687                                 last = i;
1688                         default:
1689                                 break;
1690                         }
1691                 }
1692                 output_string(printcharfun, 0, nameobj, last, size - last);
1693         }
1694         UNGCPRO;
1695 }
1696 \f
1697 /* Useful on systems or in places where writing to stdout is unavailable or
1698    not working. */
1699
1700 static int alternate_do_pointer;
1701 static char alternate_do_string[5000];
1702
1703 DEFUN("alternate-debugging-output", Falternate_debugging_output, 1, 1, 0,       /*
1704 Append CHARACTER to the array `alternate_do_string'.
1705 This can be used in place of `external-debugging-output' as a function
1706 to be passed to `print'.  Before calling `print', set `alternate_do_pointer'
1707 to 0.
1708 */
1709       (character))
1710 {
1711         Bufbyte str[MAX_EMCHAR_LEN];
1712         Bytecount len;
1713         int extlen;
1714         const Extbyte *extptr = NULL;
1715
1716         CHECK_CHAR_COERCE_INT(character);
1717         len = set_charptr_emchar(str, XCHAR(character));
1718         TO_EXTERNAL_FORMAT(DATA, (str, len),
1719                            ALLOCA, (extptr, extlen), Qterminal);
1720         if ( extptr != NULL ) {
1721                 memcpy(alternate_do_string + alternate_do_pointer, extptr, extlen);
1722                 alternate_do_pointer += extlen;
1723                 alternate_do_string[alternate_do_pointer] = 0;
1724         } else {
1725                 /* Better bad transcoding than nothing I guess... */
1726                 memcpy(alternate_do_string + alternate_do_pointer, str, len);
1727                 alternate_do_pointer += len;
1728                 alternate_do_string[alternate_do_pointer] = 0;
1729         }
1730         return character;
1731 }
1732
1733 DEFUN("external-debugging-output", Fexternal_debugging_output, 1, 3, 0, /*
1734 Write CHAR-OR-STRING to stderr or stdout.
1735 If optional arg STDOUT-P is non-nil, write to stdout; otherwise, write
1736 to stderr.  You can use this function to write directly to the terminal.
1737 This function can be used as the STREAM argument of Fprint() or the like.
1738
1739 Under MS Windows, this writes output to the console window (which is
1740 created, if necessary), unless SXEmacs is being run noninteractively
1741 \(i.e. using the `-batch' argument).
1742
1743 If you have opened a termscript file (using `open-termscript'), then
1744 the output also will be logged to this file.
1745 */
1746       (char_or_string, stdout_p, device))
1747 {
1748         FILE *file = NULL;
1749         struct console *con = NULL;
1750
1751         if (NILP(device)) {
1752                 if (!NILP(stdout_p))
1753                         file = stdout;
1754                 else
1755                         file = stderr;
1756         } else {
1757                 CHECK_LIVE_DEVICE(device);
1758                 if (!DEVICE_TTY_P(XDEVICE(device)) &&
1759                     !DEVICE_STREAM_P(XDEVICE(device)))
1760                         signal_simple_error("Must be tty or stream device",
1761                                             device);
1762                 con = XCONSOLE(DEVICE_CONSOLE(XDEVICE(device)));
1763                 if (DEVICE_TTY_P(XDEVICE(device))) {
1764                         file = 0;
1765                 } else if (!NILP(stdout_p)) {
1766                         file = CONSOLE_STREAM_DATA(con)->out;
1767                 } else {
1768                         file = CONSOLE_STREAM_DATA(con)->err;
1769                 }
1770         }
1771
1772         if (STRINGP(char_or_string))
1773                 write_string_to_stdio_stream(file, con,
1774                                              XSTRING_DATA(char_or_string),
1775                                              0, XSTRING_LENGTH(char_or_string),
1776                                              Qterminal, 1);
1777         else {
1778                 Bufbyte str[MAX_EMCHAR_LEN];
1779                 Bytecount len;
1780
1781                 CHECK_CHAR_COERCE_INT(char_or_string);
1782                 len = set_charptr_emchar(str, XCHAR(char_or_string));
1783                 write_string_to_stdio_stream(file, con, str, 0, len, Qterminal,
1784                                              1);
1785         }
1786
1787         return char_or_string;
1788 }
1789
1790 DEFUN("open-termscript", Fopen_termscript, 1, 1, "FOpen termscript file: ",     /*
1791 Start writing all terminal output to FILENAME as well as the terminal.
1792 FILENAME = nil means just close any termscript file currently open.
1793 */
1794       (filename))
1795 {
1796         /* This function can GC */
1797         if (termscript != 0) {
1798                 fclose(termscript);
1799                 termscript = 0;
1800         }
1801
1802         if (!NILP(filename)) {
1803                 filename = Fexpand_file_name(filename, Qnil);
1804                 termscript = fopen((char *)XSTRING_DATA(filename), "w");
1805                 if (termscript == NULL)
1806                         report_file_error("Opening termscript",
1807                                           list1(filename));
1808         }
1809         return Qnil;
1810 }
1811
1812 #if 1
1813 /* Debugging kludge -- unbuffered */
1814 static int debug_print_length = 50;
1815 static int debug_print_level = 15;
1816 static int debug_print_readably = -1;
1817
1818 static void debug_print_no_newline(Lisp_Object debug_print_obj)
1819 {
1820         /* This function can GC */
1821         int save_print_readably = print_readably;
1822         int save_print_depth = print_depth;
1823         Lisp_Object save_Vprint_length = Vprint_length;
1824         Lisp_Object save_Vprint_level = Vprint_level;
1825         Lisp_Object save_Vinhibit_quit = Vinhibit_quit;
1826         struct gcpro gcpro1, gcpro2, gcpro3;
1827         GCPRO3(save_Vprint_level, save_Vprint_length, save_Vinhibit_quit);
1828
1829         if (gc_in_progress)
1830                 stderr_out
1831                     ("** gc-in-progress!  Bad idea to print anything! **\n");
1832
1833         print_depth = 0;
1834         print_readably = debug_print_readably != -1 ? debug_print_readably : 0;
1835         print_unbuffered++;
1836         inhibit_non_essential_printing_operations = 1;
1837         /* Could use unwind-protect, but why bother? */
1838         if (debug_print_length > 0)
1839                 Vprint_length = make_int(debug_print_length);
1840         if (debug_print_level > 0)
1841                 Vprint_level = make_int(debug_print_level);
1842
1843         print_internal(debug_print_obj, Qexternal_debugging_output, 1);
1844         alternate_do_pointer = 0;
1845         print_internal(debug_print_obj, Qalternate_debugging_output, 1);
1846
1847         Vinhibit_quit = save_Vinhibit_quit;
1848         Vprint_level = save_Vprint_level;
1849         Vprint_length = save_Vprint_length;
1850         print_depth = save_print_depth;
1851         print_readably = save_print_readably;
1852         inhibit_non_essential_printing_operations = 0;
1853         print_unbuffered--;
1854         UNGCPRO;
1855 }
1856
1857 void debug_print(Lisp_Object debug_print_obj)
1858 {
1859         debug_print_no_newline(debug_print_obj);
1860         stderr_out("\n");
1861 }
1862
1863 /* Debugging kludge -- unbuffered */
1864 /* This function provided for the benefit of the debugger.  */
1865 void debug_backtrace(void)
1866 {
1867         /* This function can GC */
1868         int old_print_readably = print_readably;
1869         int old_print_depth = print_depth;
1870         Lisp_Object old_print_length = Vprint_length;
1871         Lisp_Object old_print_level = Vprint_level;
1872         Lisp_Object old_inhibit_quit = Vinhibit_quit;
1873
1874         struct gcpro gcpro1, gcpro2, gcpro3;
1875         GCPRO3(old_print_level, old_print_length, old_inhibit_quit);
1876
1877         if (gc_in_progress)
1878                 stderr_out
1879                     ("** gc-in-progress!  Bad idea to print anything! **\n");
1880
1881         print_depth = 0;
1882         print_readably = 0;
1883         print_unbuffered++;
1884         inhibit_non_essential_printing_operations = 1;
1885         /* Could use unwind-protect, but why bother? */
1886         if (debug_print_length > 0)
1887                 Vprint_length = make_int(debug_print_length);
1888         if (debug_print_level > 0)
1889                 Vprint_level = make_int(debug_print_level);
1890
1891         Fbacktrace(Qexternal_debugging_output, Qt);
1892         stderr_out("\n");
1893
1894         Vinhibit_quit = old_inhibit_quit;
1895         Vprint_level = old_print_level;
1896         Vprint_length = old_print_length;
1897         print_depth = old_print_depth;
1898         print_readably = old_print_readably;
1899         inhibit_non_essential_printing_operations = 0;
1900         print_unbuffered--;
1901
1902         UNGCPRO;
1903 }
1904
1905 void debug_short_backtrace(int length)
1906 {
1907         int first = 1;
1908         struct backtrace *bt = backtrace_list;
1909         stderr_out("   [");
1910         while (length > 0 && bt) {
1911                 if (!first) {
1912                         stderr_out(", ");
1913                 }
1914                 if (COMPILED_FUNCTIONP(*bt->function)) {
1915 #if defined(COMPILED_FUNCTION_ANNOTATION_HACK)
1916                         Lisp_Object ann =
1917                             compiled_function_annotation(XCOMPILED_FUNCTION
1918                                                          (*bt->function));
1919 #else
1920                         Lisp_Object ann = Qnil;
1921 #endif
1922                         if (!NILP(ann)) {
1923                                 stderr_out("<compiled-function from ");
1924                                 debug_print_no_newline(ann);
1925                                 stderr_out(">");
1926                         } else {
1927                                 stderr_out
1928                                     ("<compiled-function of unknown origin>");
1929                         }
1930                 } else
1931                         debug_print_no_newline(*bt->function);
1932                 first = 0;
1933                 length--;
1934                 bt = bt->next;
1935         }
1936         stderr_out("]\n");
1937 }
1938
1939 #endif                          /* debugging kludge */
1940 \f
1941 void syms_of_print(void)
1942 {
1943         defsymbol(&Qstandard_output, "standard-output");
1944
1945         defsymbol(&Qprint_length, "print-length");
1946
1947         defsymbol(&Qprint_string_length, "print-string-length");
1948
1949         defsymbol(&Qdisplay_error, "display-error");
1950         defsymbol(&Qprint_message_label, "print-message-label");
1951
1952         DEFSUBR(Fprin1);
1953         DEFSUBR(Fprin1_to_string);
1954         DEFSUBR(Fprinc);
1955         DEFSUBR(Fprint);
1956         DEFSUBR(Ferror_message_string);
1957         DEFSUBR(Fdisplay_error);
1958         DEFSUBR(Fterpri);
1959         DEFSUBR(Fwrite_char);
1960         DEFSUBR(Falternate_debugging_output);
1961         DEFSUBR(Fexternal_debugging_output);
1962         DEFSUBR(Fopen_termscript);
1963         defsymbol(&Qexternal_debugging_output, "external-debugging-output");
1964         defsymbol(&Qalternate_debugging_output, "alternate-debugging-output");
1965         DEFSUBR(Fwith_output_to_temp_buffer);
1966 }
1967
1968 void reinit_vars_of_print(void)
1969 {
1970         alternate_do_pointer = 0;
1971 }
1972
1973 void vars_of_print(void)
1974 {
1975         reinit_vars_of_print();
1976
1977         DEFVAR_LISP("standard-output", &Vstandard_output        /*
1978 Output stream `print' uses by default for outputting a character.
1979 This may be any function of one argument.
1980 It may also be a buffer (output is inserted before point)
1981 or a marker (output is inserted and the marker is advanced)
1982 or the symbol t (output appears in the minibuffer line).
1983                                                                  */ );
1984         Vstandard_output = Qt;
1985
1986 #ifdef HAVE_FPFLOAT
1987         DEFVAR_LISP("float-output-format", &Vfloat_output_format        /*
1988 The format descriptor string that lisp uses to print floats.
1989 This is a %-spec like those accepted by `printf' in C,
1990 but with some restrictions.  It must start with the two characters `%.'.
1991 After that comes an integer precision specification,
1992 and then a letter which controls the format.
1993 The letters allowed are `e', `f' and `g'.
1994 Use `e' for exponential notation "DIG.DIGITSeEXPT"
1995 Use `f' for decimal point notation "DIGITS.DIGITS".
1996 Use `g' to choose the shorter of those two formats for the number at hand.
1997 The precision in any of these cases is the number of digits following
1998 the decimal point.  With `f', a precision of 0 means to omit the
1999 decimal point.  0 is not allowed with `f' or `g'.
2000
2001 A value of nil means to use `%.16g'.
2002
2003 Regardless of the value of `float-output-format', a floating point number
2004 will never be printed in such a way that it is ambiguous with an integer;
2005 that is, a floating-point number will always be printed with a decimal
2006 point and/or an exponent, even if the digits following the decimal point
2007 are all zero.  This is to preserve read-equivalence.
2008                                                                          */ );
2009         Vfloat_output_format = Qnil;
2010 #endif                          /* HAVE_FPFLOAT */
2011
2012         DEFVAR_LISP("print-length", &Vprint_length      /*
2013 Maximum length of list or vector to print before abbreviating.
2014 A value of nil means no limit.
2015                                                          */ );
2016         Vprint_length = Qnil;
2017
2018         DEFVAR_LISP("print-string-length", &Vprint_string_length        /*
2019 Maximum length of string to print before abbreviating.
2020 A value of nil means no limit.
2021                                                                          */ );
2022         Vprint_string_length = Qnil;
2023
2024         DEFVAR_LISP("print-level", &Vprint_level        /*
2025 Maximum depth of list nesting to print before abbreviating.
2026 A value of nil means no limit.
2027                                                          */ );
2028         Vprint_level = Qnil;
2029
2030         DEFVAR_BOOL("print-escape-newlines", &print_escape_newlines     /*
2031 Non-nil means print newlines in strings as backslash-n.
2032                                                                          */ );
2033         print_escape_newlines = 0;
2034
2035         DEFVAR_BOOL("print-readably", &print_readably   /*
2036 If non-nil, then all objects will be printed in a readable form.
2037 If an object has no readable representation, then an error is signalled.
2038 When print-readably is true, compiled-function objects will be written in
2039 #[...] form instead of in #<compiled-function [...]> form, and two-element
2040 lists of the form (quote object) will be written as the equivalent 'object.
2041 Do not SET this variable; bind it instead.
2042                                                          */ );
2043         print_readably = 0;
2044
2045         /* #### I think this should default to t.  But we'd better wait
2046            until we see that it works out.  */
2047         DEFVAR_LISP("print-gensym", &Vprint_gensym      /*
2048 If non-nil, then uninterned symbols will be printed specially.
2049 Uninterned symbols are those which are not present in `obarray', that is,
2050 those which were made with `make-symbol' or by calling `intern' with a
2051 second argument.
2052
2053 When print-gensym is true, such symbols will be preceded by "#:",
2054 which causes the reader to create a new symbol instead of interning
2055 and returning an existing one.  Beware: the #: syntax creates a new
2056 symbol each time it is seen, so if you print an object which contains
2057 two pointers to the same uninterned symbol, `read' will not duplicate
2058 that structure.
2059
2060 If the value of `print-gensym' is a cons cell, then in addition
2061 refrain from clearing `print-gensym-alist' on entry to and exit from
2062 printing functions, so that the use of #...# and #...= can carry over
2063 for several separately printed objects.
2064                                                          */ );
2065         Vprint_gensym = Qnil;
2066
2067         DEFVAR_LISP("print-gensym-alist", &Vprint_gensym_alist  /*
2068 Association list of elements (GENSYM . N) to guide use of #N# and #N=.
2069 In each element, GENSYM is an uninterned symbol that has been associated
2070 with #N= for the specified value of N.
2071                                                                  */ );
2072         Vprint_gensym_alist = Qnil;
2073
2074         DEFVAR_LISP("print-message-label", &Vprint_message_label        /*
2075 Label for minibuffer messages created with `print'.  This should
2076 generally be bound with `let' rather than set.  (See `display-message'.)
2077                                                                          */ );
2078         Vprint_message_label = Qprint;
2079
2080         DEFVAR_LISP("custom-object-printer", &Vcustom_object_printer /*
2081 Function to call in order to print custom object.
2082                                                            */ );
2083         Vcustom_object_printer = Qnil;
2084 }