src/print.c

   1 /* Lisp object printing and output streams.
   2    Copyright (C) 1985, 1986, 1988, 1993 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20
  21 #include "config.h"
  22 #include <stdio.h>
  23 #undef NULL
  24 #include "lisp.h"
  25
  26 #ifndef standalone
  27 #include "buffer.h"
  28 #include "frame.h"
  29 #include "window.h"
  30 #include "process.h"
  31 #include "dispextern.h"
  32 #include "termchar.h"
  33 #endif /* not standalone */
  34
  35 #ifdef USE_TEXT_PROPERTIES
  36 #include "intervals.h"
  37 #endif
  38
  39 Lisp_Object Vstandard_output, Qstandard_output;
  40
  41 #ifdef LISP_FLOAT_TYPE
  42 Lisp_Object Vfloat_output_format, Qfloat_output_format;
  43 #endif /* LISP_FLOAT_TYPE */
  44
  45 /* Avoid actual stack overflow in print.  */
  46 int print_depth;
  47
  48 /* Detect most circularities to print finite output.  */
  49 #define PRINT_CIRCLE 200
  50 Lisp_Object being_printed[PRINT_CIRCLE];
  51
  52 /* Maximum length of list to print in full; noninteger means
  53    effectively infinity */
  54
  55 Lisp_Object Vprint_length;
  56
  57 /* Maximum depth of list to print in full; noninteger means
  58    effectively infinity.  */
  59
  60 Lisp_Object Vprint_level;
  61
  62 /* Nonzero means print newlines in strings as \n.  */
  63
  64 int print_escape_newlines;
  65
  66 Lisp_Object Qprint_escape_newlines;
  67
  68 /* Nonzero means print newline before next minibuffer message.
  69    Defined in xdisp.c */
  70
  71 extern int noninteractive_need_newline;
  72 #ifdef MAX_PRINT_CHARS
  73 static int print_chars;
  74 static int max_print;
  75 #endif /* MAX_PRINT_CHARS */
  76
  77 void print_interval ();
  78 \f
  79 #if 0
  80 /* Convert between chars and GLYPHs */
  81
  82 int
  83 glyphlen (glyphs)
  84      register GLYPH *glyphs;
  85 {
  86   register int i = 0;
  87
  88   while (glyphs[i])
  89     i++;
  90   return i;
  91 }
  92
  93 void
  94 str_to_glyph_cpy (str, glyphs)
  95      char *str;
  96      GLYPH *glyphs;
  97 {
  98   register GLYPH *gp = glyphs;
  99   register char *cp = str;
 100
 101   while (*cp)
 102     *gp++ = *cp++;
 103 }
 104
 105 void
 106 str_to_glyph_ncpy (str, glyphs, n)
 107      char *str;
 108      GLYPH *glyphs;
 109      register int n;
 110 {
 111   register GLYPH *gp = glyphs;
 112   register char *cp = str;
 113
 114   while (n-- > 0)
 115     *gp++ = *cp++;
 116 }
 117
 118 void
 119 glyph_to_str_cpy (glyphs, str)
 120      GLYPH *glyphs;
 121      char *str;
 122 {
 123   register GLYPH *gp = glyphs;
 124   register char *cp = str;
 125
 126   while (*gp)
 127     *str++ = *gp++ & 0377;
 128 }
 129 #endif
 130 \f
 131 /* Low level output routines for characters and strings */
 132
 133 /* Lisp functions to do output using a stream
 134  must have the stream in a variable called printcharfun
 135  and must start with PRINTPREPARE and end with PRINTFINISH.
 136  Use PRINTCHAR to output one character,
 137  or call strout to output a block of characters.
 138  Also, each one must have the declarations
 139    struct buffer *old = current_buffer;
 140    int old_point = -1, start_point;
 141    Lisp_Object original;
 142 */
 143
 144 #define PRINTPREPARE                                            \
 145    original = printcharfun;                                     \
 146    if (NILP (printcharfun)) printcharfun = Qt;                  \
 147    if (XTYPE (printcharfun) == Lisp_Buffer)                     \
 148      { if (XBUFFER (printcharfun) != current_buffer)            \
 149          Fset_buffer (printcharfun);                            \
 150        printcharfun = Qnil;}                                    \
 151    if (XTYPE (printcharfun) == Lisp_Marker)                     \
 152      { if (!(XMARKER (original)->buffer))                       \
 153          error ("Marker does not point anywhere");              \
 154        if (XMARKER (original)->buffer != current_buffer)        \
 155          set_buffer_internal (XMARKER (original)->buffer);      \
 156        old_point = point;                                       \
 157        SET_PT (marker_position (printcharfun));                 \
 158        start_point = point;                                     \
 159        printcharfun = Qnil;}
 160
 161 #define PRINTFINISH                                     \
 162    if (XTYPE (original) == Lisp_Marker)                 \
 163      Fset_marker (original, make_number (point), Qnil); \
 164    if (old_point >= 0)                                  \
 165      SET_PT (old_point + (old_point >= start_point      \
 166                           ? point - start_point : 0));  \
 167    if (old != current_buffer)                           \
 168      set_buffer_internal (old)
 169
 170 #define PRINTCHAR(ch) printchar (ch, printcharfun)
 171
 172 /* Index of first unused element of FRAME_MESSAGE_BUF(selected_frame). */
 173 static int printbufidx;
 174
 175 static void
 176 printchar (ch, fun)
 177      unsigned char ch;
 178      Lisp_Object fun;
 179 {
 180   Lisp_Object ch1;
 181
 182 #ifdef MAX_PRINT_CHARS
 183   if (max_print)
 184     print_chars++;
 185 #endif /* MAX_PRINT_CHARS */
 186 #ifndef standalone
 187   if (EQ (fun, Qnil))
 188     {
 189       QUIT;
 190       insert (&ch, 1);
 191       return;
 192     }
 193
 194   if (EQ (fun, Qt))
 195     {
 196       if (noninteractive)
 197         {
 198           putchar (ch);
 199           noninteractive_need_newline = 1;
 200           return;
 201         }
 202
 203       if (echo_area_glyphs != FRAME_MESSAGE_BUF (selected_frame)
 204           || !message_buf_print)
 205         {
 206           echo_area_glyphs = FRAME_MESSAGE_BUF (selected_frame);
 207           printbufidx = 0;
 208           message_buf_print = 1;
 209         }
 210
 211       if (printbufidx < FRAME_WIDTH (selected_frame) - 1)
 212         FRAME_MESSAGE_BUF (selected_frame)[printbufidx++] = ch;
 213       FRAME_MESSAGE_BUF (selected_frame)[printbufidx] = 0;
 214
 215       return;
 216     }
 217 #endif /* not standalone */
 218
 219   XFASTINT (ch1) = ch;
 220   call1 (fun, ch1);
 221 }
 222
 223 static void
 224 strout (ptr, size, printcharfun)
 225      char *ptr;
 226      int size;
 227      Lisp_Object printcharfun;
 228 {
 229   int i = 0;
 230
 231   if (EQ (printcharfun, Qnil))
 232     {
 233       insert (ptr, size >= 0 ? size : strlen (ptr));
 234 #ifdef MAX_PRINT_CHARS
 235       if (max_print)
 236         print_chars += size >= 0 ? size : strlen(ptr);
 237 #endif /* MAX_PRINT_CHARS */
 238       return;
 239     }
 240   if (EQ (printcharfun, Qt))
 241     {
 242       i = size >= 0 ? size : strlen (ptr);
 243 #ifdef MAX_PRINT_CHARS
 244       if (max_print)
 245         print_chars += i;
 246 #endif /* MAX_PRINT_CHARS */
 247
 248       if (noninteractive)
 249         {
 250           fwrite (ptr, 1, i, stdout);
 251           noninteractive_need_newline = 1;
 252           return;
 253         }
 254
 255       if (echo_area_glyphs != FRAME_MESSAGE_BUF (selected_frame)
 256           || !message_buf_print)
 257         {
 258           echo_area_glyphs = FRAME_MESSAGE_BUF (selected_frame);
 259           printbufidx = 0;
 260           message_buf_print = 1;
 261         }
 262
 263       if (i > FRAME_WIDTH (selected_frame) - printbufidx - 1)
 264         i = FRAME_WIDTH (selected_frame) - printbufidx - 1;
 265       bcopy (ptr, &FRAME_MESSAGE_BUF (selected_frame) [printbufidx], i);
 266       printbufidx += i;
 267       FRAME_MESSAGE_BUF (selected_frame) [printbufidx] = 0;
 268
 269       return;
 270     }
 271
 272   if (size >= 0)
 273     while (i < size)
 274       PRINTCHAR (ptr[i++]);
 275   else
 276     while (ptr[i])
 277       PRINTCHAR (ptr[i++]);
 278 }
 279
 280 /* Print the contents of a string STRING using PRINTCHARFUN.
 281    It isn't safe to use strout, because printing one char can relocate.  */
 282
 283 print_string (string, printcharfun)
 284      Lisp_Object string;
 285      Lisp_Object printcharfun;
 286 {
 287   if (EQ (printcharfun, Qnil) || EQ (printcharfun, Qt))
 288     /* In predictable cases, strout is safe: output to buffer or frame.  */
 289     strout (XSTRING (string)->data, XSTRING (string)->size, printcharfun);
 290   else
 291     {
 292       /* Otherwise, fetch the string address for each character.  */
 293       int i;
 294       int size = XSTRING (string)->size;
 295       struct gcpro gcpro1;
 296       GCPRO1 (string);
 297       for (i = 0; i < size; i++)
 298         PRINTCHAR (XSTRING (string)->data[i]);
 299       UNGCPRO;
 300     }
 301 }
 302 \f
 303 DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
 304   "Output character CHAR to stream STREAM.\n\
 305 STREAM defaults to the value of `standard-output' (which see).")
 306   (ch, printcharfun)
 307      Lisp_Object ch, printcharfun;
 308 {
 309   struct buffer *old = current_buffer;
 310   int old_point = -1;
 311   int start_point;
 312   Lisp_Object original;
 313
 314   if (NILP (printcharfun))
 315     printcharfun = Vstandard_output;
 316   CHECK_NUMBER (ch, 0);
 317   PRINTPREPARE;
 318   PRINTCHAR (XINT (ch));
 319   PRINTFINISH;
 320   return ch;
 321 }
 322
 323 /* Used from outside of print.c to print a block of SIZE chars at DATA
 324    on the default output stream.
 325    Do not use this on the contents of a Lisp string.  */
 326
 327 write_string (data, size)
 328      char *data;
 329      int size;
 330 {
 331   struct buffer *old = current_buffer;
 332   Lisp_Object printcharfun;
 333   int old_point = -1;
 334   int start_point;
 335   Lisp_Object original;
 336
 337   printcharfun = Vstandard_output;
 338
 339   PRINTPREPARE;
 340   strout (data, size, printcharfun);
 341   PRINTFINISH;
 342 }
 343
 344 /* Used from outside of print.c to print a block of SIZE chars at DATA
 345    on a specified stream PRINTCHARFUN.
 346    Do not use this on the contents of a Lisp string.  */
 347
 348 write_string_1 (data, size, printcharfun)
 349      char *data;
 350      int size;
 351      Lisp_Object printcharfun;
 352 {
 353   struct buffer *old = current_buffer;
 354   int old_point = -1;
 355   int start_point;
 356   Lisp_Object original;
 357
 358   PRINTPREPARE;
 359   strout (data, size, printcharfun);
 360   PRINTFINISH;
 361 }
 362
 363
 364 #ifndef standalone
 365
 366 void
 367 temp_output_buffer_setup (bufname)
 368     char *bufname;
 369 {
 370   register struct buffer *old = current_buffer;
 371   register Lisp_Object buf;
 372
 373   Fset_buffer (Fget_buffer_create (build_string (bufname)));
 374
 375   current_buffer->read_only = Qnil;
 376   Ferase_buffer ();
 377
 378   XSET (buf, Lisp_Buffer, current_buffer);
 379   specbind (Qstandard_output, buf);
 380
 381   set_buffer_internal (old);
 382 }
 383
 384 Lisp_Object
 385 internal_with_output_to_temp_buffer (bufname, function, args)
 386      char *bufname;
 387      Lisp_Object (*function) ();
 388      Lisp_Object args;
 389 {
 390   int count = specpdl_ptr - specpdl;
 391   Lisp_Object buf, val;
 392
 393   record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
 394   temp_output_buffer_setup (bufname);
 395   buf = Vstandard_output;
 396
 397   val = (*function) (args);
 398
 399   temp_output_buffer_show (buf);
 400
 401   return unbind_to (count, val);
 402 }
 403
 404 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
 405        1, UNEVALLED, 0,
 406   "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
 407 The buffer is cleared out initially, and marked as unmodified when done.\n\
 408 All output done by BODY is inserted in that buffer by default.\n\
 409 The buffer is displayed in another window, but not selected.\n\
 410 The value of the last form in BODY is returned.\n\
 411 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
 412 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
 413 to get the buffer displayed.  It gets one argument, the buffer to display.")
 414   (args)
 415      Lisp_Object args;
 416 {
 417   struct gcpro gcpro1;
 418   Lisp_Object name;
 419   int count = specpdl_ptr - specpdl;
 420   Lisp_Object buf, val;
 421
 422   GCPRO1(args);
 423   name = Feval (Fcar (args));
 424   UNGCPRO;
 425
 426   CHECK_STRING (name, 0);
 427   temp_output_buffer_setup (XSTRING (name)->data);
 428   buf = Vstandard_output;
 429
 430   val = Fprogn (Fcdr (args));
 431
 432   temp_output_buffer_show (buf);
 433
 434   return unbind_to (count, val);
 435 }
 436 #endif /* not standalone */
 437 \f
 438 static void print ();
 439
 440 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
 441   "Output a newline to STREAM.\n\
 442 If STREAM is omitted or nil, the value of `standard-output' is used.")
 443   (printcharfun)
 444      Lisp_Object printcharfun;
 445 {
 446   struct buffer *old = current_buffer;
 447   int old_point = -1;
 448   int start_point;
 449   Lisp_Object original;
 450
 451   if (NILP (printcharfun))
 452     printcharfun = Vstandard_output;
 453   PRINTPREPARE;
 454   PRINTCHAR ('\n');
 455   PRINTFINISH;
 456   return Qt;
 457 }
 458
 459 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
 460   "Output the printed representation of OBJECT, any Lisp object.\n\
 461 Quoting characters are printed when needed to make output that `read'\n\
 462 can handle, whenever this is possible.\n\
 463 Output stream is STREAM, or value of `standard-output' (which see).")
 464   (obj, printcharfun)
 465      Lisp_Object obj, printcharfun;
 466 {
 467   struct buffer *old = current_buffer;
 468   int old_point = -1;
 469   int start_point;
 470   Lisp_Object original;
 471
 472 #ifdef MAX_PRINT_CHARS
 473   max_print = 0;
 474 #endif /* MAX_PRINT_CHARS */
 475   if (NILP (printcharfun))
 476     printcharfun = Vstandard_output;
 477   PRINTPREPARE;
 478   print_depth = 0;
 479   print (obj, printcharfun, 1);
 480   PRINTFINISH;
 481   return obj;
 482 }
 483
 484 /* a buffer which is used to hold output being built by prin1-to-string */
 485 Lisp_Object Vprin1_to_string_buffer;
 486
 487 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
 488   "Return a string containing the printed representation of OBJECT,\n\
 489 any Lisp object.  Quoting characters are used when needed to make output\n\
 490 that `read' can handle, whenever this is possible, unless the optional\n\
 491 second argument NOESCAPE is non-nil.")
 492   (obj, noescape)
 493      Lisp_Object obj, noescape;
 494 {
 495   struct buffer *old = current_buffer;
 496   int old_point = -1;
 497   int start_point;
 498   Lisp_Object original, printcharfun;
 499   struct gcpro gcpro1;
 500
 501   printcharfun = Vprin1_to_string_buffer;
 502   PRINTPREPARE;
 503   print_depth = 0;
 504   print (obj, printcharfun, NILP (noescape));
 505   /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
 506   PRINTFINISH;
 507   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 508   obj = Fbuffer_string ();
 509
 510   GCPRO1 (obj);
 511   Ferase_buffer ();
 512   set_buffer_internal (old);
 513   UNGCPRO;
 514
 515   return obj;
 516 }
 517
 518 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
 519   "Output the printed representation of OBJECT, any Lisp object.\n\
 520 No quoting characters are used; no delimiters are printed around\n\
 521 the contents of strings.\n\
 522 Output stream is STREAM, or value of standard-output (which see).")
 523   (obj, printcharfun)
 524      Lisp_Object obj, printcharfun;
 525 {
 526   struct buffer *old = current_buffer;
 527   int old_point = -1;
 528   int start_point;
 529   Lisp_Object original;
 530
 531   if (NILP (printcharfun))
 532     printcharfun = Vstandard_output;
 533   PRINTPREPARE;
 534   print_depth = 0;
 535   print (obj, printcharfun, 0);
 536   PRINTFINISH;
 537   return obj;
 538 }
 539
 540 DEFUN ("print", Fprint, Sprint, 1, 2, 0,
 541   "Output the printed representation of OBJECT, with newlines around it.\n\
 542 Quoting characters are printed when needed to make output that `read'\n\
 543 can handle, whenever this is possible.\n\
 544 Output stream is STREAM, or value of `standard-output' (which see).")
 545   (obj, printcharfun)
 546      Lisp_Object obj, printcharfun;
 547 {
 548   struct buffer *old = current_buffer;
 549   int old_point = -1;
 550   int start_point;
 551   Lisp_Object original;
 552   struct gcpro gcpro1;
 553
 554 #ifdef MAX_PRINT_CHARS
 555   print_chars = 0;
 556   max_print = MAX_PRINT_CHARS;
 557 #endif /* MAX_PRINT_CHARS */
 558   if (NILP (printcharfun))
 559     printcharfun = Vstandard_output;
 560   GCPRO1 (obj);
 561   PRINTPREPARE;
 562   print_depth = 0;
 563   PRINTCHAR ('\n');
 564   print (obj, printcharfun, 1);
 565   PRINTCHAR ('\n');
 566   PRINTFINISH;
 567 #ifdef MAX_PRINT_CHARS
 568   max_print = 0;
 569   print_chars = 0;
 570 #endif /* MAX_PRINT_CHARS */
 571   UNGCPRO;
 572   return obj;
 573 }
 574
 575 /* The subroutine object for external-debugging-output is kept here
 576    for the convenience of the debugger.  */
 577 Lisp_Object Qexternal_debugging_output;
 578
 579 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
 580   "Write CHARACTER to stderr.\n\
 581 You can call print while debugging emacs, and pass it this function\n\
 582 to make it write to the debugging output.\n")
 583   (character)
 584      Lisp_Object character;
 585 {
 586   CHECK_NUMBER (character, 0);
 587   putc (XINT (character), stderr);
 588
 589   return character;
 590 }
 591 \f
 592 #ifdef LISP_FLOAT_TYPE
 593
 594 /*
 595  * The buffer should be at least as large as the max string size of the
 596  * largest float, printed in the biggest notation.  This is undoubtably
 597  * 20d float_output_format, with the negative of the C-constant "HUGE"
 598  * from <math.h>.
 599  *
 600  * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
 601  *
 602  * I assume that IEEE-754 format numbers can take 329 bytes for the worst
 603  * case of -1e307 in 20d float_output_format. What is one to do (short of
 604  * re-writing _doprnt to be more sane)?
 605  *                      -wsr
 606  */
 607
 608 void
 609 float_to_string (buf, data)
 610      unsigned char *buf;
 611      double data;
 612 {
 613   register unsigned char *cp, c;
 614   register int width;
 615
 616   if (NILP (Vfloat_output_format)
 617       || XTYPE (Vfloat_output_format) != Lisp_String)
 618   lose:
 619     sprintf (buf, "%.20g", data);
 620   else                  /* oink oink */
 621     {
 622       /* Check that the spec we have is fully valid.
 623          This means not only valid for printf,
 624          but meant for floats, and reasonable.  */
 625       cp = XSTRING (Vfloat_output_format)->data;
 626
 627       if (cp[0] != '%')
 628         goto lose;
 629       if (cp[1] != '.')
 630         goto lose;
 631
 632       cp += 2;
 633       for (width = 0;
 634            ((c = *cp) >= '0' && c <= '9');
 635            cp++)
 636         {
 637           width *= 10;
 638           width += c - '0';
 639         }
 640
 641       if (*cp != 'e' && *cp != 'f' && *cp != 'g')
 642         goto lose;
 643
 644       if (width < (*cp != 'e') || width > DBL_DIG)
 645         goto lose;
 646
 647       if (cp[1] != 0)
 648         goto lose;
 649
 650       sprintf (buf, XSTRING (Vfloat_output_format)->data, data);
 651     }
 652
 653   /* Make sure there is a decimal point with digit after, or an exponent,
 654      so that the value is readable as a float.  */
 655   for (cp = buf; *cp; cp++)
 656     if ((*cp < '0' || *cp > '9') && *cp != '-')
 657       break;
 658
 659   if (*cp == '.' && cp[1] == 0)
 660     {
 661       cp[1] = '0';
 662       cp[2] = 0;
 663     }
 664
 665   if (*cp == 0)
 666     {
 667       *cp++ = '.';
 668       *cp++ = '0';
 669       *cp++ = 0;
 670     }
 671 }
 672 #endif /* LISP_FLOAT_TYPE */
 673 \f
 674 static void
 675 print (obj, printcharfun, escapeflag)
 676      Lisp_Object obj;
 677      register Lisp_Object printcharfun;
 678      int escapeflag;
 679 {
 680   char buf[30];
 681
 682   QUIT;
 683
 684 #if 1  /* I'm not sure this is really worth doing.  */
 685   /* Detect circularities and truncate them.
 686      No need to offer any alternative--this is better than an error.  */
 687   if (XTYPE (obj) == Lisp_Cons || XTYPE (obj) == Lisp_Vector
 688       || XTYPE (obj) == Lisp_Compiled)
 689     {
 690       int i;
 691       for (i = 0; i < print_depth; i++)
 692         if (EQ (obj, being_printed[i]))
 693           {
 694             sprintf (buf, "#%d", i);
 695             strout (buf, -1, printcharfun);
 696             return;
 697           }
 698     }
 699 #endif
 700
 701   being_printed[print_depth] = obj;
 702   print_depth++;
 703
 704   if (print_depth > PRINT_CIRCLE)
 705     error ("Apparently circular structure being printed");
 706 #ifdef MAX_PRINT_CHARS
 707   if (max_print && print_chars > max_print)
 708     {
 709       PRINTCHAR ('\n');
 710       print_chars = 0;
 711     }
 712 #endif /* MAX_PRINT_CHARS */
 713
 714 #ifdef SWITCH_ENUM_BUG
 715   switch ((int) XTYPE (obj))
 716 #else
 717   switch (XTYPE (obj))
 718 #endif
 719     {
 720     default:
 721       /* We're in trouble if this happens!
 722          Probably should just abort () */
 723       strout ("#<EMACS BUG: INVALID DATATYPE ", -1, printcharfun);
 724       sprintf (buf, "(#o%3o)", (int) XTYPE (obj));
 725       strout (buf, -1, printcharfun);
 726       strout (" Save your buffers immediately and please report this bug>",
 727               -1, printcharfun);
 728       break;
 729
 730 #ifdef LISP_FLOAT_TYPE
 731     case Lisp_Float:
 732       {
 733         char pigbuf[350];       /* see comments in float_to_string */
 734
 735         float_to_string (pigbuf, XFLOAT(obj)->data);
 736         strout (pigbuf, -1, printcharfun);
 737       }
 738       break;
 739 #endif /* LISP_FLOAT_TYPE */
 740
 741     case Lisp_Int:
 742       sprintf (buf, "%d", XINT (obj));
 743       strout (buf, -1, printcharfun);
 744       break;
 745
 746     case Lisp_String:
 747       if (!escapeflag)
 748         print_string (obj, printcharfun);
 749       else
 750         {
 751           register int i;
 752           register unsigned char c;
 753           struct gcpro gcpro1;
 754
 755           GCPRO1 (obj);
 756
 757 #ifdef USE_TEXT_PROPERTIES
 758           if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
 759             {
 760               PRINTCHAR ('#');
 761               PRINTCHAR ('(');
 762             }
 763 #endif
 764
 765           PRINTCHAR ('\"');
 766           for (i = 0; i < XSTRING (obj)->size; i++)
 767             {
 768               QUIT;
 769               c = XSTRING (obj)->data[i];
 770               if (c == '\n' && print_escape_newlines)
 771                 {
 772                   PRINTCHAR ('\\');
 773                   PRINTCHAR ('n');
 774                 }
 775               else
 776                 {
 777                   if (c == '\"' || c == '\\')
 778                     PRINTCHAR ('\\');
 779                   PRINTCHAR (c);
 780                 }
 781             }
 782           PRINTCHAR ('\"');
 783
 784 #ifdef USE_TEXT_PROPERTIES
 785           if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
 786             {
 787               traverse_intervals (XSTRING (obj)->intervals,
 788                                   0, 0, print_interval, printcharfun);
 789               PRINTCHAR (')');
 790             }
 791 #endif
 792
 793           UNGCPRO;
 794         }
 795       break;
 796
 797     case Lisp_Symbol:
 798       {
 799         register int confusing;
 800         register unsigned char *p = XSYMBOL (obj)->name->data;
 801         register unsigned char *end = p + XSYMBOL (obj)->name->size;
 802         register unsigned char c;
 803
 804         if (p != end && (*p == '-' || *p == '+')) p++;
 805         if (p == end)
 806           confusing = 0;
 807         else
 808           {
 809             while (p != end && *p >= '0' && *p <= '9')
 810               p++;
 811             confusing = (end == p);
 812           }
 813
 814         p = XSYMBOL (obj)->name->data;
 815         while (p != end)
 816           {
 817             QUIT;
 818             c = *p++;
 819             if (escapeflag)
 820               {
 821                 if (c == '\"' || c == '\\' || c == '\'' || c == ';' || c == '#' ||
 822                     c == '(' || c == ')' || c == ',' || c =='.' || c == '`' ||
 823                     c == '[' || c == ']' || c == '?' || c <= 040 || confusing)
 824                   PRINTCHAR ('\\'), confusing = 0;
 825               }
 826             PRINTCHAR (c);
 827           }
 828       }
 829       break;
 830
 831     case Lisp_Cons:
 832       /* If deeper than spec'd depth, print placeholder.  */
 833       if (XTYPE (Vprint_level) == Lisp_Int
 834           && print_depth > XINT (Vprint_level))
 835         {
 836           strout ("...", -1, printcharfun);
 837           break;
 838         }
 839
 840       PRINTCHAR ('(');
 841       {
 842         register int i = 0;
 843         register int max = 0;
 844
 845         if (XTYPE (Vprint_length) == Lisp_Int)
 846           max = XINT (Vprint_length);
 847         /* Could recognize circularities in cdrs here,
 848            but that would make printing of long lists quadratic.
 849            It's not worth doing.  */
 850         while (CONSP (obj))
 851           {
 852             if (i++)
 853               PRINTCHAR (' ');
 854             if (max && i > max)
 855               {
 856                 strout ("...", 3, printcharfun);
 857                 break;
 858               }
 859             print (Fcar (obj), printcharfun, escapeflag);
 860             obj = Fcdr (obj);
 861           }
 862       }
 863       if (!NILP (obj) && !CONSP (obj))
 864         {
 865           strout (" . ", 3, printcharfun);
 866           print (obj, printcharfun, escapeflag);
 867         }
 868       PRINTCHAR (')');
 869       break;
 870
 871     case Lisp_Compiled:
 872       strout ("#", -1, printcharfun);
 873     case Lisp_Vector:
 874       PRINTCHAR ('[');
 875       {
 876         register int i;
 877         register Lisp_Object tem;
 878         for (i = 0; i < XVECTOR (obj)->size; i++)
 879           {
 880             if (i) PRINTCHAR (' ');
 881             tem = XVECTOR (obj)->contents[i];
 882             print (tem, printcharfun, escapeflag);
 883           }
 884       }
 885       PRINTCHAR (']');
 886       break;
 887
 888 #ifndef standalone
 889     case Lisp_Buffer:
 890       if (NILP (XBUFFER (obj)->name))
 891         strout ("#<killed buffer>", -1, printcharfun);
 892       else if (escapeflag)
 893         {
 894           strout ("#<buffer ", -1, printcharfun);
 895           print_string (XBUFFER (obj)->name, printcharfun);
 896           PRINTCHAR ('>');
 897         }
 898       else
 899         print_string (XBUFFER (obj)->name, printcharfun);
 900       break;
 901
 902     case Lisp_Process:
 903       if (escapeflag)
 904         {
 905           strout ("#<process ", -1, printcharfun);
 906           print_string (XPROCESS (obj)->name, printcharfun);
 907           PRINTCHAR ('>');
 908         }
 909       else
 910         print_string (XPROCESS (obj)->name, printcharfun);
 911       break;
 912
 913     case Lisp_Window:
 914       strout ("#<window ", -1, printcharfun);
 915       sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number));
 916       strout (buf, -1, printcharfun);
 917       if (!NILP (XWINDOW (obj)->buffer))
 918         {
 919           strout (" on ", -1, printcharfun);
 920           print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun);
 921         }
 922       PRINTCHAR ('>');
 923       break;
 924
 925     case Lisp_Window_Configuration:
 926       strout ("#<window-configuration>", -1, printcharfun);
 927       break;
 928
 929 #ifdef MULTI_FRAME
 930     case Lisp_Frame:
 931       strout ((FRAME_LIVE_P (XFRAME (obj))
 932                ? "#<frame " : "#<dead frame "),
 933               -1, printcharfun);
 934       print_string (XFRAME (obj)->name, printcharfun);
 935       sprintf (buf, " 0x%x", (unsigned int) (XFRAME (obj)));
 936       strout (buf, -1, printcharfun);
 937       strout (">", -1, printcharfun);
 938       break;
 939 #endif /* MULTI_FRAME */
 940
 941     case Lisp_Marker:
 942       strout ("#<marker ", -1, printcharfun);
 943       if (!(XMARKER (obj)->buffer))
 944         strout ("in no buffer", -1, printcharfun);
 945       else
 946         {
 947           sprintf (buf, "at %d", marker_position (obj));
 948           strout (buf, -1, printcharfun);
 949           strout (" in ", -1, printcharfun);
 950           print_string (XMARKER (obj)->buffer->name, printcharfun);
 951         }
 952       PRINTCHAR ('>');
 953       break;
 954
 955     case Lisp_Overlay:
 956       strout ("#<overlay ", -1, printcharfun);
 957       if (!(XMARKER (OVERLAY_START (obj))->buffer))
 958         strout ("in no buffer", -1, printcharfun);
 959       else
 960         {
 961           sprintf (buf, "from %d to %d in ",
 962                    marker_position (OVERLAY_START (obj)),
 963                    marker_position (OVERLAY_END   (obj)));
 964           strout (buf, -1, printcharfun);
 965           print_string (XMARKER (OVERLAY_START (obj))->buffer->name,
 966                         printcharfun);
 967         }
 968       PRINTCHAR ('>');
 969       break;
 970
 971 #endif /* standalone */
 972
 973     case Lisp_Subr:
 974       strout ("#<subr ", -1, printcharfun);
 975       strout (XSUBR (obj)->symbol_name, -1, printcharfun);
 976       PRINTCHAR ('>');
 977       break;
 978     }
 979
 980   print_depth--;
 981 }
 982 \f
 983 #ifdef USE_TEXT_PROPERTIES
 984
 985 /* Print a description of INTERVAL using PRINTCHARFUN.
 986    This is part of printing a string that has text properties.  */
 987
 988 void
 989 print_interval (interval, printcharfun)
 990      INTERVAL interval;
 991      Lisp_Object printcharfun;
 992 {
 993   PRINTCHAR (' ');
 994   print (make_number (interval->position), printcharfun, 1);
 995   PRINTCHAR (' ');
 996   print (make_number (interval->position + LENGTH (interval)),
 997          printcharfun, 1);
 998   PRINTCHAR (' ');
 999   print (interval->plist, printcharfun, 1);
1000 }
1001
1002 #endif /* USE_TEXT_PROPERTIES */
1003 \f
1004 void
1005 syms_of_print ()
1006 {
1007   staticpro (&Qprint_escape_newlines);
1008   Qprint_escape_newlines = intern ("print-escape-newlines");
1009
1010   DEFVAR_LISP ("standard-output", &Vstandard_output,
1011     "Output stream `print' uses by default for outputting a character.\n\
1012 This may be any function of one argument.\n\
1013 It may also be a buffer (output is inserted before point)\n\
1014 or a marker (output is inserted and the marker is advanced)\n\
1015 or the symbol t (output appears in the minibuffer line).");
1016   Vstandard_output = Qt;
1017   Qstandard_output = intern ("standard-output");
1018   staticpro (&Qstandard_output);
1019
1020 #ifdef LISP_FLOAT_TYPE
1021   DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
1022     "The format descriptor string used to print floats.\n\
1023 This is a %-spec like those accepted by `printf' in C,\n\
1024 but with some restrictions.  It must start with the two characters `%.'.\n\
1025 After that comes an integer precision specification,\n\
1026 and then a letter which controls the format.\n\
1027 The letters allowed are `e', `f' and `g'.\n\
1028 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1029 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1030 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1031 The precision in any of these cases is the number of digits following\n\
1032 the decimal point.  With `f', a precision of 0 means to omit the\n\
1033 decimal point.  0 is not allowed with `f' or `g'.\n\n\
1034 A value of nil means to use `%.20g'.");
1035   Vfloat_output_format = Qnil;
1036   Qfloat_output_format = intern ("float-output-format");
1037   staticpro (&Qfloat_output_format);
1038 #endif /* LISP_FLOAT_TYPE */
1039
1040   DEFVAR_LISP ("print-length", &Vprint_length,
1041     "Maximum length of list to print before abbreviating.\n\
1042 A value of nil means no limit.");
1043   Vprint_length = Qnil;
1044
1045   DEFVAR_LISP ("print-level", &Vprint_level,
1046     "Maximum depth of list nesting to print before abbreviating.\n\
1047 A value of nil means no limit.");
1048   Vprint_level = Qnil;
1049
1050   DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
1051     "Non-nil means print newlines in strings as backslash-n.");
1052   print_escape_newlines = 0;
1053
1054   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1055   staticpro (&Vprin1_to_string_buffer);
1056
1057   defsubr (&Sprin1);
1058   defsubr (&Sprin1_to_string);
1059   defsubr (&Sprinc);
1060   defsubr (&Sprint);
1061   defsubr (&Sterpri);
1062   defsubr (&Swrite_char);
1063   defsubr (&Sexternal_debugging_output);
1064
1065   Qexternal_debugging_output = intern ("external-debugging-output");
1066   staticpro (&Qexternal_debugging_output);
1067
1068 #ifndef standalone
1069   defsubr (&Swith_output_to_temp_buffer);
1070 #endif /* not standalone */
1071 }