src/print.c

   1 /* Lisp object printing and output streams.
   2    Copyright (C) 1985, 86, 88, 93, 94, 95 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, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21
  22 #include <config.h>
  23 #include <stdio.h>
  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 #include "keyboard.h"
  34 #endif /* not standalone */
  35
  36 #ifdef USE_TEXT_PROPERTIES
  37 #include "intervals.h"
  38 #endif
  39
  40 Lisp_Object Vstandard_output, Qstandard_output;
  41
  42 /* These are used to print like we read.  */
  43 extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
  44
  45 #ifdef LISP_FLOAT_TYPE
  46 Lisp_Object Vfloat_output_format, Qfloat_output_format;
  47 #endif /* LISP_FLOAT_TYPE */
  48
  49 /* Avoid actual stack overflow in print.  */
  50 int print_depth;
  51
  52 /* Detect most circularities to print finite output.  */
  53 #define PRINT_CIRCLE 200
  54 Lisp_Object being_printed[PRINT_CIRCLE];
  55
  56 /* When printing into a buffer, first we put the text in this
  57    block, then insert it all at once.  */
  58 char *print_buffer;
  59
  60 /* Size allocated in print_buffer.  */
  61 int print_buffer_size;
  62 /* Size used in print_buffer.  */
  63 int print_buffer_pos;
  64
  65 /* Maximum length of list to print in full; noninteger means
  66    effectively infinity */
  67
  68 Lisp_Object Vprint_length;
  69
  70 /* Maximum depth of list to print in full; noninteger means
  71    effectively infinity.  */
  72
  73 Lisp_Object Vprint_level;
  74
  75 /* Nonzero means print newlines in strings as \n.  */
  76
  77 int print_escape_newlines;
  78
  79 Lisp_Object Qprint_escape_newlines;
  80
  81 /* Nonzero means print (quote foo) forms as 'foo, etc.  */
  82
  83 int print_quoted;
  84
  85 /* Nonzero means print #: before uninterned symbols.  */
  86
  87 int print_gensym;
  88
  89 /* Association list of certain objects that are `eq' in the form being
  90    printed and which should be `eq' when read back in, using the #n=object
  91    and #n# reader forms.  Each element has the form (object . n).  */
  92
  93 Lisp_Object printed_gensyms;
  94
  95 /* Nonzero means print newline to stdout before next minibuffer message.
  96    Defined in xdisp.c */
  97
  98 extern int noninteractive_need_newline;
  99
 100 #ifdef MAX_PRINT_CHARS
 101 static int print_chars;
 102 static int max_print;
 103 #endif /* MAX_PRINT_CHARS */
 104
 105 void print_interval ();
 106 \f
 107 #if 0
 108 /* Convert between chars and GLYPHs */
 109
 110 int
 111 glyphlen (glyphs)
 112      register GLYPH *glyphs;
 113 {
 114   register int i = 0;
 115
 116   while (glyphs[i])
 117     i++;
 118   return i;
 119 }
 120
 121 void
 122 str_to_glyph_cpy (str, glyphs)
 123      char *str;
 124      GLYPH *glyphs;
 125 {
 126   register GLYPH *gp = glyphs;
 127   register char *cp = str;
 128
 129   while (*cp)
 130     *gp++ = *cp++;
 131 }
 132
 133 void
 134 str_to_glyph_ncpy (str, glyphs, n)
 135      char *str;
 136      GLYPH *glyphs;
 137      register int n;
 138 {
 139   register GLYPH *gp = glyphs;
 140   register char *cp = str;
 141
 142   while (n-- > 0)
 143     *gp++ = *cp++;
 144 }
 145
 146 void
 147 glyph_to_str_cpy (glyphs, str)
 148      GLYPH *glyphs;
 149      char *str;
 150 {
 151   register GLYPH *gp = glyphs;
 152   register char *cp = str;
 153
 154   while (*gp)
 155     *str++ = *gp++ & 0377;
 156 }
 157 #endif
 158 \f
 159 /* Low level output routines for characters and strings */
 160
 161 /* Lisp functions to do output using a stream
 162    must have the stream in a variable called printcharfun
 163    and must start with PRINTPREPARE, end with PRINTFINISH,
 164    and use PRINTDECLARE to declare common variables.
 165    Use PRINTCHAR to output one character,
 166    or call strout to output a block of characters.
 167 */
 168
 169 #define PRINTDECLARE                                            \
 170    struct buffer *old = current_buffer;                         \
 171    int old_point = -1, start_point;                             \
 172    int specpdl_count = specpdl_ptr - specpdl;                   \
 173    int free_print_buffer = 0;                                   \
 174    Lisp_Object original
 175
 176 #define PRINTPREPARE                                            \
 177    original = printcharfun;                                     \
 178    if (NILP (printcharfun)) printcharfun = Qt;                  \
 179    if (BUFFERP (printcharfun))                                  \
 180      {                                                          \
 181        if (XBUFFER (printcharfun) != current_buffer)            \
 182          Fset_buffer (printcharfun);                            \
 183        printcharfun = Qnil;                                     \
 184      }                                                          \
 185    if (MARKERP (printcharfun))                                  \
 186      {                                                          \
 187        if (!(XMARKER (original)->buffer))                       \
 188          error ("Marker does not point anywhere");              \
 189        if (XMARKER (original)->buffer != current_buffer)        \
 190          set_buffer_internal (XMARKER (original)->buffer);      \
 191        old_point = PT;                                          \
 192        SET_PT (marker_position (printcharfun));                 \
 193        start_point = PT;                                        \
 194        printcharfun = Qnil;                                     \
 195      }                                                          \
 196    if (NILP (printcharfun))                                     \
 197      {                                                          \
 198        if (print_buffer != 0)                                   \
 199          record_unwind_protect (print_unwind,                   \
 200                                 make_string (print_buffer,      \
 201                                              print_buffer_pos)); \
 202        else                                                     \
 203          {                                                      \
 204            print_buffer_size = 1000;                            \
 205            print_buffer = (char *) xmalloc (print_buffer_size); \
 206            free_print_buffer = 1;                               \
 207          }                                                      \
 208        print_buffer_pos = 0;                                    \
 209      }                                                          \
 210    printed_gensyms = Qnil
 211
 212 #define PRINTFINISH                                     \
 213    if (NILP (printcharfun))                             \
 214      insert (print_buffer, print_buffer_pos);           \
 215    if (free_print_buffer)                               \
 216      {                                                  \
 217        xfree (print_buffer);                            \
 218        print_buffer = 0;                                \
 219      }                                                  \
 220    unbind_to (specpdl_count, Qnil);                     \
 221    if (MARKERP (original))                              \
 222      Fset_marker (original, make_number (PT), Qnil);    \
 223    if (old_point >= 0)                                  \
 224      SET_PT (old_point + (old_point >= start_point      \
 225                           ? PT - start_point : 0));     \
 226    if (old != current_buffer)                           \
 227      set_buffer_internal (old);                         \
 228    printed_gensyms = Qnil
 229
 230 #define PRINTCHAR(ch) printchar (ch, printcharfun)
 231
 232 /* Nonzero if there is no room to print any more characters
 233    so print might as well return right away.  */
 234
 235 #define PRINTFULLP()                                    \
 236  (EQ (printcharfun, Qt) && !noninteractive              \
 237   && printbufidx >= FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)))))
 238
 239 /* This is used to restore the saved contents of print_buffer
 240    when there is a recursive call to print.  */
 241 static Lisp_Object
 242 print_unwind (saved_text)
 243      Lisp_Object saved_text;
 244 {
 245   bcopy (XSTRING (saved_text)->data, print_buffer, XSTRING (saved_text)->size);
 246 }
 247
 248 /* Index of first unused element of FRAME_MESSAGE_BUF (mini_frame). */
 249 static int printbufidx;
 250
 251 static void
 252 printchar (ch, fun)
 253      unsigned char ch;
 254      Lisp_Object fun;
 255 {
 256   Lisp_Object ch1;
 257
 258 #ifdef MAX_PRINT_CHARS
 259   if (max_print)
 260     print_chars++;
 261 #endif /* MAX_PRINT_CHARS */
 262 #ifndef standalone
 263   if (EQ (fun, Qnil))
 264     {
 265       QUIT;
 266       if (print_buffer_pos == print_buffer_size)
 267         print_buffer = (char *) xrealloc (print_buffer,
 268                                           print_buffer_size *= 2);
 269       print_buffer[print_buffer_pos++] = ch;
 270       return;
 271     }
 272
 273   if (EQ (fun, Qt))
 274     {
 275       FRAME_PTR mini_frame
 276         = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)));
 277
 278       QUIT;
 279
 280       if (noninteractive)
 281         {
 282           putchar (ch);
 283           noninteractive_need_newline = 1;
 284           return;
 285         }
 286
 287       if (echo_area_glyphs != FRAME_MESSAGE_BUF (mini_frame)
 288           || !message_buf_print)
 289         {
 290           message_log_maybe_newline ();
 291           echo_area_glyphs = FRAME_MESSAGE_BUF (mini_frame);
 292           printbufidx = 0;
 293           echo_area_glyphs_length = 0;
 294           message_buf_print = 1;
 295         }
 296
 297       message_dolog (&ch, 1, 0);
 298       if (printbufidx < FRAME_WIDTH (mini_frame) - 1)
 299         FRAME_MESSAGE_BUF (mini_frame)[printbufidx++] = ch;
 300       FRAME_MESSAGE_BUF (mini_frame)[printbufidx] = 0;
 301       echo_area_glyphs_length = printbufidx;
 302
 303       return;
 304     }
 305 #endif /* not standalone */
 306
 307   XSETFASTINT (ch1, ch);
 308   call1 (fun, ch1);
 309 }
 310
 311 static void
 312 strout (ptr, size, printcharfun)
 313      char *ptr;
 314      int size;
 315      Lisp_Object printcharfun;
 316 {
 317   int i = 0;
 318
 319   if (EQ (printcharfun, Qnil))
 320     {
 321       if (size < 0)
 322         size = strlen (ptr);
 323
 324       if (print_buffer_pos + size > print_buffer_size)
 325         {
 326           print_buffer_size = print_buffer_size * 2 + size;
 327           print_buffer = (char *) xrealloc (print_buffer,
 328                                             print_buffer_size);
 329         }
 330       bcopy (ptr, print_buffer + print_buffer_pos, size);
 331       print_buffer_pos += size;
 332
 333 #ifdef MAX_PRINT_CHARS
 334       if (max_print)
 335         print_chars += size;
 336 #endif /* MAX_PRINT_CHARS */
 337       return;
 338     }
 339   if (EQ (printcharfun, Qt))
 340     {
 341       FRAME_PTR mini_frame
 342         = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)));
 343
 344       QUIT;
 345
 346       i = size >= 0 ? size : strlen (ptr);
 347 #ifdef MAX_PRINT_CHARS
 348       if (max_print)
 349         print_chars += i;
 350 #endif /* MAX_PRINT_CHARS */
 351
 352       if (noninteractive)
 353         {
 354           fwrite (ptr, 1, i, stdout);
 355           noninteractive_need_newline = 1;
 356           return;
 357         }
 358
 359       if (echo_area_glyphs != FRAME_MESSAGE_BUF (mini_frame)
 360           || !message_buf_print)
 361         {
 362           message_log_maybe_newline ();
 363           echo_area_glyphs = FRAME_MESSAGE_BUF (mini_frame);
 364           printbufidx = 0;
 365           echo_area_glyphs_length = 0;
 366           message_buf_print = 1;
 367         }
 368
 369       message_dolog (ptr, i, 0);
 370       if (i > FRAME_WIDTH (mini_frame) - printbufidx - 1)
 371         i = FRAME_WIDTH (mini_frame) - printbufidx - 1;
 372       bcopy (ptr, &FRAME_MESSAGE_BUF (mini_frame) [printbufidx], i);
 373       printbufidx += i;
 374       echo_area_glyphs_length = printbufidx;
 375       FRAME_MESSAGE_BUF (mini_frame) [printbufidx] = 0;
 376
 377       return;
 378     }
 379
 380   if (size >= 0)
 381     while (i < size)
 382       PRINTCHAR (ptr[i++]);
 383   else
 384     while (ptr[i])
 385       PRINTCHAR (ptr[i++]);
 386 }
 387
 388 /* Print the contents of a string STRING using PRINTCHARFUN.
 389    It isn't safe to use strout in many cases,
 390    because printing one char can relocate.  */
 391
 392 print_string (string, printcharfun)
 393      Lisp_Object string;
 394      Lisp_Object printcharfun;
 395 {
 396   if (EQ (printcharfun, Qt) || NILP (printcharfun))
 397     /* strout is safe for output to a frame (echo area) or to print_buffer.  */
 398     strout (XSTRING (string)->data, XSTRING (string)->size, printcharfun);
 399   else
 400     {
 401       /* Otherwise, fetch the string address for each character.  */
 402       int i;
 403       int size = XSTRING (string)->size;
 404       struct gcpro gcpro1;
 405       GCPRO1 (string);
 406       for (i = 0; i < size; i++)
 407         PRINTCHAR (XSTRING (string)->data[i]);
 408       UNGCPRO;
 409     }
 410 }
 411 \f
 412 DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
 413   "Output character CHARACTER to stream PRINTCHARFUN.\n\
 414 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
 415   (character, printcharfun)
 416      Lisp_Object character, printcharfun;
 417 {
 418   PRINTDECLARE;
 419
 420   if (NILP (printcharfun))
 421     printcharfun = Vstandard_output;
 422   CHECK_NUMBER (character, 0);
 423   PRINTPREPARE;
 424   PRINTCHAR (XINT (character));
 425   PRINTFINISH;
 426   return character;
 427 }
 428
 429 /* Used from outside of print.c to print a block of SIZE chars at DATA
 430    on the default output stream.
 431    Do not use this on the contents of a Lisp string.  */
 432
 433 write_string (data, size)
 434      char *data;
 435      int size;
 436 {
 437   PRINTDECLARE;
 438   Lisp_Object printcharfun;
 439
 440   printcharfun = Vstandard_output;
 441
 442   PRINTPREPARE;
 443   strout (data, size, printcharfun);
 444   PRINTFINISH;
 445 }
 446
 447 /* Used from outside of print.c to print a block of SIZE chars at DATA
 448    on a specified stream PRINTCHARFUN.
 449    Do not use this on the contents of a Lisp string.  */
 450
 451 write_string_1 (data, size, printcharfun)
 452      char *data;
 453      int size;
 454      Lisp_Object printcharfun;
 455 {
 456   PRINTDECLARE;
 457
 458   PRINTPREPARE;
 459   strout (data, size, printcharfun);
 460   PRINTFINISH;
 461 }
 462
 463
 464 #ifndef standalone
 465
 466 void
 467 temp_output_buffer_setup (bufname)
 468     char *bufname;
 469 {
 470   register struct buffer *old = current_buffer;
 471   register Lisp_Object buf;
 472
 473   Fset_buffer (Fget_buffer_create (build_string (bufname)));
 474
 475   current_buffer->directory = old->directory;
 476   current_buffer->read_only = Qnil;
 477   Ferase_buffer ();
 478
 479   XSETBUFFER (buf, current_buffer);
 480   specbind (Qstandard_output, buf);
 481
 482   set_buffer_internal (old);
 483 }
 484
 485 Lisp_Object
 486 internal_with_output_to_temp_buffer (bufname, function, args)
 487      char *bufname;
 488      Lisp_Object (*function) ();
 489      Lisp_Object args;
 490 {
 491   int count = specpdl_ptr - specpdl;
 492   Lisp_Object buf, val;
 493   struct gcpro gcpro1;
 494
 495   GCPRO1 (args);
 496   record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
 497   temp_output_buffer_setup (bufname);
 498   buf = Vstandard_output;
 499   UNGCPRO;
 500
 501   val = (*function) (args);
 502
 503   GCPRO1 (val);
 504   temp_output_buffer_show (buf);
 505   UNGCPRO;
 506
 507   return unbind_to (count, val);
 508 }
 509
 510 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
 511        1, UNEVALLED, 0,
 512   "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
 513 The buffer is cleared out initially, and marked as unmodified when done.\n\
 514 All output done by BODY is inserted in that buffer by default.\n\
 515 The buffer is displayed in another window, but not selected.\n\
 516 The value of the last form in BODY is returned.\n\
 517 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
 518 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
 519 to get the buffer displayed.  It gets one argument, the buffer to display.")
 520   (args)
 521      Lisp_Object args;
 522 {
 523   struct gcpro gcpro1;
 524   Lisp_Object name;
 525   int count = specpdl_ptr - specpdl;
 526   Lisp_Object buf, val;
 527
 528   GCPRO1(args);
 529   name = Feval (Fcar (args));
 530   UNGCPRO;
 531
 532   CHECK_STRING (name, 0);
 533   temp_output_buffer_setup (XSTRING (name)->data);
 534   buf = Vstandard_output;
 535
 536   val = Fprogn (Fcdr (args));
 537
 538   temp_output_buffer_show (buf);
 539
 540   return unbind_to (count, val);
 541 }
 542 #endif /* not standalone */
 543 \f
 544 static void print ();
 545
 546 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
 547   "Output a newline to stream PRINTCHARFUN.\n\
 548 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
 549   (printcharfun)
 550      Lisp_Object printcharfun;
 551 {
 552   PRINTDECLARE;
 553
 554   if (NILP (printcharfun))
 555     printcharfun = Vstandard_output;
 556   PRINTPREPARE;
 557   PRINTCHAR ('\n');
 558   PRINTFINISH;
 559   return Qt;
 560 }
 561
 562 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
 563   "Output the printed representation of OBJECT, any Lisp object.\n\
 564 Quoting characters are printed when needed to make output that `read'\n\
 565 can handle, whenever this is possible.\n\
 566 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
 567   (object, printcharfun)
 568      Lisp_Object object, printcharfun;
 569 {
 570   PRINTDECLARE;
 571
 572 #ifdef MAX_PRINT_CHARS
 573   max_print = 0;
 574 #endif /* MAX_PRINT_CHARS */
 575   if (NILP (printcharfun))
 576     printcharfun = Vstandard_output;
 577   PRINTPREPARE;
 578   print_depth = 0;
 579   print (object, printcharfun, 1);
 580   PRINTFINISH;
 581   return object;
 582 }
 583
 584 /* a buffer which is used to hold output being built by prin1-to-string */
 585 Lisp_Object Vprin1_to_string_buffer;
 586
 587 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
 588   "Return a string containing the printed representation of OBJECT,\n\
 589 any Lisp object.  Quoting characters are used when needed to make output\n\
 590 that `read' can handle, whenever this is possible, unless the optional\n\
 591 second argument NOESCAPE is non-nil.")
 592   (object, noescape)
 593      Lisp_Object object, noescape;
 594 {
 595   PRINTDECLARE;
 596   Lisp_Object printcharfun;
 597   struct gcpro gcpro1, gcpro2;
 598   Lisp_Object tem;
 599
 600   /* Save and restore this--we are altering a buffer
 601      but we don't want to deactivate the mark just for that.
 602      No need for specbind, since errors deactivate the mark.  */
 603   tem = Vdeactivate_mark;
 604   GCPRO2 (object, tem);
 605
 606   printcharfun = Vprin1_to_string_buffer;
 607   PRINTPREPARE;
 608   print_depth = 0;
 609   print (object, printcharfun, NILP (noescape));
 610   /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
 611   PRINTFINISH;
 612   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 613   object = Fbuffer_string ();
 614
 615   Ferase_buffer ();
 616   set_buffer_internal (old);
 617
 618   Vdeactivate_mark = tem;
 619   UNGCPRO;
 620
 621   return object;
 622 }
 623
 624 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
 625   "Output the printed representation of OBJECT, any Lisp object.\n\
 626 No quoting characters are used; no delimiters are printed around\n\
 627 the contents of strings.\n\
 628 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
 629   (object, printcharfun)
 630      Lisp_Object object, printcharfun;
 631 {
 632   PRINTDECLARE;
 633
 634   if (NILP (printcharfun))
 635     printcharfun = Vstandard_output;
 636   PRINTPREPARE;
 637   print_depth = 0;
 638   print (object, printcharfun, 0);
 639   PRINTFINISH;
 640   return object;
 641 }
 642
 643 DEFUN ("print", Fprint, Sprint, 1, 2, 0,
 644   "Output the printed representation of OBJECT, with newlines around it.\n\
 645 Quoting characters are printed when needed to make output that `read'\n\
 646 can handle, whenever this is possible.\n\
 647 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
 648   (object, printcharfun)
 649      Lisp_Object object, printcharfun;
 650 {
 651   PRINTDECLARE;
 652   struct gcpro gcpro1;
 653
 654 #ifdef MAX_PRINT_CHARS
 655   print_chars = 0;
 656   max_print = MAX_PRINT_CHARS;
 657 #endif /* MAX_PRINT_CHARS */
 658   if (NILP (printcharfun))
 659     printcharfun = Vstandard_output;
 660   GCPRO1 (object);
 661   PRINTPREPARE;
 662   print_depth = 0;
 663   PRINTCHAR ('\n');
 664   print (object, printcharfun, 1);
 665   PRINTCHAR ('\n');
 666   PRINTFINISH;
 667 #ifdef MAX_PRINT_CHARS
 668   max_print = 0;
 669   print_chars = 0;
 670 #endif /* MAX_PRINT_CHARS */
 671   UNGCPRO;
 672   return object;
 673 }
 674
 675 /* The subroutine object for external-debugging-output is kept here
 676    for the convenience of the debugger.  */
 677 Lisp_Object Qexternal_debugging_output;
 678
 679 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
 680   "Write CHARACTER to stderr.\n\
 681 You can call print while debugging emacs, and pass it this function\n\
 682 to make it write to the debugging output.\n")
 683   (character)
 684      Lisp_Object character;
 685 {
 686   CHECK_NUMBER (character, 0);
 687   putc (XINT (character), stderr);
 688
 689   return character;
 690 }
 691
 692 /* This is the interface for debugging printing.  */
 693
 694 void
 695 debug_print (arg)
 696      Lisp_Object arg;
 697 {
 698   Fprin1 (arg, Qexternal_debugging_output);
 699   fprintf (stderr, "\r\n");
 700 }
 701 \f
 702 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
 703        1, 1, 0,
 704   "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
 705   (obj)
 706      Lisp_Object obj;
 707 {
 708   struct buffer *old = current_buffer;
 709   Lisp_Object original, printcharfun, value;
 710   struct gcpro gcpro1;
 711
 712   print_error_message (obj, Vprin1_to_string_buffer, NULL);
 713
 714   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 715   value = Fbuffer_string ();
 716
 717   GCPRO1 (value);
 718   Ferase_buffer ();
 719   set_buffer_internal (old);
 720   UNGCPRO;
 721
 722   return value;
 723 }
 724
 725 /* Print an error message for the error DATA
 726    onto Lisp output stream STREAM (suitable for the print functions).  */
 727
 728 print_error_message (data, stream)
 729      Lisp_Object data, stream;
 730 {
 731   Lisp_Object errname, errmsg, file_error, tail;
 732   struct gcpro gcpro1;
 733   int i;
 734
 735   errname = Fcar (data);
 736
 737   if (EQ (errname, Qerror))
 738     {
 739       data = Fcdr (data);
 740       if (!CONSP (data)) data = Qnil;
 741       errmsg = Fcar (data);
 742       file_error = Qnil;
 743     }
 744   else
 745     {
 746       errmsg = Fget (errname, Qerror_message);
 747       file_error = Fmemq (Qfile_error,
 748                           Fget (errname, Qerror_conditions));
 749     }
 750
 751   /* Print an error message including the data items.  */
 752
 753   tail = Fcdr_safe (data);
 754   GCPRO1 (tail);
 755
 756   /* For file-error, make error message by concatenating
 757      all the data items.  They are all strings.  */
 758   if (!NILP (file_error) && !NILP (tail))
 759     errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr;
 760
 761   if (STRINGP (errmsg))
 762     Fprinc (errmsg, stream);
 763   else
 764     write_string_1 ("peculiar error", -1, stream);
 765
 766   for (i = 0; CONSP (tail); tail = Fcdr (tail), i++)
 767     {
 768       write_string_1 (i ? ", " : ": ", 2, stream);
 769       if (!NILP (file_error))
 770         Fprinc (Fcar (tail), stream);
 771       else
 772         Fprin1 (Fcar (tail), stream);
 773     }
 774   UNGCPRO;
 775 }
 776 \f
 777 #ifdef LISP_FLOAT_TYPE
 778
 779 /*
 780  * The buffer should be at least as large as the max string size of the
 781  * largest float, printed in the biggest notation.  This is undoubtedly
 782  * 20d float_output_format, with the negative of the C-constant "HUGE"
 783  * from <math.h>.
 784  *
 785  * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
 786  *
 787  * I assume that IEEE-754 format numbers can take 329 bytes for the worst
 788  * case of -1e307 in 20d float_output_format. What is one to do (short of
 789  * re-writing _doprnt to be more sane)?
 790  *                      -wsr
 791  */
 792
 793 void
 794 float_to_string (buf, data)
 795      unsigned char *buf;
 796      double data;
 797 {
 798   unsigned char *cp;
 799   int width;
 800
 801   if (NILP (Vfloat_output_format)
 802       || !STRINGP (Vfloat_output_format))
 803   lose:
 804     {
 805       sprintf (buf, "%.17g", data);
 806       width = -1;
 807     }
 808   else                  /* oink oink */
 809     {
 810       /* Check that the spec we have is fully valid.
 811          This means not only valid for printf,
 812          but meant for floats, and reasonable.  */
 813       cp = XSTRING (Vfloat_output_format)->data;
 814
 815       if (cp[0] != '%')
 816         goto lose;
 817       if (cp[1] != '.')
 818         goto lose;
 819
 820       cp += 2;
 821
 822       /* Check the width specification.  */
 823       width = -1;
 824       if ('0' <= *cp && *cp <= '9')
 825         {
 826           width = 0;
 827           do
 828             width = (width * 10) + (*cp++ - '0');
 829           while (*cp >= '0' && *cp <= '9');
 830
 831           /* A precision of zero is valid only for %f.  */
 832           if (width > DBL_DIG
 833               || (width == 0 && *cp != 'f'))
 834             goto lose;
 835         }
 836
 837       if (*cp != 'e' && *cp != 'f' && *cp != 'g')
 838         goto lose;
 839
 840       if (cp[1] != 0)
 841         goto lose;
 842
 843       sprintf (buf, XSTRING (Vfloat_output_format)->data, data);
 844     }
 845
 846   /* Make sure there is a decimal point with digit after, or an
 847      exponent, so that the value is readable as a float.  But don't do
 848      this with "%.0f"; it's valid for that not to produce a decimal
 849      point.  Note that width can be 0 only for %.0f.  */
 850   if (width != 0)
 851     {
 852       for (cp = buf; *cp; cp++)
 853         if ((*cp < '0' || *cp > '9') && *cp != '-')
 854           break;
 855
 856       if (*cp == '.' && cp[1] == 0)
 857         {
 858           cp[1] = '0';
 859           cp[2] = 0;
 860         }
 861
 862       if (*cp == 0)
 863         {
 864           *cp++ = '.';
 865           *cp++ = '0';
 866           *cp++ = 0;
 867         }
 868     }
 869 }
 870 #endif /* LISP_FLOAT_TYPE */
 871 \f
 872 static void
 873 print (obj, printcharfun, escapeflag)
 874      Lisp_Object obj;
 875      register Lisp_Object printcharfun;
 876      int escapeflag;
 877 {
 878   char buf[30];
 879
 880   QUIT;
 881
 882 #if 1  /* I'm not sure this is really worth doing.  */
 883   /* Detect circularities and truncate them.
 884      No need to offer any alternative--this is better than an error.  */
 885   if (CONSP (obj) || VECTORP (obj) || COMPILEDP (obj))
 886     {
 887       int i;
 888       for (i = 0; i < print_depth; i++)
 889         if (EQ (obj, being_printed[i]))
 890           {
 891             sprintf (buf, "#%d", i);
 892             strout (buf, -1, printcharfun);
 893             return;
 894           }
 895     }
 896 #endif
 897
 898   being_printed[print_depth] = obj;
 899   print_depth++;
 900
 901   if (print_depth > PRINT_CIRCLE)
 902     error ("Apparently circular structure being printed");
 903 #ifdef MAX_PRINT_CHARS
 904   if (max_print && print_chars > max_print)
 905     {
 906       PRINTCHAR ('\n');
 907       print_chars = 0;
 908     }
 909 #endif /* MAX_PRINT_CHARS */
 910
 911   switch (XGCTYPE (obj))
 912     {
 913     case Lisp_Int:
 914       if (sizeof (int) == sizeof (EMACS_INT))
 915         sprintf (buf, "%d", XINT (obj));
 916       else if (sizeof (long) == sizeof (EMACS_INT))
 917         sprintf (buf, "%ld", XINT (obj));
 918       else
 919         abort ();
 920       strout (buf, -1, printcharfun);
 921       break;
 922
 923 #ifdef LISP_FLOAT_TYPE
 924     case Lisp_Float:
 925       {
 926         char pigbuf[350];       /* see comments in float_to_string */
 927
 928         float_to_string (pigbuf, XFLOAT(obj)->data);
 929         strout (pigbuf, -1, printcharfun);
 930       }
 931       break;
 932 #endif
 933
 934     case Lisp_String:
 935       if (!escapeflag)
 936         print_string (obj, printcharfun);
 937       else
 938         {
 939           register int i;
 940           register unsigned char c;
 941           struct gcpro gcpro1;
 942
 943           GCPRO1 (obj);
 944
 945 #ifdef USE_TEXT_PROPERTIES
 946           if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
 947             {
 948               PRINTCHAR ('#');
 949               PRINTCHAR ('(');
 950             }
 951 #endif
 952
 953           PRINTCHAR ('\"');
 954           for (i = 0; i < XSTRING (obj)->size; i++)
 955             {
 956               QUIT;
 957               c = XSTRING (obj)->data[i];
 958               if (c == '\n' && print_escape_newlines)
 959                 {
 960                   PRINTCHAR ('\\');
 961                   PRINTCHAR ('n');
 962                 }
 963               else if (c == '\f' && print_escape_newlines)
 964                 {
 965                   PRINTCHAR ('\\');
 966                   PRINTCHAR ('f');
 967                 }
 968               else
 969                 {
 970                   if (c == '\"' || c == '\\')
 971                     PRINTCHAR ('\\');
 972                   PRINTCHAR (c);
 973                 }
 974             }
 975           PRINTCHAR ('\"');
 976
 977 #ifdef USE_TEXT_PROPERTIES
 978           if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
 979             {
 980               traverse_intervals (XSTRING (obj)->intervals,
 981                                   0, 0, print_interval, printcharfun);
 982               PRINTCHAR (')');
 983             }
 984 #endif
 985
 986           UNGCPRO;
 987         }
 988       break;
 989
 990     case Lisp_Symbol:
 991       {
 992         register int confusing;
 993         register unsigned char *p = XSYMBOL (obj)->name->data;
 994         register unsigned char *end = p + XSYMBOL (obj)->name->size;
 995         register unsigned char c;
 996         int i;
 997
 998         if (p != end && (*p == '-' || *p == '+')) p++;
 999         if (p == end)
1000           confusing = 0;
1001         else
1002           {
1003             while (p != end && *p >= '0' && *p <= '9')
1004               p++;
1005             confusing = (end == p);
1006           }
1007
1008         /* If we print an uninterned symbol as part of a complex object and
1009            the flag print-gensym is non-nil, prefix it with #n= to read the
1010            object back with the #n# reader syntax later if needed.  */
1011         if (print_gensym && NILP (XSYMBOL (obj)->obarray))
1012           {
1013             if (print_depth > 1)
1014               {
1015                 Lisp_Object tem;
1016                 tem = Fassq (obj, printed_gensyms);
1017                 if (CONSP (tem))
1018                   {
1019                     PRINTCHAR ('#');
1020                     print (XCDR (tem), printcharfun, escapeflag);
1021                     PRINTCHAR ('#');
1022                     break;
1023                   }
1024                 else
1025                   {
1026                     if (CONSP (printed_gensyms))
1027                       XSETFASTINT (tem, XCDR (XCAR (printed_gensyms)) + 1);
1028                     else
1029                       XSETFASTINT (tem, 1);
1030                     printed_gensyms = Fcons (Fcons (obj, tem), printed_gensyms);
1031
1032                     PRINTCHAR ('#');
1033                     print (tem, printcharfun, escapeflag);
1034                     PRINTCHAR ('=');
1035                   }
1036               }
1037             PRINTCHAR ('#');
1038             PRINTCHAR (':');
1039           }
1040
1041         for (i = 0; i < XSYMBOL (obj)->name->size; i++)
1042           {
1043             QUIT;
1044             c = XSYMBOL (obj)->name->data[i];
1045
1046             if (escapeflag)
1047               {
1048                 if (c == '\"' || c == '\\' || c == '\''
1049                     || c == ';' || c == '#' || c == '(' || c == ')'
1050                     || c == ',' || c =='.' || c == '`'
1051                     || c == '[' || c == ']' || c == '?' || c <= 040
1052                     || confusing)
1053                   PRINTCHAR ('\\'), confusing = 0;
1054               }
1055             PRINTCHAR (c);
1056           }
1057       }
1058       break;
1059
1060     case Lisp_Cons:
1061       /* If deeper than spec'd depth, print placeholder.  */
1062       if (INTEGERP (Vprint_level)
1063           && print_depth > XINT (Vprint_level))
1064         strout ("...", -1, printcharfun);
1065       else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1066                && (EQ (XCAR (obj), Qquote)))
1067         {
1068           PRINTCHAR ('\'');
1069           print (XCAR (XCDR (obj)), printcharfun, escapeflag);
1070         }
1071       else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1072                && (EQ (XCAR (obj), Qfunction)))
1073         {
1074           PRINTCHAR ('#');
1075           PRINTCHAR ('\'');
1076           print (XCAR (XCDR (obj)), printcharfun, escapeflag);
1077         }
1078       else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1079                && ((EQ (XCAR (obj), Qbackquote)
1080                     || EQ (XCAR (obj), Qcomma)
1081                     || EQ (XCAR (obj), Qcomma_at)
1082                     || EQ (XCAR (obj), Qcomma_dot))))
1083         {
1084           print (XCAR (obj), printcharfun, 0);
1085           print (XCAR (XCDR (obj)), printcharfun, escapeflag);
1086         }
1087       else
1088         {
1089           PRINTCHAR ('(');
1090           {
1091             register int i = 0;
1092             register int max = 0;
1093
1094             if (INTEGERP (Vprint_length))
1095               max = XINT (Vprint_length);
1096             /* Could recognize circularities in cdrs here,
1097                but that would make printing of long lists quadratic.
1098                It's not worth doing.  */
1099             while (CONSP (obj))
1100               {
1101                 if (i++)
1102                   PRINTCHAR (' ');
1103                 if (max && i > max)
1104                   {
1105                     strout ("...", 3, printcharfun);
1106                     break;
1107                   }
1108                 print (XCAR (obj), printcharfun, escapeflag);
1109                 obj = XCDR (obj);
1110               }
1111           }
1112           if (!NILP (obj))
1113             {
1114               strout (" . ", 3, printcharfun);
1115               print (obj, printcharfun, escapeflag);
1116             }
1117           PRINTCHAR (')');
1118         }
1119       break;
1120
1121     case Lisp_Vectorlike:
1122       if (PROCESSP (obj))
1123         {
1124           if (escapeflag)
1125             {
1126               strout ("#<process ", -1, printcharfun);
1127               print_string (XPROCESS (obj)->name, printcharfun);
1128               PRINTCHAR ('>');
1129             }
1130           else
1131             print_string (XPROCESS (obj)->name, printcharfun);
1132         }
1133       else if (BOOL_VECTOR_P (obj))
1134         {
1135           register int i;
1136           register unsigned char c;
1137           struct gcpro gcpro1;
1138           int size_in_chars
1139             = (XBOOL_VECTOR (obj)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
1140
1141           GCPRO1 (obj);
1142
1143           PRINTCHAR ('#');
1144           PRINTCHAR ('&');
1145           sprintf (buf, "%d", XBOOL_VECTOR (obj)->size);
1146           strout (buf, -1, printcharfun);
1147           PRINTCHAR ('\"');
1148
1149           /* Don't print more characters than the specified maximum.  */
1150           if (INTEGERP (Vprint_length)
1151               && XINT (Vprint_length) < size_in_chars)
1152             size_in_chars = XINT (Vprint_length);
1153
1154           for (i = 0; i < size_in_chars; i++)
1155             {
1156               QUIT;
1157               c = XBOOL_VECTOR (obj)->data[i];
1158               if (c == '\n' && print_escape_newlines)
1159                 {
1160                   PRINTCHAR ('\\');
1161                   PRINTCHAR ('n');
1162                 }
1163               else if (c == '\f' && print_escape_newlines)
1164                 {
1165                   PRINTCHAR ('\\');
1166                   PRINTCHAR ('f');
1167                 }
1168               else
1169                 {
1170                   if (c == '\"' || c == '\\')
1171                     PRINTCHAR ('\\');
1172                   PRINTCHAR (c);
1173                 }
1174             }
1175           PRINTCHAR ('\"');
1176
1177           UNGCPRO;
1178         }
1179       else if (SUBRP (obj))
1180         {
1181           strout ("#<subr ", -1, printcharfun);
1182           strout (XSUBR (obj)->symbol_name, -1, printcharfun);
1183           PRINTCHAR ('>');
1184         }
1185 #ifndef standalone
1186       else if (WINDOWP (obj))
1187         {
1188           strout ("#<window ", -1, printcharfun);
1189           sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number));
1190           strout (buf, -1, printcharfun);
1191           if (!NILP (XWINDOW (obj)->buffer))
1192             {
1193               strout (" on ", -1, printcharfun);
1194               print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun);
1195             }
1196           PRINTCHAR ('>');
1197         }
1198       else if (BUFFERP (obj))
1199         {
1200           if (NILP (XBUFFER (obj)->name))
1201             strout ("#<killed buffer>", -1, printcharfun);
1202           else if (escapeflag)
1203             {
1204               strout ("#<buffer ", -1, printcharfun);
1205               print_string (XBUFFER (obj)->name, printcharfun);
1206               PRINTCHAR ('>');
1207             }
1208           else
1209             print_string (XBUFFER (obj)->name, printcharfun);
1210         }
1211       else if (WINDOW_CONFIGURATIONP (obj))
1212         {
1213           strout ("#<window-configuration>", -1, printcharfun);
1214         }
1215       else if (FRAMEP (obj))
1216         {
1217           strout ((FRAME_LIVE_P (XFRAME (obj))
1218                    ? "#<frame " : "#<dead frame "),
1219                   -1, printcharfun);
1220           print_string (XFRAME (obj)->name, printcharfun);
1221           sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj)));
1222           strout (buf, -1, printcharfun);
1223           PRINTCHAR ('>');
1224         }
1225 #endif /* not standalone */
1226       else
1227         {
1228           int size = XVECTOR (obj)->size;
1229           if (COMPILEDP (obj))
1230             {
1231               PRINTCHAR ('#');
1232               size &= PSEUDOVECTOR_SIZE_MASK;
1233             }
1234           if (CHAR_TABLE_P (obj))
1235             {
1236               /* We print a char-table as if it were a vector,
1237                  lumping the parent and default slots in with the
1238                  character slots.  But we add #^ as a prefix.  */
1239               PRINTCHAR ('#');
1240               PRINTCHAR ('^');
1241               size &= PSEUDOVECTOR_SIZE_MASK;
1242             }
1243           if (size & PSEUDOVECTOR_FLAG)
1244             goto badtype;
1245
1246           PRINTCHAR ('[');
1247           {
1248             register int i;
1249             register Lisp_Object tem;
1250
1251             /* Don't print more elements than the specified maximum.  */
1252             if (INTEGERP (Vprint_length)
1253                 && XINT (Vprint_length) < size)
1254               size = XINT (Vprint_length);
1255
1256             for (i = 0; i < size; i++)
1257               {
1258                 if (i) PRINTCHAR (' ');
1259                 tem = XVECTOR (obj)->contents[i];
1260                 print (tem, printcharfun, escapeflag);
1261               }
1262           }
1263           PRINTCHAR (']');
1264         }
1265       break;
1266
1267 #ifndef standalone
1268     case Lisp_Misc:
1269       switch (XMISCTYPE (obj))
1270         {
1271         case Lisp_Misc_Marker:
1272           strout ("#<marker ", -1, printcharfun);
1273           if (!(XMARKER (obj)->buffer))
1274             strout ("in no buffer", -1, printcharfun);
1275           else
1276             {
1277               sprintf (buf, "at %d", marker_position (obj));
1278               strout (buf, -1, printcharfun);
1279               strout (" in ", -1, printcharfun);
1280               print_string (XMARKER (obj)->buffer->name, printcharfun);
1281             }
1282           PRINTCHAR ('>');
1283           break;
1284
1285         case Lisp_Misc_Overlay:
1286           strout ("#<overlay ", -1, printcharfun);
1287           if (!(XMARKER (OVERLAY_START (obj))->buffer))
1288             strout ("in no buffer", -1, printcharfun);
1289           else
1290             {
1291               sprintf (buf, "from %d to %d in ",
1292                        marker_position (OVERLAY_START (obj)),
1293                        marker_position (OVERLAY_END   (obj)));
1294               strout (buf, -1, printcharfun);
1295               print_string (XMARKER (OVERLAY_START (obj))->buffer->name,
1296                             printcharfun);
1297             }
1298           PRINTCHAR ('>');
1299           break;
1300
1301       /* Remaining cases shouldn't happen in normal usage, but let's print
1302          them anyway for the benefit of the debugger.  */
1303         case Lisp_Misc_Free:
1304           strout ("#<misc free cell>", -1, printcharfun);
1305           break;
1306
1307         case Lisp_Misc_Intfwd:
1308           sprintf (buf, "#<intfwd to %d>", *XINTFWD (obj)->intvar);
1309           strout (buf, -1, printcharfun);
1310           break;
1311
1312         case Lisp_Misc_Boolfwd:
1313           sprintf (buf, "#<boolfwd to %s>",
1314                    (*XBOOLFWD (obj)->boolvar ? "t" : "nil"));
1315           strout (buf, -1, printcharfun);
1316           break;
1317
1318         case Lisp_Misc_Objfwd:
1319           strout ("#<objfwd to ", -1, printcharfun);
1320           print (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
1321           PRINTCHAR ('>');
1322           break;
1323
1324         case Lisp_Misc_Buffer_Objfwd:
1325           strout ("#<buffer_objfwd to ", -1, printcharfun);
1326           print (*(Lisp_Object *)((char *)current_buffer
1327                                   + XBUFFER_OBJFWD (obj)->offset),
1328                  printcharfun, escapeflag);
1329           PRINTCHAR ('>');
1330           break;
1331
1332         case Lisp_Misc_Kboard_Objfwd:
1333           strout ("#<kboard_objfwd to ", -1, printcharfun);
1334           print (*(Lisp_Object *)((char *) current_kboard
1335                                   + XKBOARD_OBJFWD (obj)->offset),
1336                  printcharfun, escapeflag);
1337           PRINTCHAR ('>');
1338           break;
1339
1340         case Lisp_Misc_Buffer_Local_Value:
1341           strout ("#<buffer_local_value ", -1, printcharfun);
1342           goto do_buffer_local;
1343         case Lisp_Misc_Some_Buffer_Local_Value:
1344           strout ("#<some_buffer_local_value ", -1, printcharfun);
1345         do_buffer_local:
1346           strout ("[realvalue] ", -1, printcharfun);
1347           print (XBUFFER_LOCAL_VALUE (obj)->car, printcharfun, escapeflag);
1348           strout ("[buffer] ", -1, printcharfun);
1349           print (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->car,
1350                  printcharfun, escapeflag);
1351           strout ("[alist-elt] ", -1, printcharfun);
1352           print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr)->car,
1353                  printcharfun, escapeflag);
1354           strout ("[default-value] ", -1, printcharfun);
1355           print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr)->cdr,
1356                  printcharfun, escapeflag);
1357           PRINTCHAR ('>');
1358           break;
1359
1360         default:
1361           goto badtype;
1362         }
1363       break;
1364 #endif /* standalone */
1365
1366     default:
1367     badtype:
1368       {
1369         /* We're in trouble if this happens!
1370            Probably should just abort () */
1371         strout ("#<EMACS BUG: INVALID DATATYPE ", -1, printcharfun);
1372         if (MISCP (obj))
1373           sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
1374         else if (VECTORLIKEP (obj))
1375           sprintf (buf, "(PVEC 0x%08x)", (int) XVECTOR (obj)->size);
1376         else
1377           sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
1378         strout (buf, -1, printcharfun);
1379         strout (" Save your buffers immediately and please report this bug>",
1380                 -1, printcharfun);
1381       }
1382     }
1383
1384   print_depth--;
1385 }
1386 \f
1387 #ifdef USE_TEXT_PROPERTIES
1388
1389 /* Print a description of INTERVAL using PRINTCHARFUN.
1390    This is part of printing a string that has text properties.  */
1391
1392 void
1393 print_interval (interval, printcharfun)
1394      INTERVAL interval;
1395      Lisp_Object printcharfun;
1396 {
1397   PRINTCHAR (' ');
1398   print (make_number (interval->position), printcharfun, 1);
1399   PRINTCHAR (' ');
1400   print (make_number (interval->position + LENGTH (interval)),
1401          printcharfun, 1);
1402   PRINTCHAR (' ');
1403   print (interval->plist, printcharfun, 1);
1404 }
1405
1406 #endif /* USE_TEXT_PROPERTIES */
1407 \f
1408 void
1409 syms_of_print ()
1410 {
1411   DEFVAR_LISP ("standard-output", &Vstandard_output,
1412     "Output stream `print' uses by default for outputting a character.\n\
1413 This may be any function of one argument.\n\
1414 It may also be a buffer (output is inserted before point)\n\
1415 or a marker (output is inserted and the marker is advanced)\n\
1416 or the symbol t (output appears in the echo area).");
1417   Vstandard_output = Qt;
1418   Qstandard_output = intern ("standard-output");
1419   staticpro (&Qstandard_output);
1420
1421 #ifdef LISP_FLOAT_TYPE
1422   DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
1423     "The format descriptor string used to print floats.\n\
1424 This is a %-spec like those accepted by `printf' in C,\n\
1425 but with some restrictions.  It must start with the two characters `%.'.\n\
1426 After that comes an integer precision specification,\n\
1427 and then a letter which controls the format.\n\
1428 The letters allowed are `e', `f' and `g'.\n\
1429 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1430 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1431 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1432 The precision in any of these cases is the number of digits following\n\
1433 the decimal point.  With `f', a precision of 0 means to omit the\n\
1434 decimal point.  0 is not allowed with `e' or `g'.\n\n\
1435 A value of nil means to use `%.17g'.");
1436   Vfloat_output_format = Qnil;
1437   Qfloat_output_format = intern ("float-output-format");
1438   staticpro (&Qfloat_output_format);
1439 #endif /* LISP_FLOAT_TYPE */
1440
1441   DEFVAR_LISP ("print-length", &Vprint_length,
1442     "Maximum length of list to print before abbreviating.\n\
1443 A value of nil means no limit.");
1444   Vprint_length = Qnil;
1445
1446   DEFVAR_LISP ("print-level", &Vprint_level,
1447     "Maximum depth of list nesting to print before abbreviating.\n\
1448 A value of nil means no limit.");
1449   Vprint_level = Qnil;
1450
1451   DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
1452     "Non-nil means print newlines in strings as backslash-n.\n\
1453 Also print formfeeds as backslash-f.");
1454   print_escape_newlines = 0;
1455
1456   DEFVAR_BOOL ("print-quoted", &print_quoted,
1457     "Non-nil means print quoted forms with reader syntax.\n\
1458 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\
1459 forms print in the new syntax.");
1460   print_quoted = 0;
1461
1462   DEFVAR_BOOL ("print-gensym", &print_gensym,
1463     "Non-nil means print uninterned symbols so they will read as uninterned.\n\
1464 I.e., the value of (make-symbol "foobar") prints as #:foobar.");
1465   print_gensym = 0;
1466
1467   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1468   staticpro (&Vprin1_to_string_buffer);
1469
1470   defsubr (&Sprin1);
1471   defsubr (&Sprin1_to_string);
1472   defsubr (&Serror_message_string);
1473   defsubr (&Sprinc);
1474   defsubr (&Sprint);
1475   defsubr (&Sterpri);
1476   defsubr (&Swrite_char);
1477   defsubr (&Sexternal_debugging_output);
1478
1479   Qexternal_debugging_output = intern ("external-debugging-output");
1480   staticpro (&Qexternal_debugging_output);
1481
1482   Qprint_escape_newlines = intern ("print-escape-newlines");
1483   staticpro (&Qprint_escape_newlines);
1484
1485   staticpro (&printed_gensyms);
1486   printed_gensyms = Qnil;
1487
1488 #ifndef standalone
1489   defsubr (&Swith_output_to_temp_buffer);
1490 #endif /* not standalone */
1491 }