cgit.sxemacs.org Git - sxemacs/blob - 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 void float_to_string(char *buf, fpfloat data, int maxlen);
 916
 917 /*
 918  * This buffer should be at least as large as the max string size of the
 919  * largest float, printed in the biggest notation.  This is undoubtedly
 920  * 20d float_output_format, with the negative of the C-constant "HUGE"
 921  * from <math.h>.
 922  *
 923  * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
 924  *
 925  * I assume that IEEE-754 format numbers can take 329 bytes for the worst
 926  * case of -1e307 in 20d float_output_format. What is one to do (short of
 927  * re-writing _doprnt to be more sane)?
 928  *                      -wsr
 929  */
 930 void float_to_string(char *buf, fpfloat data, int maxlen)
 931 {
 932         Bufbyte *cp, c;
 933         int width, sz;
 934
 935         if (NILP(Vfloat_output_format) || !STRINGP(Vfloat_output_format)) {
 936         lose:
 937 #if fpfloat_double_p
 938                 sz = snprintf(buf, maxlen, "%.16g", data);
 939 #elif fpfloat_long_double_p
 940                 sz = snprintf(buf, maxlen, "%.16Lg", data);
 941 #endif
 942                 assert(sz>=0 && sz<maxlen);
 943         } else {                        /* oink oink */
 944
 945                 /* Check that the spec we have is fully valid.
 946                    This means not only valid for printf,
 947                    but meant for floats, and reasonable.  */
 948                 cp = XSTRING_DATA(Vfloat_output_format);
 949
 950                 if (cp[0] != '%')
 951                         goto lose;
 952                 if (cp[1] != '.')
 953                         goto lose;
 954
 955                 cp += 2;
 956                 for (width = 0; (c = *cp, isdigit(c)); cp++) {
 957                         width *= 10;
 958                         width += c - '0';
 959                 }
 960
 961                 if (*cp != 'e' && *cp != 'f' && *cp != 'g' && *cp != 'E'
 962                     && *cp != 'G')
 963                         goto lose;
 964
 965                 if (width < (int)(*cp != 'e' && *cp != 'E') || width > DBL_DIG)
 966                         goto lose;
 967
 968                 if (cp[1] != 0)
 969                         goto lose;
 970
 971                 sz = snprintf(buf, maxlen,
 972                               (char *)XSTRING_DATA(Vfloat_output_format), data);
 973                 assert(sz>=0 && sz < maxlen);
 974         }
 975
 976         /* added by jwz: don't allow "1.0" to print as "1"; that destroys
 977            the read-equivalence of lisp objects.  (* x 1) and (* x 1.0) do
 978            not do the same thing, so it's important that the printed
 979            representation of that form not be corrupted by the printer.
 980          */
 981         {
 982                 Bufbyte *s = (Bufbyte *) buf;   /* don't use signed chars here!
 983                                                    isdigit() can't hack them! */
 984                 if (*s == '-') {
 985                         s++;
 986                         maxlen--;
 987                         assert(maxlen>0);
 988                 }
 989                 for (; *s; s++)
 990                         /* if there's a non-digit, then there is a decimal point, or
 991                            it's in exponential notation, both of which are ok. */
 992                         if (!isdigit(*s))
 993                                 goto DONE_LABEL;
 994                 /* otherwise, we need to hack it. */
 995                 maxlen-=2;
 996                 assert(maxlen>0);
 997                 *s++ = '.';
 998                 *s++ = '0';
 999                 *s = 0;
1000         }
1001       DONE_LABEL:
1002
1003         /* Some machines print "0.4" as ".4".  I don't like that. */
1004         if (buf[0] == '.' || (buf[0] == '-' && buf[1] == '.')) {
1005                 assert(maxlen>0);
1006                 int i;
1007                 for (i = strlen(buf) + 1; i >= 0; i--)
1008                         buf[i + 1] = buf[i];
1009                 buf[(buf[0] == '-' ? 1 : 0)] = '0';
1010         }
1011 }
1012 #endif                          /* HAVE_FPFLOAT */
1013
1014 /* Print NUMBER to BUFFER.
1015    This is equivalent to snprintf (buffer, maxlen, "%ld", number), only much faster.
1016
1017    BUFFER should accept 24 bytes.  This should suffice for the longest
1018    numbers on 64-bit machines, including the `-' sign and the trailing
1019    '\0'.  Returns a pointer to the trailing '\0'. */
1020 char *long_to_string(char *buffer, long number, int maxlen)
1021 {
1022 #if (SIZEOF_LONG != 4) && (SIZEOF_LONG != 8)
1023         /* Huh? */
1024         int sz = snprintf(buffer, maxlen, "%ld", number);
1025         assert(sz>=0 && sz < maxlen);
1026         return buffer + strlen(buffer);
1027 #else                           /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
1028         char *p = buffer;
1029         int force = 0;
1030
1031         if (number < 0) {
1032                 *p++ = '-';
1033                 number = -number;
1034         }
1035 #define FROB(figure) \
1036         do {                                                            \
1037                 if (force || number >= figure) {                        \
1038                         *p++ = number / figure + '0';                   \
1039                         number %= figure;                               \
1040                         force = 1;                                      \
1041                         --maxlen;                                       \
1042                         assert(maxlen>0);                               \
1043                 }                                                       \
1044         } while (0)
1045 #if SIZEOF_LONG == 8
1046         FROB(1000000000000000000L);
1047         FROB(100000000000000000L);
1048         FROB(10000000000000000L);
1049         FROB(1000000000000000L);
1050         FROB(100000000000000L);
1051         FROB(10000000000000L);
1052         FROB(1000000000000L);
1053         FROB(100000000000L);
1054         FROB(10000000000L);
1055 #endif                          /* SIZEOF_LONG == 8 */
1056         FROB(1000000000);
1057         FROB(100000000);
1058         FROB(10000000);
1059         FROB(1000000);
1060         FROB(100000);
1061         FROB(10000);
1062         FROB(1000);
1063         FROB(100);
1064         FROB(10);
1065 #undef FROB
1066         *p++ = number + '0';
1067         *p = '\0';
1068         return p;
1069 #endif                          /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
1070 }
1071 \f
1072 static void
1073 print_vector_internal(const char *start, const char *end,
1074                       Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1075 {
1076         /* This function can GC */
1077         int i;
1078         int len = XVECTOR_LENGTH(obj);
1079         int last = len;
1080         struct gcpro gcpro1, gcpro2;
1081         GCPRO2(obj, printcharfun);
1082
1083         if (INTP(Vprint_length)) {
1084                 int max = XINT(Vprint_length);
1085                 if (max < len)
1086                         last = max;
1087         }
1088
1089         write_c_string(start, printcharfun);
1090         for (i = 0; i < last; i++) {
1091                 Lisp_Object elt = XVECTOR_DATA(obj)[i];
1092                 if (i != 0)
1093                         write_char_internal(" ", printcharfun);
1094                 print_internal(elt, printcharfun, escapeflag);
1095         }
1096         UNGCPRO;
1097         if (last != len)
1098                 write_c_string(" ...", printcharfun);
1099         write_c_string(end, printcharfun);
1100 }
1101
1102 void print_cons(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1103 {
1104         /* This function can GC */
1105         struct gcpro gcpro1, gcpro2;
1106
1107         /* If print_readably is on, print (quote -foo-) as '-foo-
1108            (Yeah, this should really be what print-pretty does, but we
1109            don't have the rest of a pretty printer, and this actually
1110            has non-negligible impact on size/speed of .elc files.)
1111          */
1112         if (print_readably &&
1113             EQ(XCAR(obj), Qquote) &&
1114             CONSP(XCDR(obj)) && NILP(XCDR(XCDR(obj)))) {
1115                 obj = XCAR(XCDR(obj));
1116                 GCPRO2(obj, printcharfun);
1117                 write_char_internal("\'", printcharfun);
1118                 UNGCPRO;
1119                 print_internal(obj, printcharfun, escapeflag);
1120                 return;
1121         }
1122
1123         GCPRO2(obj, printcharfun);
1124         write_char_internal("(", printcharfun);
1125
1126         {
1127                 int len;
1128                 int max = INTP(Vprint_length) ? XINT(Vprint_length) : INT_MAX;
1129                 Lisp_Object tortoise;
1130                 /* Use tortoise/hare to make sure circular lists don't infloop */
1131
1132                 for (tortoise = obj, len = 0;
1133                      CONSP(obj); obj = XCDR(obj), len++) {
1134                         if (len > 0)
1135                                 write_char_internal(" ", printcharfun);
1136                         if (EQ(obj, tortoise) && len > 0) {
1137                                 if (print_readably)
1138                                         error
1139                                             ("printing unreadable circular list");
1140                                 else
1141                                         write_c_string("... <circular list>",
1142                                                        printcharfun);
1143                                 break;
1144                         }
1145                         if (len & 1)
1146                                 tortoise = XCDR(tortoise);
1147                         if (len > max) {
1148                                 write_c_string("...", printcharfun);
1149                                 break;
1150                         }
1151                         print_internal(XCAR(obj), printcharfun, escapeflag);
1152                 }
1153         }
1154         if (!LISTP(obj)) {
1155                 write_c_string(" . ", printcharfun);
1156                 print_internal(obj, printcharfun, escapeflag);
1157         }
1158         UNGCPRO;
1159
1160         write_char_internal(")", printcharfun);
1161         return;
1162 }
1163
1164 void print_vector(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1165 {
1166         print_vector_internal("[", "]", obj, printcharfun, escapeflag);
1167 }
1168
1169 void print_string(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1170 {
1171         Lisp_String *s = XSTRING(obj);
1172         /* We distinguish between Bytecounts and Charcounts, to make
1173            Vprint_string_length work correctly under Mule.  */
1174         Charcount size = string_char_length(s);
1175         Charcount max = size;
1176         Bytecount bcmax = string_length(s);
1177         struct gcpro gcpro1, gcpro2;
1178         GCPRO2(obj, printcharfun);
1179
1180         if (INTP(Vprint_string_length) && XINT(Vprint_string_length) < max) {
1181                 max = XINT(Vprint_string_length);
1182                 bcmax = charcount_to_bytecount(string_data(s), max);
1183         }
1184         if (max < 0) {
1185                 max = 0;
1186                 bcmax = 0;
1187         }
1188
1189         if (!escapeflag) {
1190                 /* This deals with GC-relocation and Mule. */
1191                 output_string(printcharfun, 0, obj, 0, bcmax);
1192                 if (max < size)
1193                         write_c_string(" ...", printcharfun);
1194         } else {
1195                 Bytecount i, last = 0;
1196
1197                 write_char_internal("\"", printcharfun);
1198                 for (i = 0; i < bcmax; i++) {
1199                         Bufbyte ch = string_byte(s, i);
1200                         if (ch == '\"' || ch == '\\'
1201                             || (ch == '\n' && print_escape_newlines)) {
1202                                 if (i > last) {
1203                                         output_string(printcharfun, 0, obj,
1204                                                       last, i - last);
1205                                 }
1206                                 if (ch == '\n') {
1207                                         write_c_string("\\n", printcharfun);
1208                                 } else {
1209                                         write_char_internal("\\", printcharfun);
1210                                         /* This is correct for Mule because the
1211                                            character is either \ or " */
1212                                         write_char_internal(string_data(s) + i,
1213                                                             printcharfun);
1214                                 }
1215                                 last = i + 1;
1216                         }
1217                 }
1218                 if (bcmax > last) {
1219                         output_string(printcharfun, 0, obj, last, bcmax - last);
1220                 }
1221                 if (max < size)
1222                         write_c_string(" ...", printcharfun);
1223                 write_char_internal("\"", printcharfun);
1224         }
1225         UNGCPRO;
1226 }
1227
1228 static void
1229 default_object_printer(Lisp_Object obj, Lisp_Object printcharfun,
1230                        int escapeflag)
1231 {
1232         struct lcrecord_header *header = (struct lcrecord_header *)XPNTR(obj);
1233
1234         if (print_readably)
1235                 error("printing unreadable object #<%s 0x%x>",
1236                       LHEADER_IMPLEMENTATION(&header->lheader)->name,
1237                       header->uid);
1238
1239         write_fmt_string(printcharfun, "#<%s 0x%x>",
1240                          LHEADER_IMPLEMENTATION(&header->lheader)->name, header->uid);
1241 }
1242
1243 void
1244 internal_object_printer(Lisp_Object obj, Lisp_Object printcharfun,
1245                         int escapeflag)
1246 {
1247         write_fmt_string(printcharfun, "#<INTERNAL OBJECT (SXEmacs bug?) (%s) 0x%lx>",
1248                          XRECORD_LHEADER_IMPLEMENTATION(obj)->name,
1249                          (unsigned long)XPNTR(obj));
1250 }
1251
1252 enum printing_badness {
1253         BADNESS_INTEGER_OBJECT,
1254         BADNESS_POINTER_OBJECT,
1255         BADNESS_NO_TYPE
1256 };
1257
1258 static void
1259 printing_major_badness(Lisp_Object printcharfun,
1260                        Char_ASCII * badness_string, int type, void *val,
1261                        enum printing_badness badness)
1262 {
1263         char buf[666];
1264         ssize_t len;
1265
1266         switch (badness) {
1267         case BADNESS_INTEGER_OBJECT:
1268                 len = snprintf(buf, sizeof(buf), "%s %d object %ld", badness_string, type,
1269                                (EMACS_INT) val);
1270                 break;
1271
1272         case BADNESS_POINTER_OBJECT:
1273                 len = snprintf(buf, sizeof(buf), "%s %d object %p", badness_string, type, val);
1274                 break;
1275
1276         case BADNESS_NO_TYPE:
1277                 len = snprintf(buf, sizeof(buf), "%s object %p", badness_string, val);
1278                 break;
1279         default:
1280                 len = snprintf(buf, sizeof(buf), "%s unknown badness %d",
1281                                badness_string, badness);
1282                 break;
1283         }
1284         assert(len >= 0 && (size_t)len < sizeof(buf));
1285
1286         /* Don't abort or signal if called from debug_print() or already
1287            crashing */
1288         if (!inhibit_non_essential_printing_operations) {
1289 #ifdef ERROR_CHECK_TYPES
1290                 abort();
1291 #else                           /* not ERROR_CHECK_TYPES */
1292                 if (print_readably)
1293                         type_error(Qinternal_error, "printing %s", buf);
1294 #endif                          /* not ERROR_CHECK_TYPES */
1295         }
1296         write_fmt_string(printcharfun,
1297                          "#<EMACS BUG: %s Save your buffers immediately and "
1298                          "please report this bug>", buf);
1299 }
1300
1301 void
1302 print_internal(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1303 {
1304         /* This function can GC */
1305         /* defined in emacs.c */
1306         extern int inhibit_autoloads, nodumpfile;
1307
1308         QUIT;
1309
1310         /* Emacs won't print while GCing, but an external debugger might */
1311         if (gc_in_progress)
1312                 return;
1313
1314 #ifdef I18N3
1315         /* #### Both input and output streams should have a flag associated
1316            with them indicating whether output to that stream, or strings
1317            read from the stream, get translated using Fgettext().  Such a
1318            stream is called a "translating stream".  For the minibuffer and
1319            external-debugging-output this is always true on output, and
1320            with-output-to-temp-buffer sets the flag to true for the buffer
1321            it creates.  This flag should also be user-settable.  Perhaps it
1322            should be split up into two flags, one for input and one for
1323            output. */
1324 #endif
1325
1326         /* Try out custom printing */
1327         if (UNLIKELY(!(bool)inhibit_autoloads && !(bool)nodumpfile) &&
1328             !EQ(Qnil, Vcustom_object_printer) &&
1329             !EQ(Qnil, apply1(Vcustom_object_printer,
1330                              Fcons(obj, Fcons(printcharfun, Qnil))))) {
1331                 return;
1332         }
1333
1334         /* Detect circularities and truncate them.
1335            No need to offer any alternative--this is better than an error.  */
1336         if (CONSP(obj) || VECTORP(obj) || COMPILED_FUNCTIONP(obj)) {
1337                 int i;
1338                 for (i = 0; i < print_depth; i++)
1339                         if (EQ(obj, being_printed[i])) {
1340                                 char buf[32];
1341                                 *buf = '#';
1342                                 long_to_string(buf + 1, i, sizeof(buf)-1);
1343                                 write_c_string(buf, printcharfun);
1344                                 return;
1345                         }
1346         }
1347
1348         being_printed[print_depth] = obj;
1349         print_depth++;
1350
1351         if (print_depth > PRINT_CIRCLE) {
1352                 error("Apparently circular structure being printed");
1353         }
1354
1355         switch (XTYPE(obj)) {
1356         case Lisp_Type_Int_Even:
1357         case Lisp_Type_Int_Odd: {
1358                 /* ASCII Decimal representation uses 2.4 times as many bits as
1359                    machine binary.  */
1360                 char buf[3 * sizeof(EMACS_INT) + 5];
1361                 long_to_string(buf, XINT(obj),sizeof(buf));
1362                 write_c_string(buf, printcharfun);
1363                 break;
1364         }
1365
1366         case Lisp_Type_Char: {
1367                 /* God intended that this be #\..., you know. */
1368                 char buf[16];
1369                 memset(buf, 0, sizeof(buf));
1370                 Emchar ch = XCHAR(obj);
1371                 char *p = buf;
1372                 *p++ = '?';
1373                 if (ch < 32) {
1374                         *p++ = '\\';
1375                         switch (ch) {
1376                         case '\t':
1377                                 *p++ = 't';
1378                                 break;
1379                         case '\n':
1380                                 *p++ = 'n';
1381                                 break;
1382                         case '\r':
1383                                 *p++ = 'r';
1384                                 break;
1385                         default:
1386                                 *p++ = '^';
1387                                 *p++ = ch + 64;
1388                                 if ((ch + 64) == '\\')
1389                                         *p++ = '\\';
1390                                 break;
1391                         }
1392                 } else if (ch < 127) {
1393                         /* syntactically special characters should be
1394                            escaped. */
1395                         switch (ch) {
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                         case ']':
1409                         case '`':
1410                                 *p++ = '\\';
1411                         default:
1412                                 break;
1413                         }
1414                         *p++ = ch;
1415                 } else if (ch == 127) {
1416                         *p++ = '\\', *p++ = '^', *p++ = '?';
1417                 } else if (ch < 160) {
1418                         *p++ = '\\', *p++ = '^';
1419                         p += set_charptr_emchar((Bufbyte *) p, ch + 64);
1420                 } else {
1421                         p += set_charptr_emchar((Bufbyte *) p, ch);
1422                 }
1423
1424                 output_string(printcharfun, (Bufbyte *) buf, Qnil, 0,
1425                               p - buf);
1426
1427                 break;
1428         }
1429
1430         case Lisp_Type_Record: {
1431                 struct lrecord_header *lheader = XRECORD_LHEADER(obj);
1432
1433                 /* Try to check for various sorts of bogus pointers if we're in
1434                    a situation where it may be likely -- i.e. called from
1435                    debug_print() or we're already crashing.  In such cases,
1436                    (further) crashing is counterproductive. */
1437
1438                 if (inhibit_non_essential_printing_operations &&
1439                     !debug_can_access_memory(lheader, sizeof(*lheader))) {
1440                         write_fmt_string(printcharfun,
1441                                          "#<EMACS BUG: BAD MEMORY ACCESS %p>",
1442                                          lheader);
1443                         break;
1444                 }
1445
1446                 if (CONSP(obj) || VECTORP(obj)) {
1447                         /* If deeper than spec'd depth, print placeholder.  */
1448                         if (INTP(Vprint_level)
1449                             && print_depth > XINT(Vprint_level)) {
1450                                 write_c_string("...", printcharfun);
1451                                 break;
1452                         }
1453                 }
1454
1455                 if (lheader->type == lrecord_type_free) {
1456                         printing_major_badness(printcharfun,
1457                                                "freed lrecord", 0,
1458                                                lheader,
1459                                                BADNESS_NO_TYPE);
1460                         break;
1461                 } else if (lheader->type == lrecord_type_undefined) {
1462                         printing_major_badness(printcharfun,
1463                                                "lrecord_type_undefined",
1464                                                0, lheader,
1465                                                BADNESS_NO_TYPE);
1466                         break;
1467                 } else if (lheader->type >= lrecord_type_count) {
1468                         printing_major_badness(printcharfun,
1469                                                "illegal lrecord type",
1470                                                (int)(lheader->type),
1471                                                lheader,
1472                                                BADNESS_POINTER_OBJECT);
1473                         break;
1474                 }
1475
1476                 /* Further checks for bad memory in critical situations.  We
1477                    don't normally do these because they may be expensive or
1478                    weird (e.g. under Unix we typically have to set a SIGSEGV
1479                    handler and try to trigger a seg fault). */
1480
1481                 if (inhibit_non_essential_printing_operations) {
1482                         const struct lrecord_implementation *imp =
1483                                 LHEADER_IMPLEMENTATION(lheader);
1484
1485                         if (!debug_can_access_memory
1486                             (lheader, imp->size_in_bytes_method ?
1487                              imp->size_in_bytes_method(lheader) :
1488                              imp->static_size)) {
1489                                 write_fmt_string(
1490                                         printcharfun,
1491                                         "#<EMACS BUG: type %s "
1492                                         "BAD MEMORY ACCESS %p>",
1493                                         LHEADER_IMPLEMENTATION
1494                                         (lheader)->name, lheader);
1495                                 break;
1496                         }
1497
1498                         if (STRINGP(obj)) {
1499                                 Lisp_String *l = (Lisp_String *)lheader;
1500                                 if (!debug_can_access_memory(
1501                                             l->data, l->size)) {
1502                                         write_fmt_string(
1503                                                 printcharfun,
1504                                                 "#<EMACS BUG: %p "
1505                                                 "(CAN'T ACCESS STRING "
1506                                                 "DATA %p)>", lheader, l->data);
1507                                         break;
1508                                 }
1509                         }
1510                 }
1511
1512                 if (LHEADER_IMPLEMENTATION(lheader)->printer) {
1513                         ((LHEADER_IMPLEMENTATION(lheader)->printer)
1514                          (obj, printcharfun, escapeflag));
1515                 } else {
1516                         default_object_printer(obj, printcharfun, escapeflag);
1517                 }
1518                 break;
1519         }
1520
1521         default: {
1522                 /* We're in trouble if this happens! */
1523                 printing_major_badness(printcharfun,
1524                                        "illegal data type", XTYPE(obj),
1525                                        LISP_TO_VOID(obj),
1526                                        BADNESS_INTEGER_OBJECT);
1527                 break;
1528         }
1529         }
1530
1531         print_depth--;
1532         return;
1533 }
1534
1535 void print_symbol(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1536 {
1537         /* This function can GC */
1538         /* #### Bug!! (intern "") isn't printed in some distinguished way */
1539         /* ####  (the reader also loses on it) */
1540         Lisp_String *name = symbol_name(XSYMBOL(obj));
1541         Bytecount size = string_length(name);
1542         struct gcpro gcpro1, gcpro2;
1543
1544         if (!escapeflag) {
1545                 /* This deals with GC-relocation */
1546                 Lisp_Object nameobj;
1547                 XSETSTRING(nameobj, name);
1548                 output_string(printcharfun, 0, nameobj, 0, size);
1549                 return;
1550         }
1551         GCPRO2(obj, printcharfun);
1552
1553         /* If we print an uninterned symbol as part of a complex object and
1554            the flag print-gensym is non-nil, prefix it with #n= to read the
1555            object back with the #n# reader syntax later if needed.  */
1556         if (!NILP(Vprint_gensym)
1557             /* #### Test whether this produces a noticeable slow-down for
1558                printing when print-gensym is non-nil.  */
1559             && !EQ(obj, oblookup(Vobarray,
1560                                  string_data(symbol_name(XSYMBOL(obj))),
1561                                  string_length(symbol_name(XSYMBOL(obj)))))) {
1562                 if (print_depth > 1) {
1563                         Lisp_Object tem = Fassq(obj, Vprint_gensym_alist);
1564                         if (CONSP(tem)) {
1565                                 write_char_internal("#", printcharfun);
1566                                 print_internal(XCDR(tem), printcharfun,
1567                                                escapeflag);
1568                                 write_char_internal("#", printcharfun);
1569                                 UNGCPRO;
1570                                 return;
1571                         } else {
1572                                 if (CONSP(Vprint_gensym_alist)) {
1573                                         /* Vprint_gensym_alist is exposed to Lisp, so we
1574                                            have to be careful.  */
1575                                         CHECK_CONS(XCAR(Vprint_gensym_alist));
1576                                         CHECK_INT(XCDR
1577                                                   (XCAR(Vprint_gensym_alist)));
1578                                         XSETINT(tem,
1579                                                 XINT(XCDR
1580                                                      (XCAR
1581                                                       (Vprint_gensym_alist))) +
1582                                                 1);
1583                                 } else
1584                                         XSETINT(tem, 1);
1585                                 Vprint_gensym_alist =
1586                                     Fcons(Fcons(obj, tem), Vprint_gensym_alist);
1587
1588                                 write_char_internal("#", printcharfun);
1589                                 print_internal(tem, printcharfun, escapeflag);
1590                                 write_char_internal("=", printcharfun);
1591                         }
1592                 }
1593                 write_c_string("#:", printcharfun);
1594         }
1595
1596         /* Does it look like an integer or a float? */
1597         {
1598                 Bufbyte *data = string_data(name);
1599                 Bytecount confusing = 0;
1600
1601                 if (size == 0)
1602                         goto not_yet_confused;  /* Really confusing */
1603                 else if (isdigit(data[0]))
1604                         confusing = 0;
1605                 else if (size == 1)
1606                         goto not_yet_confused;
1607                 else if (data[0] == '-' || data[0] == '+')
1608                         confusing = 1;
1609                 else
1610                         goto not_yet_confused;
1611
1612                 for (; confusing < size; confusing++) {
1613                         if (!isdigit(data[confusing])) {
1614                                 confusing = 0;
1615                                 break;
1616                         }
1617                 }
1618               not_yet_confused:
1619
1620 #ifdef HAVE_FPFLOAT
1621                 if (!confusing)
1622                         /* #### Ugh, this is needlessly complex and slow for what we
1623                            need here.  It might be a good idea to copy equivalent code
1624                            from FSF.  --hniksic */
1625                         confusing = isfloat_string((char *)data);
1626 #endif
1627                 if (confusing)
1628                         write_char_internal("\\", printcharfun);
1629         }
1630
1631         {
1632                 Lisp_Object nameobj;
1633                 Bytecount i;
1634                 Bytecount last = 0;
1635
1636                 XSETSTRING(nameobj, name);
1637                 for (i = 0; i < size; i++) {
1638                         switch (string_byte(name, i)) {
1639                         case 0:
1640                         case 1:
1641                         case 2:
1642                         case 3:
1643                         case 4:
1644                         case 5:
1645                         case 6:
1646                         case 7:
1647                         case 8:
1648                         case 9:
1649                         case 10:
1650                         case 11:
1651                         case 12:
1652                         case 13:
1653                         case 14:
1654                         case 15:
1655                         case 16:
1656                         case 17:
1657                         case 18:
1658                         case 19:
1659                         case 20:
1660                         case 21:
1661                         case 22:
1662                         case 23:
1663                         case 24:
1664                         case 25:
1665                         case 26:
1666                         case 27:
1667                         case 28:
1668                         case 29:
1669                         case 30:
1670                         case 31:
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                         case ']':
1684                         case '?':
1685                                 if (i > last)
1686                                         output_string(printcharfun, 0, nameobj,
1687                                                       last, i - last);
1688                                 write_char_internal("\\", printcharfun);
1689                                 last = i;
1690                         default:
1691                                 break;
1692                         }
1693                 }
1694                 output_string(printcharfun, 0, nameobj, last, size - last);
1695         }
1696         UNGCPRO;
1697 }
1698 \f
1699 /* Useful on systems or in places where writing to stdout is unavailable or
1700    not working. */
1701
1702 static int alternate_do_pointer;
1703 static char alternate_do_string[5000];
1704
1705 DEFUN("alternate-debugging-output", Falternate_debugging_output, 1, 1, 0,       /*
1706 Append CHARACTER to the array `alternate_do_string'.
1707 This can be used in place of `external-debugging-output' as a function
1708 to be passed to `print'.  Before calling `print', set `alternate_do_pointer'
1709 to 0.
1710 */
1711       (character))
1712 {
1713         Bufbyte str[MAX_EMCHAR_LEN];
1714         Bytecount len;
1715         int extlen;
1716         const Extbyte *extptr = NULL;
1717
1718         CHECK_CHAR_COERCE_INT(character);
1719         len = set_charptr_emchar(str, XCHAR(character));
1720         TO_EXTERNAL_FORMAT(DATA, (str, len),
1721                            ALLOCA, (extptr, extlen), Qterminal);
1722         if ( extptr != NULL ) {
1723                 memcpy(alternate_do_string + alternate_do_pointer, extptr, extlen);
1724                 alternate_do_pointer += extlen;
1725                 alternate_do_string[alternate_do_pointer] = 0;
1726         } else {
1727                 /* Better bad transcoding than nothing I guess... */
1728                 memcpy(alternate_do_string + alternate_do_pointer, str, len);
1729                 alternate_do_pointer += len;
1730                 alternate_do_string[alternate_do_pointer] = 0;
1731         }
1732         return character;
1733 }
1734
1735 DEFUN("external-debugging-output", Fexternal_debugging_output, 1, 3, 0, /*
1736 Write CHAR-OR-STRING to stderr or stdout.
1737 If optional arg STDOUT-P is non-nil, write to stdout; otherwise, write
1738 to stderr.  You can use this function to write directly to the terminal.
1739 This function can be used as the STREAM argument of Fprint() or the like.
1740
1741 Under MS Windows, this writes output to the console window (which is
1742 created, if necessary), unless SXEmacs is being run noninteractively
1743 \(i.e. using the `-batch' argument).
1744
1745 If you have opened a termscript file (using `open-termscript'), then
1746 the output also will be logged to this file.
1747 */
1748       (char_or_string, stdout_p, device))
1749 {
1750         FILE *file = NULL;
1751         struct console *con = NULL;
1752
1753         if (NILP(device)) {
1754                 if (!NILP(stdout_p))
1755                         file = stdout;
1756                 else
1757                         file = stderr;
1758         } else {
1759                 CHECK_LIVE_DEVICE(device);
1760                 if (!DEVICE_TTY_P(XDEVICE(device)) &&
1761                     !DEVICE_STREAM_P(XDEVICE(device)))
1762                         signal_simple_error("Must be tty or stream device",
1763                                             device);
1764                 con = XCONSOLE(DEVICE_CONSOLE(XDEVICE(device)));
1765                 if (DEVICE_TTY_P(XDEVICE(device))) {
1766                         file = 0;
1767                 } else if (!NILP(stdout_p)) {
1768                         file = CONSOLE_STREAM_DATA(con)->out;
1769                 } else {
1770                         file = CONSOLE_STREAM_DATA(con)->err;
1771                 }
1772         }
1773
1774         if (STRINGP(char_or_string))
1775                 write_string_to_stdio_stream(file, con,
1776                                              XSTRING_DATA(char_or_string),
1777                                              0, XSTRING_LENGTH(char_or_string),
1778                                              Qterminal, 1);
1779         else {
1780                 Bufbyte str[MAX_EMCHAR_LEN];
1781                 Bytecount len;
1782
1783                 CHECK_CHAR_COERCE_INT(char_or_string);
1784                 len = set_charptr_emchar(str, XCHAR(char_or_string));
1785                 write_string_to_stdio_stream(file, con, str, 0, len, Qterminal,
1786                                              1);
1787         }
1788
1789         return char_or_string;
1790 }
1791
1792 DEFUN("open-termscript", Fopen_termscript, 1, 1, "FOpen termscript file: ",     /*
1793 Start writing all terminal output to FILENAME as well as the terminal.
1794 FILENAME = nil means just close any termscript file currently open.
1795 */
1796       (filename))
1797 {
1798         /* This function can GC */
1799         if (termscript != 0) {
1800                 fclose(termscript);
1801                 termscript = 0;
1802         }
1803
1804         if (!NILP(filename)) {
1805                 filename = Fexpand_file_name(filename, Qnil);
1806                 termscript = fopen((char *)XSTRING_DATA(filename), "w");
1807                 if (termscript == NULL)
1808                         report_file_error("Opening termscript",
1809                                           list1(filename));
1810         }
1811         return Qnil;
1812 }
1813
1814 #if 1
1815 /* Debugging kludge -- unbuffered */
1816 static int debug_print_length = 50;
1817 static int debug_print_level = 15;
1818 static int debug_print_readably = -1;
1819
1820 static void debug_print_no_newline(Lisp_Object debug_print_obj)
1821 {
1822         /* This function can GC */
1823         int save_print_readably = print_readably;
1824         int save_print_depth = print_depth;
1825         Lisp_Object save_Vprint_length = Vprint_length;
1826         Lisp_Object save_Vprint_level = Vprint_level;
1827         Lisp_Object save_Vinhibit_quit = Vinhibit_quit;
1828         struct gcpro gcpro1, gcpro2, gcpro3;
1829         GCPRO3(save_Vprint_level, save_Vprint_length, save_Vinhibit_quit);
1830
1831         if (gc_in_progress)
1832                 stderr_out
1833                     ("** gc-in-progress!  Bad idea to print anything! **\n");
1834
1835         print_depth = 0;
1836         print_readably = debug_print_readably != -1 ? debug_print_readably : 0;
1837         print_unbuffered++;
1838         inhibit_non_essential_printing_operations = 1;
1839         /* Could use unwind-protect, but why bother? */
1840         if (debug_print_length > 0)
1841                 Vprint_length = make_int(debug_print_length);
1842         if (debug_print_level > 0)
1843                 Vprint_level = make_int(debug_print_level);
1844
1845         print_internal(debug_print_obj, Qexternal_debugging_output, 1);
1846         alternate_do_pointer = 0;
1847         print_internal(debug_print_obj, Qalternate_debugging_output, 1);
1848
1849         Vinhibit_quit = save_Vinhibit_quit;
1850         Vprint_level = save_Vprint_level;
1851         Vprint_length = save_Vprint_length;
1852         print_depth = save_print_depth;
1853         print_readably = save_print_readably;
1854         inhibit_non_essential_printing_operations = 0;
1855         print_unbuffered--;
1856         UNGCPRO;
1857 }
1858
1859 void debug_print(Lisp_Object debug_print_obj)
1860 {
1861         debug_print_no_newline(debug_print_obj);
1862         stderr_out("\n");
1863 }
1864
1865 /* Debugging kludge -- unbuffered */
1866 /* This function provided for the benefit of the debugger.  */
1867 void debug_backtrace(void)
1868 {
1869         /* This function can GC */
1870         int old_print_readably = print_readably;
1871         int old_print_depth = print_depth;
1872         Lisp_Object old_print_length = Vprint_length;
1873         Lisp_Object old_print_level = Vprint_level;
1874         Lisp_Object old_inhibit_quit = Vinhibit_quit;
1875
1876         struct gcpro gcpro1, gcpro2, gcpro3;
1877         GCPRO3(old_print_level, old_print_length, old_inhibit_quit);
1878
1879         if (gc_in_progress)
1880                 stderr_out
1881                     ("** gc-in-progress!  Bad idea to print anything! **\n");
1882
1883         print_depth = 0;
1884         print_readably = 0;
1885         print_unbuffered++;
1886         inhibit_non_essential_printing_operations = 1;
1887         /* Could use unwind-protect, but why bother? */
1888         if (debug_print_length > 0)
1889                 Vprint_length = make_int(debug_print_length);
1890         if (debug_print_level > 0)
1891                 Vprint_level = make_int(debug_print_level);
1892
1893         Fbacktrace(Qexternal_debugging_output, Qt);
1894         stderr_out("\n");
1895
1896         Vinhibit_quit = old_inhibit_quit;
1897         Vprint_level = old_print_level;
1898         Vprint_length = old_print_length;
1899         print_depth = old_print_depth;
1900         print_readably = old_print_readably;
1901         inhibit_non_essential_printing_operations = 0;
1902         print_unbuffered--;
1903
1904         UNGCPRO;
1905 }
1906
1907 void debug_short_backtrace(int length)
1908 {
1909         int first = 1;
1910         struct backtrace *bt = backtrace_list;
1911         stderr_out("   [");
1912         while (length > 0 && bt) {
1913                 if (!first) {
1914                         stderr_out(", ");
1915                 }
1916                 if (COMPILED_FUNCTIONP(*bt->function)) {
1917 #if defined(COMPILED_FUNCTION_ANNOTATION_HACK)
1918                         Lisp_Object ann =
1919                             compiled_function_annotation(XCOMPILED_FUNCTION
1920                                                          (*bt->function));
1921 #else
1922                         Lisp_Object ann = Qnil;
1923 #endif
1924                         if (!NILP(ann)) {
1925                                 stderr_out("<compiled-function from ");
1926                                 debug_print_no_newline(ann);
1927                                 stderr_out(">");
1928                         } else {
1929                                 stderr_out
1930                                     ("<compiled-function of unknown origin>");
1931                         }
1932                 } else
1933                         debug_print_no_newline(*bt->function);
1934                 first = 0;
1935                 length--;
1936                 bt = bt->next;
1937         }
1938         stderr_out("]\n");
1939 }
1940
1941 #endif                          /* debugging kludge */
1942 \f
1943 void syms_of_print(void)
1944 {
1945         defsymbol(&Qstandard_output, "standard-output");
1946
1947         defsymbol(&Qprint_length, "print-length");
1948
1949         defsymbol(&Qprint_string_length, "print-string-length");
1950
1951         defsymbol(&Qdisplay_error, "display-error");
1952         defsymbol(&Qprint_message_label, "print-message-label");
1953
1954         DEFSUBR(Fprin1);
1955         DEFSUBR(Fprin1_to_string);
1956         DEFSUBR(Fprinc);
1957         DEFSUBR(Fprint);
1958         DEFSUBR(Ferror_message_string);
1959         DEFSUBR(Fdisplay_error);
1960         DEFSUBR(Fterpri);
1961         DEFSUBR(Fwrite_char);
1962         DEFSUBR(Falternate_debugging_output);
1963         DEFSUBR(Fexternal_debugging_output);
1964         DEFSUBR(Fopen_termscript);
1965         defsymbol(&Qexternal_debugging_output, "external-debugging-output");
1966         defsymbol(&Qalternate_debugging_output, "alternate-debugging-output");
1967         DEFSUBR(Fwith_output_to_temp_buffer);
1968 }
1969
1970 void reinit_vars_of_print(void)
1971 {
1972         alternate_do_pointer = 0;
1973 }
1974
1975 void vars_of_print(void)
1976 {
1977         reinit_vars_of_print();
1978
1979         DEFVAR_LISP("standard-output", &Vstandard_output        /*
1980 Output stream `print' uses by default for outputting a character.
1981 This may be any function of one argument.
1982 It may also be a buffer (output is inserted before point)
1983 or a marker (output is inserted and the marker is advanced)
1984 or the symbol t (output appears in the minibuffer line).
1985                                                                  */ );
1986         Vstandard_output = Qt;
1987
1988 #ifdef HAVE_FPFLOAT
1989         DEFVAR_LISP("float-output-format", &Vfloat_output_format        /*
1990 The format descriptor string that lisp uses to print floats.
1991 This is a %-spec like those accepted by `printf' in C,
1992 but with some restrictions.  It must start with the two characters `%.'.
1993 After that comes an integer precision specification,
1994 and then a letter which controls the format.
1995 The letters allowed are `e', `f' and `g'.
1996 Use `e' for exponential notation "DIG.DIGITSeEXPT"
1997 Use `f' for decimal point notation "DIGITS.DIGITS".
1998 Use `g' to choose the shorter of those two formats for the number at hand.
1999 The precision in any of these cases is the number of digits following
2000 the decimal point.  With `f', a precision of 0 means to omit the
2001 decimal point.  0 is not allowed with `f' or `g'.
2002
2003 A value of nil means to use `%.16g'.
2004
2005 Regardless of the value of `float-output-format', a floating point number
2006 will never be printed in such a way that it is ambiguous with an integer;
2007 that is, a floating-point number will always be printed with a decimal
2008 point and/or an exponent, even if the digits following the decimal point
2009 are all zero.  This is to preserve read-equivalence.
2010                                                                          */ );
2011         Vfloat_output_format = Qnil;
2012 #endif                          /* HAVE_FPFLOAT */
2013
2014         DEFVAR_LISP("print-length", &Vprint_length      /*
2015 Maximum length of list or vector to print before abbreviating.
2016 A value of nil means no limit.
2017                                                          */ );
2018         Vprint_length = Qnil;
2019
2020         DEFVAR_LISP("print-string-length", &Vprint_string_length        /*
2021 Maximum length of string to print before abbreviating.
2022 A value of nil means no limit.
2023                                                                          */ );
2024         Vprint_string_length = Qnil;
2025
2026         DEFVAR_LISP("print-level", &Vprint_level        /*
2027 Maximum depth of list nesting to print before abbreviating.
2028 A value of nil means no limit.
2029                                                          */ );
2030         Vprint_level = Qnil;
2031
2032         DEFVAR_BOOL("print-escape-newlines", &print_escape_newlines     /*
2033 Non-nil means print newlines in strings as backslash-n.
2034                                                                          */ );
2035         print_escape_newlines = 0;
2036
2037         DEFVAR_BOOL("print-readably", &print_readably   /*
2038 If non-nil, then all objects will be printed in a readable form.
2039 If an object has no readable representation, then an error is signalled.
2040 When print-readably is true, compiled-function objects will be written in
2041 #[...] form instead of in #<compiled-function [...]> form, and two-element
2042 lists of the form (quote object) will be written as the equivalent 'object.
2043 Do not SET this variable; bind it instead.
2044                                                          */ );
2045         print_readably = 0;
2046
2047         /* #### I think this should default to t.  But we'd better wait
2048            until we see that it works out.  */
2049         DEFVAR_LISP("print-gensym", &Vprint_gensym      /*
2050 If non-nil, then uninterned symbols will be printed specially.
2051 Uninterned symbols are those which are not present in `obarray', that is,
2052 those which were made with `make-symbol' or by calling `intern' with a
2053 second argument.
2054
2055 When print-gensym is true, such symbols will be preceded by "#:",
2056 which causes the reader to create a new symbol instead of interning
2057 and returning an existing one.  Beware: the #: syntax creates a new
2058 symbol each time it is seen, so if you print an object which contains
2059 two pointers to the same uninterned symbol, `read' will not duplicate
2060 that structure.
2061
2062 If the value of `print-gensym' is a cons cell, then in addition
2063 refrain from clearing `print-gensym-alist' on entry to and exit from
2064 printing functions, so that the use of #...# and #...= can carry over
2065 for several separately printed objects.
2066                                                          */ );
2067         Vprint_gensym = Qnil;
2068
2069         DEFVAR_LISP("print-gensym-alist", &Vprint_gensym_alist  /*
2070 Association list of elements (GENSYM . N) to guide use of #N# and #N=.
2071 In each element, GENSYM is an uninterned symbol that has been associated
2072 with #N= for the specified value of N.
2073                                                                  */ );
2074         Vprint_gensym_alist = Qnil;
2075
2076         DEFVAR_LISP("print-message-label", &Vprint_message_label        /*
2077 Label for minibuffer messages created with `print'.  This should
2078 generally be bound with `let' rather than set.  (See `display-message'.)
2079                                                                          */ );
2080         Vprint_message_label = Qprint;
2081
2082         DEFVAR_LISP("custom-object-printer", &Vcustom_object_printer /*
2083 Function to call in order to print custom object.
2084                                                            */ );
2085         Vcustom_object_printer = Qnil;
2086 }