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 ( retval == 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                         ret = 0;                                        \
 149                 } else if ( (size_t)ret > (size_t)size ) {              \
 150                     /* We need more space, so we need to allocate it */ \
 151                         XMALLOC_UNBIND(buf,size,spec);                  \
 152                         size = ret + 1;                                 \
 153                         XMALLOC_OR_ALLOCA(buf,size,type);               \
 154                         ret = 0;                                        \
 155                 }                                                       \
 156         } while( ret == 0 && tries > 0 )
 157
 158
 159 int write_fmt_str(Lisp_Object stream, const char* fmt, ...)
 160 {
 161         char   *kludge;
 162         va_list args;
 163         int     bufsize, retval, tries = 3;
 164         /* write_fmt_str is used for small prints usually... */
 165         char    buffer[64+1];
 166         int speccount = specpdl_depth();
 167
 168         va_start(args, fmt);
 169         kludge = buffer;
 170         bufsize = sizeof(buffer);
 171
 172         SXE_VSNPRINT_VA(retval,buffer,kludge,bufsize,speccount,tries,char,fmt,args);
 173
 174         if (retval>0)
 175                 write_c_string(kludge,stream);
 176
 177         XMALLOC_UNBIND(kludge, bufsize, speccount);
 178         va_end(args);
 179
 180         if (retval < 0)
 181                 error("Error attempting to write write format string '%s'",
 182                       fmt);
 183         return retval;
 184 }
 185
 186 int write_fmt_string(Lisp_Object stream, const char *fmt, ...)
 187 {
 188         char   *kludge;
 189         va_list args;
 190         int     bufsize, retval, tries = 3;
 191         /* write_va is used for small prints usually... */
 192         char    buffer[128+1];
 193         int speccount = specpdl_depth();
 194
 195         va_start(args, fmt);
 196         kludge = buffer;
 197         bufsize = sizeof(buffer);
 198
 199         SXE_VSNPRINT_VA(retval,buffer,kludge,bufsize,speccount,tries,char,fmt,args);
 200         if (retval>0)
 201                 write_c_string(kludge,stream);
 202         XMALLOC_UNBIND(kludge, bufsize, speccount);
 203         va_end(args);
 204
 205         if (retval < 0)
 206                 error("Error attempting to write write format string '%s'",
 207                       fmt);
 208         return retval;
 209 }
 210
 211 /* #### The following function should be replaced a call to the
 212    emacs_doprnt_*() functions.  This is the only way to ensure that
 213    I18N3 works properly (many implementations of the *printf()
 214    functions, including the ones included in glibc, do not implement
 215    the %###$ argument-positioning syntax).
 216
 217    Note, however, that to do this, we'd have to
 218
 219    1) pre-allocate all the lstreams and do whatever else was necessary
 220    to make sure that no allocation occurs, since these functions may be
 221    called from fatal_error_signal().
 222
 223    2) (to be really correct) make a new lstream that outputs using
 224    mswindows_output_console_string().  */
 225
 226 static int std_handle_out_va(FILE * stream, const char *fmt, va_list args)
 227 {
 228         int      retval, tries = 3;
 229         size_t   bufsize;
 230         int      use_fprintf;
 231         Bufbyte *kludge;
 232         Bufbyte  buffer[1024]; /* Tax stack lightly, used to be 16KiB */
 233         int      speccount = specpdl_depth();
 234
 235         bufsize = sizeof(buffer);
 236         kludge = buffer;
 237
 238         SXE_VSNPRINT_VA(retval,buffer,kludge,bufsize,speccount,tries,Bufbyte,fmt,args);
 239
 240         if (retval == 0)
 241                 /* nothing to write */
 242                 return retval;
 243
 244         use_fprintf = ! initialized ||fatal_error_in_progress ||
 245                 inhibit_non_essential_printing_operations;
 246
 247         if (retval > 0) {
 248                 if (use_fprintf) {
 249                         fprintf(stream,"%s",(char*)kludge);
 250                 } else {
 251                         Extbyte  *extptr = NULL;
 252                         Extcount extlen = retval;
 253
 254                         TO_EXTERNAL_FORMAT(DATA, (kludge, strlen((char *)kludge)),
 255                                            ALLOCA, (extptr, extlen), Qnative);
 256                         std_handle_out_external(stream, Qnil, extptr, extlen, 1, 1);
 257                 }
 258         } else {
 259                 if (use_fprintf) {
 260                         fprintf(stream,"Error attempting to write format string '%s'",
 261                                 fmt);
 262                 } else {
 263                         const Extbyte *msg = "Error attempting to write format string";
 264                         std_handle_out_external(stream, Qnil, msg, strlen(msg), 1, 1);
 265                 }
 266         }
 267         XMALLOC_UNBIND(kludge, bufsize, speccount);
 268         return retval;
 269 }
 270
 271
 272 /* Output portably to stderr or its equivalent; call GETTEXT on the
 273    format string.  Automatically flush when done. */
 274
 275 int stderr_out(const char *fmt, ...)
 276 {
 277         int retval;
 278         va_list args;
 279         va_start(args, fmt);
 280         retval =
 281             std_handle_out_va
 282             (stderr, initialized
 283              && !fatal_error_in_progress ? GETTEXT(fmt) : fmt, args);
 284         va_end(args);
 285         return retval;
 286 }
 287
 288 /* Output portably to stdout or its equivalent; call GETTEXT on the
 289    format string.  Automatically flush when done. */
 290
 291 int stdout_out(const char *fmt, ...)
 292 {
 293         int retval;
 294         va_list args;
 295         va_start(args, fmt);
 296         retval = std_handle_out_va(stdout,
 297                                    (initialized && !fatal_error_in_progress
 298                                     ? GETTEXT(fmt) : fmt),
 299                                    args);
 300         va_end(args);
 301         return retval;
 302 }
 303
 304 DOESNT_RETURN fatal(const char *fmt, ...)
 305 {
 306         va_list args;
 307         va_start(args, fmt);
 308
 309         stderr_out("\nSXEmacs: ");
 310         std_handle_out_va(stderr,
 311                           (initialized && !fatal_error_in_progress
 312                            ? GETTEXT(fmt) : fmt),
 313                           args);
 314         stderr_out("\n");
 315
 316         va_end(args);
 317         exit(1);
 318 }
 319
 320 /* Write a string (in internal format) to stdio stream STREAM. */
 321
 322 void
 323 write_string_to_stdio_stream(FILE * stream, struct console *con,
 324                              const Bufbyte * str,
 325                              Bytecount offset, Bytecount len,
 326                              Lisp_Object coding_system, int must_flush)
 327 {
 328         Extcount extlen;
 329         const Extbyte *extptr;
 330
 331         /* #### yuck! sometimes this function is called with string data,
 332            and the following call may gc. */
 333         {
 334                 Bufbyte *puta = (Bufbyte *) alloca(len);
 335                 memcpy(puta, str + offset, len);
 336
 337                 if (initialized && !inhibit_non_essential_printing_operations)
 338                         TO_EXTERNAL_FORMAT(DATA, (puta, len),
 339                                            ALLOCA, (extptr, extlen),
 340                                            coding_system);
 341                 else {
 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;
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         memcpy(alternate_do_string + alternate_do_pointer, extptr, extlen);
1721         alternate_do_pointer += extlen;
1722         alternate_do_string[alternate_do_pointer] = 0;
1723         return character;
1724 }
1725
1726 DEFUN("external-debugging-output", Fexternal_debugging_output, 1, 3, 0, /*
1727 Write CHAR-OR-STRING to stderr or stdout.
1728 If optional arg STDOUT-P is non-nil, write to stdout; otherwise, write
1729 to stderr.  You can use this function to write directly to the terminal.
1730 This function can be used as the STREAM argument of Fprint() or the like.
1731
1732 Under MS Windows, this writes output to the console window (which is
1733 created, if necessary), unless SXEmacs is being run noninteractively
1734 \(i.e. using the `-batch' argument).
1735
1736 If you have opened a termscript file (using `open-termscript'), then
1737 the output also will be logged to this file.
1738 */
1739       (char_or_string, stdout_p, device))
1740 {
1741         FILE *file = NULL;
1742         struct console *con = NULL;
1743
1744         if (NILP(device)) {
1745                 if (!NILP(stdout_p))
1746                         file = stdout;
1747                 else
1748                         file = stderr;
1749         } else {
1750                 CHECK_LIVE_DEVICE(device);
1751                 if (!DEVICE_TTY_P(XDEVICE(device)) &&
1752                     !DEVICE_STREAM_P(XDEVICE(device)))
1753                         signal_simple_error("Must be tty or stream device",
1754                                             device);
1755                 con = XCONSOLE(DEVICE_CONSOLE(XDEVICE(device)));
1756                 if (DEVICE_TTY_P(XDEVICE(device))) {
1757                         file = 0;
1758                 } else if (!NILP(stdout_p)) {
1759                         file = CONSOLE_STREAM_DATA(con)->out;
1760                 } else {
1761                         file = CONSOLE_STREAM_DATA(con)->err;
1762                 }
1763         }
1764
1765         if (STRINGP(char_or_string))
1766                 write_string_to_stdio_stream(file, con,
1767                                              XSTRING_DATA(char_or_string),
1768                                              0, XSTRING_LENGTH(char_or_string),
1769                                              Qterminal, 1);
1770         else {
1771                 Bufbyte str[MAX_EMCHAR_LEN];
1772                 Bytecount len;
1773
1774                 CHECK_CHAR_COERCE_INT(char_or_string);
1775                 len = set_charptr_emchar(str, XCHAR(char_or_string));
1776                 write_string_to_stdio_stream(file, con, str, 0, len, Qterminal,
1777                                              1);
1778         }
1779
1780         return char_or_string;
1781 }
1782
1783 DEFUN("open-termscript", Fopen_termscript, 1, 1, "FOpen termscript file: ",     /*
1784 Start writing all terminal output to FILENAME as well as the terminal.
1785 FILENAME = nil means just close any termscript file currently open.
1786 */
1787       (filename))
1788 {
1789         /* This function can GC */
1790         if (termscript != 0) {
1791                 fclose(termscript);
1792                 termscript = 0;
1793         }
1794
1795         if (!NILP(filename)) {
1796                 filename = Fexpand_file_name(filename, Qnil);
1797                 termscript = fopen((char *)XSTRING_DATA(filename), "w");
1798                 if (termscript == NULL)
1799                         report_file_error("Opening termscript",
1800                                           list1(filename));
1801         }
1802         return Qnil;
1803 }
1804
1805 #if 1
1806 /* Debugging kludge -- unbuffered */
1807 static int debug_print_length = 50;
1808 static int debug_print_level = 15;
1809 static int debug_print_readably = -1;
1810
1811 static void debug_print_no_newline(Lisp_Object debug_print_obj)
1812 {
1813         /* This function can GC */
1814         int save_print_readably = print_readably;
1815         int save_print_depth = print_depth;
1816         Lisp_Object save_Vprint_length = Vprint_length;
1817         Lisp_Object save_Vprint_level = Vprint_level;
1818         Lisp_Object save_Vinhibit_quit = Vinhibit_quit;
1819         struct gcpro gcpro1, gcpro2, gcpro3;
1820         GCPRO3(save_Vprint_level, save_Vprint_length, save_Vinhibit_quit);
1821
1822         if (gc_in_progress)
1823                 stderr_out
1824                     ("** gc-in-progress!  Bad idea to print anything! **\n");
1825
1826         print_depth = 0;
1827         print_readably = debug_print_readably != -1 ? debug_print_readably : 0;
1828         print_unbuffered++;
1829         inhibit_non_essential_printing_operations = 1;
1830         /* Could use unwind-protect, but why bother? */
1831         if (debug_print_length > 0)
1832                 Vprint_length = make_int(debug_print_length);
1833         if (debug_print_level > 0)
1834                 Vprint_level = make_int(debug_print_level);
1835
1836         print_internal(debug_print_obj, Qexternal_debugging_output, 1);
1837         alternate_do_pointer = 0;
1838         print_internal(debug_print_obj, Qalternate_debugging_output, 1);
1839
1840         Vinhibit_quit = save_Vinhibit_quit;
1841         Vprint_level = save_Vprint_level;
1842         Vprint_length = save_Vprint_length;
1843         print_depth = save_print_depth;
1844         print_readably = save_print_readably;
1845         inhibit_non_essential_printing_operations = 0;
1846         print_unbuffered--;
1847         UNGCPRO;
1848 }
1849
1850 void debug_print(Lisp_Object debug_print_obj)
1851 {
1852         debug_print_no_newline(debug_print_obj);
1853         stderr_out("\n");
1854 }
1855
1856 /* Debugging kludge -- unbuffered */
1857 /* This function provided for the benefit of the debugger.  */
1858 void debug_backtrace(void)
1859 {
1860         /* This function can GC */
1861         int old_print_readably = print_readably;
1862         int old_print_depth = print_depth;
1863         Lisp_Object old_print_length = Vprint_length;
1864         Lisp_Object old_print_level = Vprint_level;
1865         Lisp_Object old_inhibit_quit = Vinhibit_quit;
1866
1867         struct gcpro gcpro1, gcpro2, gcpro3;
1868         GCPRO3(old_print_level, old_print_length, old_inhibit_quit);
1869
1870         if (gc_in_progress)
1871                 stderr_out
1872                     ("** gc-in-progress!  Bad idea to print anything! **\n");
1873
1874         print_depth = 0;
1875         print_readably = 0;
1876         print_unbuffered++;
1877         inhibit_non_essential_printing_operations = 1;
1878         /* Could use unwind-protect, but why bother? */
1879         if (debug_print_length > 0)
1880                 Vprint_length = make_int(debug_print_length);
1881         if (debug_print_level > 0)
1882                 Vprint_level = make_int(debug_print_level);
1883
1884         Fbacktrace(Qexternal_debugging_output, Qt);
1885         stderr_out("\n");
1886
1887         Vinhibit_quit = old_inhibit_quit;
1888         Vprint_level = old_print_level;
1889         Vprint_length = old_print_length;
1890         print_depth = old_print_depth;
1891         print_readably = old_print_readably;
1892         inhibit_non_essential_printing_operations = 0;
1893         print_unbuffered--;
1894
1895         UNGCPRO;
1896 }
1897
1898 void debug_short_backtrace(int length)
1899 {
1900         int first = 1;
1901         struct backtrace *bt = backtrace_list;
1902         stderr_out("   [");
1903         while (length > 0 && bt) {
1904                 if (!first) {
1905                         stderr_out(", ");
1906                 }
1907                 if (COMPILED_FUNCTIONP(*bt->function)) {
1908 #if defined(COMPILED_FUNCTION_ANNOTATION_HACK)
1909                         Lisp_Object ann =
1910                             compiled_function_annotation(XCOMPILED_FUNCTION
1911                                                          (*bt->function));
1912 #else
1913                         Lisp_Object ann = Qnil;
1914 #endif
1915                         if (!NILP(ann)) {
1916                                 stderr_out("<compiled-function from ");
1917                                 debug_print_no_newline(ann);
1918                                 stderr_out(">");
1919                         } else {
1920                                 stderr_out
1921                                     ("<compiled-function of unknown origin>");
1922                         }
1923                 } else
1924                         debug_print_no_newline(*bt->function);
1925                 first = 0;
1926                 length--;
1927                 bt = bt->next;
1928         }
1929         stderr_out("]\n");
1930 }
1931
1932 #endif                          /* debugging kludge */
1933 \f
1934 void syms_of_print(void)
1935 {
1936         defsymbol(&Qstandard_output, "standard-output");
1937
1938         defsymbol(&Qprint_length, "print-length");
1939
1940         defsymbol(&Qprint_string_length, "print-string-length");
1941
1942         defsymbol(&Qdisplay_error, "display-error");
1943         defsymbol(&Qprint_message_label, "print-message-label");
1944
1945         DEFSUBR(Fprin1);
1946         DEFSUBR(Fprin1_to_string);
1947         DEFSUBR(Fprinc);
1948         DEFSUBR(Fprint);
1949         DEFSUBR(Ferror_message_string);
1950         DEFSUBR(Fdisplay_error);
1951         DEFSUBR(Fterpri);
1952         DEFSUBR(Fwrite_char);
1953         DEFSUBR(Falternate_debugging_output);
1954         DEFSUBR(Fexternal_debugging_output);
1955         DEFSUBR(Fopen_termscript);
1956         defsymbol(&Qexternal_debugging_output, "external-debugging-output");
1957         defsymbol(&Qalternate_debugging_output, "alternate-debugging-output");
1958         DEFSUBR(Fwith_output_to_temp_buffer);
1959 }
1960
1961 void reinit_vars_of_print(void)
1962 {
1963         alternate_do_pointer = 0;
1964 }
1965
1966 void vars_of_print(void)
1967 {
1968         reinit_vars_of_print();
1969
1970         DEFVAR_LISP("standard-output", &Vstandard_output        /*
1971 Output stream `print' uses by default for outputting a character.
1972 This may be any function of one argument.
1973 It may also be a buffer (output is inserted before point)
1974 or a marker (output is inserted and the marker is advanced)
1975 or the symbol t (output appears in the minibuffer line).
1976                                                                  */ );
1977         Vstandard_output = Qt;
1978
1979 #ifdef HAVE_FPFLOAT
1980         DEFVAR_LISP("float-output-format", &Vfloat_output_format        /*
1981 The format descriptor string that lisp uses to print floats.
1982 This is a %-spec like those accepted by `printf' in C,
1983 but with some restrictions.  It must start with the two characters `%.'.
1984 After that comes an integer precision specification,
1985 and then a letter which controls the format.
1986 The letters allowed are `e', `f' and `g'.
1987 Use `e' for exponential notation "DIG.DIGITSeEXPT"
1988 Use `f' for decimal point notation "DIGITS.DIGITS".
1989 Use `g' to choose the shorter of those two formats for the number at hand.
1990 The precision in any of these cases is the number of digits following
1991 the decimal point.  With `f', a precision of 0 means to omit the
1992 decimal point.  0 is not allowed with `f' or `g'.
1993
1994 A value of nil means to use `%.16g'.
1995
1996 Regardless of the value of `float-output-format', a floating point number
1997 will never be printed in such a way that it is ambiguous with an integer;
1998 that is, a floating-point number will always be printed with a decimal
1999 point and/or an exponent, even if the digits following the decimal point
2000 are all zero.  This is to preserve read-equivalence.
2001                                                                          */ );
2002         Vfloat_output_format = Qnil;
2003 #endif                          /* HAVE_FPFLOAT */
2004
2005         DEFVAR_LISP("print-length", &Vprint_length      /*
2006 Maximum length of list or vector to print before abbreviating.
2007 A value of nil means no limit.
2008                                                          */ );
2009         Vprint_length = Qnil;
2010
2011         DEFVAR_LISP("print-string-length", &Vprint_string_length        /*
2012 Maximum length of string to print before abbreviating.
2013 A value of nil means no limit.
2014                                                                          */ );
2015         Vprint_string_length = Qnil;
2016
2017         DEFVAR_LISP("print-level", &Vprint_level        /*
2018 Maximum depth of list nesting to print before abbreviating.
2019 A value of nil means no limit.
2020                                                          */ );
2021         Vprint_level = Qnil;
2022
2023         DEFVAR_BOOL("print-escape-newlines", &print_escape_newlines     /*
2024 Non-nil means print newlines in strings as backslash-n.
2025                                                                          */ );
2026         print_escape_newlines = 0;
2027
2028         DEFVAR_BOOL("print-readably", &print_readably   /*
2029 If non-nil, then all objects will be printed in a readable form.
2030 If an object has no readable representation, then an error is signalled.
2031 When print-readably is true, compiled-function objects will be written in
2032 #[...] form instead of in #<compiled-function [...]> form, and two-element
2033 lists of the form (quote object) will be written as the equivalent 'object.
2034 Do not SET this variable; bind it instead.
2035                                                          */ );
2036         print_readably = 0;
2037
2038         /* #### I think this should default to t.  But we'd better wait
2039            until we see that it works out.  */
2040         DEFVAR_LISP("print-gensym", &Vprint_gensym      /*
2041 If non-nil, then uninterned symbols will be printed specially.
2042 Uninterned symbols are those which are not present in `obarray', that is,
2043 those which were made with `make-symbol' or by calling `intern' with a
2044 second argument.
2045
2046 When print-gensym is true, such symbols will be preceded by "#:",
2047 which causes the reader to create a new symbol instead of interning
2048 and returning an existing one.  Beware: the #: syntax creates a new
2049 symbol each time it is seen, so if you print an object which contains
2050 two pointers to the same uninterned symbol, `read' will not duplicate
2051 that structure.
2052
2053 If the value of `print-gensym' is a cons cell, then in addition
2054 refrain from clearing `print-gensym-alist' on entry to and exit from
2055 printing functions, so that the use of #...# and #...= can carry over
2056 for several separately printed objects.
2057                                                          */ );
2058         Vprint_gensym = Qnil;
2059
2060         DEFVAR_LISP("print-gensym-alist", &Vprint_gensym_alist  /*
2061 Association list of elements (GENSYM . N) to guide use of #N# and #N=.
2062 In each element, GENSYM is an uninterned symbol that has been associated
2063 with #N= for the specified value of N.
2064                                                                  */ );
2065         Vprint_gensym_alist = Qnil;
2066
2067         DEFVAR_LISP("print-message-label", &Vprint_message_label        /*
2068 Label for minibuffer messages created with `print'.  This should
2069 generally be bound with `let' rather than set.  (See `display-message'.)
2070                                                                          */ );
2071         Vprint_message_label = Qprint;
2072
2073         DEFVAR_LISP("custom-object-printer", &Vcustom_object_printer /*
2074 Function to call in order to print custom object.
2075                                                            */ );
2076         Vcustom_object_printer = Qnil;
2077 }