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 "screen.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 SCREEN_MESSAGE_BUF(selected_screen). */
 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 != SCREEN_MESSAGE_BUF (selected_screen)
 194           || !message_buf_print)
 195         {
 196           echo_area_glyphs = SCREEN_MESSAGE_BUF (selected_screen);
 197           printbufidx = 0;
 198           message_buf_print = 1;
 199         }
 200
 201       if (printbufidx < SCREEN_WIDTH (selected_screen) - 1)
 202         SCREEN_MESSAGE_BUF (selected_screen)[printbufidx++] = ch;
 203       SCREEN_MESSAGE_BUF (selected_screen)[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 != SCREEN_MESSAGE_BUF (selected_screen)
 246           || !message_buf_print)
 247         {
 248           echo_area_glyphs = SCREEN_MESSAGE_BUF (selected_screen);
 249           printbufidx = 0;
 250           message_buf_print = 1;
 251         }
 252
 253       if (i > SCREEN_WIDTH (selected_screen) - printbufidx - 1)
 254         i = SCREEN_WIDTH (selected_screen) - printbufidx - 1;
 255       bcopy (ptr, &SCREEN_MESSAGE_BUF (selected_screen) [printbufidx], i);
 256       printbufidx += i;
 257       SCREEN_MESSAGE_BUF (selected_screen) [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 screen.  */
 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 void
 585 float_to_string (buf, data)
 586      char *buf;
 587 /*
 588  * This buffer should be at least as large as the max string size of the
 589  * largest float, printed in the biggest notation.  This is undoubtably
 590  * 20d float_output_format, with the negative of the C-constant "HUGE"
 591  * from <math.h>.
 592  *
 593  * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
 594  *
 595  * I assume that IEEE-754 format numbers can take 329 bytes for the worst
 596  * case of -1e307 in 20d float_output_format. What is one to do (short of
 597  * re-writing _doprnt to be more sane)?
 598  *                      -wsr
 599  */
 600      double data;
 601 {
 602   register unsigned char *cp, c;
 603   register int width;
 604
 605   if (NILP (Vfloat_output_format)
 606       || XTYPE (Vfloat_output_format) != Lisp_String)
 607   lose:
 608     sprintf (buf, "%.20g", data);
 609   else                  /* oink oink */
 610     {
 611       /* Check that the spec we have is fully valid.
 612          This means not only valid for printf,
 613          but meant for floats, and reasonable.  */
 614       cp = XSTRING (Vfloat_output_format)->data;
 615
 616       if (cp[0] != '%')
 617         goto lose;
 618       if (cp[1] != '.')
 619         goto lose;
 620
 621       cp += 2;
 622       for (width = 0;
 623            ((c = *cp) >= '0' && c <= '9');
 624            cp++)
 625         {
 626           width *= 10;
 627           width += c - '0';
 628         }
 629
 630       if (*cp != 'e' && *cp != 'f' && *cp != 'g')
 631         goto lose;
 632
 633       if (width < (*cp != 'e') || width > DBL_DIG)
 634         goto lose;
 635
 636       if (cp[1] != 0)
 637         goto lose;
 638
 639       sprintf (buf, XSTRING (Vfloat_output_format)->data, data);
 640     }
 641 }
 642 #endif /* LISP_FLOAT_TYPE */
 643 \f
 644 static void
 645 print (obj, printcharfun, escapeflag)
 646 #ifndef RTPC_REGISTER_BUG
 647      register Lisp_Object obj;
 648 #else
 649      Lisp_Object obj;
 650 #endif
 651      register Lisp_Object printcharfun;
 652      int escapeflag;
 653 {
 654   char buf[30];
 655
 656   QUIT;
 657
 658 #if 1  /* I'm not sure this is really worth doing.  */
 659   /* Detect circularities and truncate them.
 660      No need to offer any alternative--this is better than an error.  */
 661   if (XTYPE (obj) == Lisp_Cons || XTYPE (obj) == Lisp_Vector
 662       || XTYPE (obj) == Lisp_Compiled)
 663     {
 664       int i;
 665       for (i = 0; i < print_depth; i++)
 666         if (EQ (obj, being_printed[i]))
 667           {
 668             sprintf (buf, "#%d", i);
 669             strout (buf, -1, printcharfun);
 670             return;
 671           }
 672     }
 673 #endif
 674
 675   being_printed[print_depth] = obj;
 676   print_depth++;
 677
 678   if (print_depth > PRINT_CIRCLE)
 679     error ("Apparently circular structure being printed");
 680 #ifdef MAX_PRINT_CHARS
 681   if (max_print && print_chars > max_print)
 682     {
 683       PRINTCHAR ('\n');
 684       print_chars = 0;
 685     }
 686 #endif /* MAX_PRINT_CHARS */
 687
 688 #ifdef SWITCH_ENUM_BUG
 689   switch ((int) XTYPE (obj))
 690 #else
 691   switch (XTYPE (obj))
 692 #endif
 693     {
 694     default:
 695       /* We're in trouble if this happens!
 696          Probably should just abort () */
 697       strout ("#<EMACS BUG: INVALID DATATYPE ", -1, printcharfun);
 698       sprintf (buf, "(#o%3o)", (int) XTYPE (obj));
 699       strout (buf, -1, printcharfun);
 700       strout (" Save your buffers immediately and please report this bug>",
 701               -1, printcharfun);
 702       break;
 703
 704 #ifdef LISP_FLOAT_TYPE
 705     case Lisp_Float:
 706       {
 707         char pigbuf[350];       /* see comments in float_to_string */
 708
 709         float_to_string (pigbuf, XFLOAT(obj)->data);
 710         strout (pigbuf, -1, printcharfun);
 711       }
 712       break;
 713 #endif /* LISP_FLOAT_TYPE */
 714
 715     case Lisp_Int:
 716       sprintf (buf, "%d", XINT (obj));
 717       strout (buf, -1, printcharfun);
 718       break;
 719
 720     case Lisp_String:
 721       if (!escapeflag)
 722         print_string (obj, printcharfun);
 723       else
 724         {
 725           register int i;
 726           register unsigned char c;
 727           Lisp_Object obj1;
 728           struct gcpro gcpro1;
 729
 730           /* You can't gcpro register variables, so copy obj to a
 731              non-register variable so we can gcpro it without
 732              making it non-register.  */
 733           obj1 = obj;
 734           GCPRO1 (obj1);
 735
 736           PRINTCHAR ('\"');
 737           for (i = 0; i < XSTRING (obj)->size; i++)
 738             {
 739               QUIT;
 740               c = XSTRING (obj)->data[i];
 741               if (c == '\n' && print_escape_newlines)
 742                 {
 743                   PRINTCHAR ('\\');
 744                   PRINTCHAR ('n');
 745                 }
 746               else
 747                 {
 748                   if (c == '\"' || c == '\\')
 749                     PRINTCHAR ('\\');
 750                   PRINTCHAR (c);
 751                 }
 752             }
 753           PRINTCHAR ('\"');
 754           UNGCPRO;
 755         }
 756       break;
 757
 758     case Lisp_Symbol:
 759       {
 760         register int confusing;
 761         register unsigned char *p = XSYMBOL (obj)->name->data;
 762         register unsigned char *end = p + XSYMBOL (obj)->name->size;
 763         register unsigned char c;
 764
 765         if (p != end && (*p == '-' || *p == '+')) p++;
 766         if (p == end)
 767           confusing = 0;
 768         else
 769           {
 770             while (p != end && *p >= '0' && *p <= '9')
 771               p++;
 772             confusing = (end == p);
 773           }
 774
 775         p = XSYMBOL (obj)->name->data;
 776         while (p != end)
 777           {
 778             QUIT;
 779             c = *p++;
 780             if (escapeflag)
 781               {
 782                 if (c == '\"' || c == '\\' || c == '\'' || c == ';' || c == '#' ||
 783                     c == '(' || c == ')' || c == ',' || c =='.' || c == '`' ||
 784                     c == '[' || c == ']' || c == '?' || c <= 040 || confusing)
 785                   PRINTCHAR ('\\'), confusing = 0;
 786               }
 787             PRINTCHAR (c);
 788           }
 789       }
 790       break;
 791
 792     case Lisp_Cons:
 793       /* If deeper than spec'd depth, print placeholder.  */
 794       if (XTYPE (Vprint_level) == Lisp_Int
 795           && print_depth > XINT (Vprint_level))
 796         {
 797           strout ("...", -1, printcharfun);
 798           break;
 799         }
 800
 801       PRINTCHAR ('(');
 802       {
 803         register int i = 0;
 804         register int max = 0;
 805
 806         if (XTYPE (Vprint_length) == Lisp_Int)
 807           max = XINT (Vprint_length);
 808         /* Could recognize circularities in cdrs here,
 809            but that would make printing of long lists quadratic.
 810            It's not worth doing.  */
 811         while (CONSP (obj))
 812           {
 813             if (i++)
 814               PRINTCHAR (' ');
 815             if (max && i > max)
 816               {
 817                 strout ("...", 3, printcharfun);
 818                 break;
 819               }
 820             print (Fcar (obj), printcharfun, escapeflag);
 821             obj = Fcdr (obj);
 822           }
 823       }
 824       if (!NILP (obj) && !CONSP (obj))
 825         {
 826           strout (" . ", 3, printcharfun);
 827           print (obj, printcharfun, escapeflag);
 828         }
 829       PRINTCHAR (')');
 830       break;
 831
 832     case Lisp_Compiled:
 833       strout ("#", -1, printcharfun);
 834     case Lisp_Vector:
 835       PRINTCHAR ('[');
 836       {
 837         register int i;
 838         register Lisp_Object tem;
 839         for (i = 0; i < XVECTOR (obj)->size; i++)
 840           {
 841             if (i) PRINTCHAR (' ');
 842             tem = XVECTOR (obj)->contents[i];
 843             print (tem, printcharfun, escapeflag);
 844           }
 845       }
 846       PRINTCHAR (']');
 847       break;
 848
 849 #ifndef standalone
 850     case Lisp_Buffer:
 851       if (NILP (XBUFFER (obj)->name))
 852         strout ("#<killed buffer>", -1, printcharfun);
 853       else if (escapeflag)
 854         {
 855           strout ("#<buffer ", -1, printcharfun);
 856           print_string (XBUFFER (obj)->name, printcharfun);
 857           PRINTCHAR ('>');
 858         }
 859       else
 860         print_string (XBUFFER (obj)->name, printcharfun);
 861       break;
 862
 863     case Lisp_Process:
 864       if (escapeflag)
 865         {
 866           strout ("#<process ", -1, printcharfun);
 867           print_string (XPROCESS (obj)->name, printcharfun);
 868           PRINTCHAR ('>');
 869         }
 870       else
 871         print_string (XPROCESS (obj)->name, printcharfun);
 872       break;
 873
 874     case Lisp_Window:
 875       strout ("#<window ", -1, printcharfun);
 876       sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number));
 877       strout (buf, -1, printcharfun);
 878       if (!NILP (XWINDOW (obj)->buffer))
 879         {
 880           strout (" on ", -1, printcharfun);
 881           print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun);
 882         }
 883       PRINTCHAR ('>');
 884       break;
 885
 886     case Lisp_Window_Configuration:
 887       strout ("#<window-configuration>", -1, printcharfun);
 888       break;
 889
 890 #ifdef MULTI_SCREEN
 891     case Lisp_Screen:
 892       strout (((XSCREEN (obj)->display.nothing == 0)
 893                ? "#<dead screen " : "#<screen "),
 894               -1, printcharfun);
 895       print_string (XSCREEN (obj)->name, printcharfun);
 896       sprintf (buf, " 0x%x", XFASTINT (XSCREEN (obj)));
 897       strout (buf, -1, printcharfun);
 898       strout (">", -1, printcharfun);
 899       break;
 900 #endif /* MULTI_SCREEN */
 901
 902     case Lisp_Marker:
 903       strout ("#<marker ", -1, printcharfun);
 904       if (!(XMARKER (obj)->buffer))
 905         strout ("in no buffer", -1, printcharfun);
 906       else
 907         {
 908           sprintf (buf, "at %d", marker_position (obj));
 909           strout (buf, -1, printcharfun);
 910           strout (" in ", -1, printcharfun);
 911           print_string (XMARKER (obj)->buffer->name, printcharfun);
 912         }
 913       PRINTCHAR ('>');
 914       break;
 915 #endif /* standalone */
 916
 917     case Lisp_Subr:
 918       strout ("#<subr ", -1, printcharfun);
 919       strout (XSUBR (obj)->symbol_name, -1, printcharfun);
 920       PRINTCHAR ('>');
 921       break;
 922     }
 923
 924   print_depth--;
 925 }
 926 \f
 927 void
 928 syms_of_print ()
 929 {
 930   staticpro (&Qprint_escape_newlines);
 931   Qprint_escape_newlines = intern ("print-escape-newlines");
 932
 933   DEFVAR_LISP ("standard-output", &Vstandard_output,
 934     "Output stream `print' uses by default for outputting a character.\n\
 935 This may be any function of one argument.\n\
 936 It may also be a buffer (output is inserted before point)\n\
 937 or a marker (output is inserted and the marker is advanced)\n\
 938 or the symbol t (output appears in the minibuffer line).");
 939   Vstandard_output = Qt;
 940   Qstandard_output = intern ("standard-output");
 941   staticpro (&Qstandard_output);
 942
 943 #ifdef LISP_FLOAT_TYPE
 944   DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
 945     "The format descriptor string used to print floats.\n\
 946 This is a %-spec like those accepted by `printf' in C,\n\
 947 but with some restrictions.  It must start with the two characters `%.'.\n\
 948 After that comes an integer precision specification,\n\
 949 and then a letter which controls the format.\n\
 950 The letters allowed are `e', `f' and `g'.\n\
 951 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
 952 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
 953 Use `g' to choose the shorter of those two formats for the number at hand.\n\
 954 The precision in any of these cases is the number of digits following\n\
 955 the decimal point.  With `f', a precision of 0 means to omit the\n\
 956 decimal point.  0 is not allowed with `f' or `g'.\n\n\
 957 A value of nil means to use `%.20g'.");
 958   Vfloat_output_format = Qnil;
 959   Qfloat_output_format = intern ("float-output-format");
 960   staticpro (&Qfloat_output_format);
 961 #endif /* LISP_FLOAT_TYPE */
 962
 963   DEFVAR_LISP ("print-length", &Vprint_length,
 964     "Maximum length of list to print before abbreviating.\n\
 965 A value of nil means no limit.");
 966   Vprint_length = Qnil;
 967
 968   DEFVAR_LISP ("print-level", &Vprint_level,
 969     "Maximum depth of list nesting to print before abbreviating.\n\
 970 A value of nil means no limit.");
 971   Vprint_level = Qnil;
 972
 973   DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
 974     "Non-nil means print newlines in strings as backslash-n.");
 975   print_escape_newlines = 0;
 976
 977   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
 978   staticpro (&Vprin1_to_string_buffer);
 979
 980   defsubr (&Sprin1);
 981   defsubr (&Sprin1_to_string);
 982   defsubr (&Sprinc);
 983   defsubr (&Sprint);
 984   defsubr (&Sterpri);
 985   defsubr (&Swrite_char);
 986   defsubr (&Sexternal_debugging_output);
 987
 988   Qexternal_debugging_output = intern ("external-debugging-output");
 989   staticpro (&Qexternal_debugging_output);
 990
 991 #ifndef standalone
 992   defsubr (&Swith_output_to_temp_buffer);
 993 #endif /* not standalone */
 994 }