src/print.c

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