(printchar, strout): Use FRAME_PTR, not struct frame *.
[emacs.git] / src / print.c
blob230969fa6062b4daad2794931560fcf45b447f5c
1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
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.
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.
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. */
21 #include <config.h>
22 #include <stdio.h>
23 #undef NULL
24 #include "lisp.h"
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 */
35 #ifdef USE_TEXT_PROPERTIES
36 #include "intervals.h"
37 #endif
39 Lisp_Object Vstandard_output, Qstandard_output;
41 #ifdef LISP_FLOAT_TYPE
42 Lisp_Object Vfloat_output_format, Qfloat_output_format;
43 #endif /* LISP_FLOAT_TYPE */
45 /* Avoid actual stack overflow in print. */
46 int print_depth;
48 /* Detect most circularities to print finite output. */
49 #define PRINT_CIRCLE 200
50 Lisp_Object being_printed[PRINT_CIRCLE];
52 /* Maximum length of list to print in full; noninteger means
53 effectively infinity */
55 Lisp_Object Vprint_length;
57 /* Maximum depth of list to print in full; noninteger means
58 effectively infinity. */
60 Lisp_Object Vprint_level;
62 /* Nonzero means print newlines in strings as \n. */
64 int print_escape_newlines;
66 Lisp_Object Qprint_escape_newlines;
68 /* Nonzero means print newline before next minibuffer message.
69 Defined in xdisp.c */
71 extern int noninteractive_need_newline;
72 #ifdef MAX_PRINT_CHARS
73 static int print_chars;
74 static int max_print;
75 #endif /* MAX_PRINT_CHARS */
77 void print_interval ();
79 #if 0
80 /* Convert between chars and GLYPHs */
82 int
83 glyphlen (glyphs)
84 register GLYPH *glyphs;
86 register int i = 0;
88 while (glyphs[i])
89 i++;
90 return i;
93 void
94 str_to_glyph_cpy (str, glyphs)
95 char *str;
96 GLYPH *glyphs;
98 register GLYPH *gp = glyphs;
99 register char *cp = str;
101 while (*cp)
102 *gp++ = *cp++;
105 void
106 str_to_glyph_ncpy (str, glyphs, n)
107 char *str;
108 GLYPH *glyphs;
109 register int n;
111 register GLYPH *gp = glyphs;
112 register char *cp = str;
114 while (n-- > 0)
115 *gp++ = *cp++;
118 void
119 glyph_to_str_cpy (glyphs, str)
120 GLYPH *glyphs;
121 char *str;
123 register GLYPH *gp = glyphs;
124 register char *cp = str;
126 while (*gp)
127 *str++ = *gp++ & 0377;
129 #endif
131 /* Low level output routines for characters and strings */
133 /* Lisp functions to do output using a stream
134 must have the stream in a variable called printcharfun
135 and must start with PRINTPREPARE and end with PRINTFINISH.
136 Use PRINTCHAR to output one character,
137 or call strout to output a block of characters.
138 Also, each one must have the declarations
139 struct buffer *old = current_buffer;
140 int old_point = -1, start_point;
141 Lisp_Object original;
144 #define PRINTPREPARE \
145 original = printcharfun; \
146 if (NILP (printcharfun)) printcharfun = Qt; \
147 if (XTYPE (printcharfun) == Lisp_Buffer) \
148 { if (XBUFFER (printcharfun) != current_buffer) \
149 Fset_buffer (printcharfun); \
150 printcharfun = Qnil;} \
151 if (XTYPE (printcharfun) == Lisp_Marker) \
152 { if (!(XMARKER (original)->buffer)) \
153 error ("Marker does not point anywhere"); \
154 if (XMARKER (original)->buffer != current_buffer) \
155 set_buffer_internal (XMARKER (original)->buffer); \
156 old_point = point; \
157 SET_PT (marker_position (printcharfun)); \
158 start_point = point; \
159 printcharfun = Qnil;}
161 #define PRINTFINISH \
162 if (XTYPE (original) == Lisp_Marker) \
163 Fset_marker (original, make_number (point), Qnil); \
164 if (old_point >= 0) \
165 SET_PT (old_point + (old_point >= start_point \
166 ? point - start_point : 0)); \
167 if (old != current_buffer) \
168 set_buffer_internal (old)
170 #define PRINTCHAR(ch) printchar (ch, printcharfun)
172 /* Index of first unused element of FRAME_MESSAGE_BUF(mini_frame). */
173 static int printbufidx;
175 static void
176 printchar (ch, fun)
177 unsigned char ch;
178 Lisp_Object fun;
180 Lisp_Object ch1;
182 #ifdef MAX_PRINT_CHARS
183 if (max_print)
184 print_chars++;
185 #endif /* MAX_PRINT_CHARS */
186 #ifndef standalone
187 if (EQ (fun, Qnil))
189 QUIT;
190 insert (&ch, 1);
191 return;
194 if (EQ (fun, Qt))
196 FRAME_PTR mini_frame
197 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)));
199 if (noninteractive)
201 putchar (ch);
202 noninteractive_need_newline = 1;
203 return;
206 if (echo_area_glyphs != FRAME_MESSAGE_BUF (mini_frame)
207 || !message_buf_print)
209 echo_area_glyphs = FRAME_MESSAGE_BUF (mini_frame);
210 printbufidx = 0;
211 echo_area_glyphs_length = 0;
212 message_buf_print = 1;
215 if (printbufidx < FRAME_WIDTH (mini_frame) - 1)
216 FRAME_MESSAGE_BUF (mini_frame)[printbufidx++] = ch;
217 FRAME_MESSAGE_BUF (mini_frame)[printbufidx] = 0;
218 echo_area_glyphs_length = printbufidx;
220 return;
222 #endif /* not standalone */
224 XFASTINT (ch1) = ch;
225 call1 (fun, ch1);
228 static void
229 strout (ptr, size, printcharfun)
230 char *ptr;
231 int size;
232 Lisp_Object printcharfun;
234 int i = 0;
236 if (EQ (printcharfun, Qnil))
238 insert (ptr, size >= 0 ? size : strlen (ptr));
239 #ifdef MAX_PRINT_CHARS
240 if (max_print)
241 print_chars += size >= 0 ? size : strlen(ptr);
242 #endif /* MAX_PRINT_CHARS */
243 return;
245 if (EQ (printcharfun, Qt))
247 FRAME_PTR mini_frame
248 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)));
250 i = size >= 0 ? size : strlen (ptr);
251 #ifdef MAX_PRINT_CHARS
252 if (max_print)
253 print_chars += i;
254 #endif /* MAX_PRINT_CHARS */
256 if (noninteractive)
258 fwrite (ptr, 1, i, stdout);
259 noninteractive_need_newline = 1;
260 return;
263 if (echo_area_glyphs != FRAME_MESSAGE_BUF (mini_frame)
264 || !message_buf_print)
266 echo_area_glyphs = FRAME_MESSAGE_BUF (mini_frame);
267 printbufidx = 0;
268 echo_area_glyphs_length = 0;
269 message_buf_print = 1;
272 if (i > FRAME_WIDTH (mini_frame) - printbufidx - 1)
273 i = FRAME_WIDTH (mini_frame) - printbufidx - 1;
274 bcopy (ptr, &FRAME_MESSAGE_BUF (mini_frame) [printbufidx], i);
275 printbufidx += i;
276 echo_area_glyphs_length = printbufidx;
277 FRAME_MESSAGE_BUF (mini_frame) [printbufidx] = 0;
279 return;
282 if (size >= 0)
283 while (i < size)
284 PRINTCHAR (ptr[i++]);
285 else
286 while (ptr[i])
287 PRINTCHAR (ptr[i++]);
290 /* Print the contents of a string STRING using PRINTCHARFUN.
291 It isn't safe to use strout, because printing one char can relocate. */
293 print_string (string, printcharfun)
294 Lisp_Object string;
295 Lisp_Object printcharfun;
297 if (EQ (printcharfun, Qnil) || EQ (printcharfun, Qt))
298 /* In predictable cases, strout is safe: output to buffer or frame. */
299 strout (XSTRING (string)->data, XSTRING (string)->size, printcharfun);
300 else
302 /* Otherwise, fetch the string address for each character. */
303 int i;
304 int size = XSTRING (string)->size;
305 struct gcpro gcpro1;
306 GCPRO1 (string);
307 for (i = 0; i < size; i++)
308 PRINTCHAR (XSTRING (string)->data[i]);
309 UNGCPRO;
313 DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
314 "Output character CHAR to stream STREAM.\n\
315 STREAM defaults to the value of `standard-output' (which see).")
316 (ch, printcharfun)
317 Lisp_Object ch, printcharfun;
319 struct buffer *old = current_buffer;
320 int old_point = -1;
321 int start_point;
322 Lisp_Object original;
324 if (NILP (printcharfun))
325 printcharfun = Vstandard_output;
326 CHECK_NUMBER (ch, 0);
327 PRINTPREPARE;
328 PRINTCHAR (XINT (ch));
329 PRINTFINISH;
330 return ch;
333 /* Used from outside of print.c to print a block of SIZE chars at DATA
334 on the default output stream.
335 Do not use this on the contents of a Lisp string. */
337 write_string (data, size)
338 char *data;
339 int size;
341 struct buffer *old = current_buffer;
342 Lisp_Object printcharfun;
343 int old_point = -1;
344 int start_point;
345 Lisp_Object original;
347 printcharfun = Vstandard_output;
349 PRINTPREPARE;
350 strout (data, size, printcharfun);
351 PRINTFINISH;
354 /* Used from outside of print.c to print a block of SIZE chars at DATA
355 on a specified stream PRINTCHARFUN.
356 Do not use this on the contents of a Lisp string. */
358 write_string_1 (data, size, printcharfun)
359 char *data;
360 int size;
361 Lisp_Object printcharfun;
363 struct buffer *old = current_buffer;
364 int old_point = -1;
365 int start_point;
366 Lisp_Object original;
368 PRINTPREPARE;
369 strout (data, size, printcharfun);
370 PRINTFINISH;
374 #ifndef standalone
376 void
377 temp_output_buffer_setup (bufname)
378 char *bufname;
380 register struct buffer *old = current_buffer;
381 register Lisp_Object buf;
383 Fset_buffer (Fget_buffer_create (build_string (bufname)));
385 current_buffer->read_only = Qnil;
386 Ferase_buffer ();
388 XSET (buf, Lisp_Buffer, current_buffer);
389 specbind (Qstandard_output, buf);
391 set_buffer_internal (old);
394 Lisp_Object
395 internal_with_output_to_temp_buffer (bufname, function, args)
396 char *bufname;
397 Lisp_Object (*function) ();
398 Lisp_Object args;
400 int count = specpdl_ptr - specpdl;
401 Lisp_Object buf, val;
403 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
404 temp_output_buffer_setup (bufname);
405 buf = Vstandard_output;
407 val = (*function) (args);
409 temp_output_buffer_show (buf);
411 return unbind_to (count, val);
414 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
415 1, UNEVALLED, 0,
416 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
417 The buffer is cleared out initially, and marked as unmodified when done.\n\
418 All output done by BODY is inserted in that buffer by default.\n\
419 The buffer is displayed in another window, but not selected.\n\
420 The value of the last form in BODY is returned.\n\
421 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
422 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
423 to get the buffer displayed. It gets one argument, the buffer to display.")
424 (args)
425 Lisp_Object args;
427 struct gcpro gcpro1;
428 Lisp_Object name;
429 int count = specpdl_ptr - specpdl;
430 Lisp_Object buf, val;
432 GCPRO1(args);
433 name = Feval (Fcar (args));
434 UNGCPRO;
436 CHECK_STRING (name, 0);
437 temp_output_buffer_setup (XSTRING (name)->data);
438 buf = Vstandard_output;
440 val = Fprogn (Fcdr (args));
442 temp_output_buffer_show (buf);
444 return unbind_to (count, val);
446 #endif /* not standalone */
448 static void print ();
450 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
451 "Output a newline to STREAM.\n\
452 If STREAM is omitted or nil, the value of `standard-output' is used.")
453 (printcharfun)
454 Lisp_Object printcharfun;
456 struct buffer *old = current_buffer;
457 int old_point = -1;
458 int start_point;
459 Lisp_Object original;
461 if (NILP (printcharfun))
462 printcharfun = Vstandard_output;
463 PRINTPREPARE;
464 PRINTCHAR ('\n');
465 PRINTFINISH;
466 return Qt;
469 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
470 "Output the printed representation of OBJECT, any Lisp object.\n\
471 Quoting characters are printed when needed to make output that `read'\n\
472 can handle, whenever this is possible.\n\
473 Output stream is STREAM, or value of `standard-output' (which see).")
474 (obj, printcharfun)
475 Lisp_Object obj, printcharfun;
477 struct buffer *old = current_buffer;
478 int old_point = -1;
479 int start_point;
480 Lisp_Object original;
482 #ifdef MAX_PRINT_CHARS
483 max_print = 0;
484 #endif /* MAX_PRINT_CHARS */
485 if (NILP (printcharfun))
486 printcharfun = Vstandard_output;
487 PRINTPREPARE;
488 print_depth = 0;
489 print (obj, printcharfun, 1);
490 PRINTFINISH;
491 return obj;
494 /* a buffer which is used to hold output being built by prin1-to-string */
495 Lisp_Object Vprin1_to_string_buffer;
497 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
498 "Return a string containing the printed representation of OBJECT,\n\
499 any Lisp object. Quoting characters are used when needed to make output\n\
500 that `read' can handle, whenever this is possible, unless the optional\n\
501 second argument NOESCAPE is non-nil.")
502 (obj, noescape)
503 Lisp_Object obj, noescape;
505 struct buffer *old = current_buffer;
506 int old_point = -1;
507 int start_point;
508 Lisp_Object original, printcharfun;
509 struct gcpro gcpro1;
511 printcharfun = Vprin1_to_string_buffer;
512 PRINTPREPARE;
513 print_depth = 0;
514 print (obj, printcharfun, NILP (noescape));
515 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
516 PRINTFINISH;
517 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
518 obj = Fbuffer_string ();
520 GCPRO1 (obj);
521 Ferase_buffer ();
522 set_buffer_internal (old);
523 UNGCPRO;
525 return obj;
528 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
529 "Output the printed representation of OBJECT, any Lisp object.\n\
530 No quoting characters are used; no delimiters are printed around\n\
531 the contents of strings.\n\
532 Output stream is STREAM, or value of standard-output (which see).")
533 (obj, printcharfun)
534 Lisp_Object obj, printcharfun;
536 struct buffer *old = current_buffer;
537 int old_point = -1;
538 int start_point;
539 Lisp_Object original;
541 if (NILP (printcharfun))
542 printcharfun = Vstandard_output;
543 PRINTPREPARE;
544 print_depth = 0;
545 print (obj, printcharfun, 0);
546 PRINTFINISH;
547 return obj;
550 DEFUN ("print", Fprint, Sprint, 1, 2, 0,
551 "Output the printed representation of OBJECT, with newlines around it.\n\
552 Quoting characters are printed when needed to make output that `read'\n\
553 can handle, whenever this is possible.\n\
554 Output stream is STREAM, or value of `standard-output' (which see).")
555 (obj, printcharfun)
556 Lisp_Object obj, printcharfun;
558 struct buffer *old = current_buffer;
559 int old_point = -1;
560 int start_point;
561 Lisp_Object original;
562 struct gcpro gcpro1;
564 #ifdef MAX_PRINT_CHARS
565 print_chars = 0;
566 max_print = MAX_PRINT_CHARS;
567 #endif /* MAX_PRINT_CHARS */
568 if (NILP (printcharfun))
569 printcharfun = Vstandard_output;
570 GCPRO1 (obj);
571 PRINTPREPARE;
572 print_depth = 0;
573 PRINTCHAR ('\n');
574 print (obj, printcharfun, 1);
575 PRINTCHAR ('\n');
576 PRINTFINISH;
577 #ifdef MAX_PRINT_CHARS
578 max_print = 0;
579 print_chars = 0;
580 #endif /* MAX_PRINT_CHARS */
581 UNGCPRO;
582 return obj;
585 /* The subroutine object for external-debugging-output is kept here
586 for the convenience of the debugger. */
587 Lisp_Object Qexternal_debugging_output;
589 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
590 "Write CHARACTER to stderr.\n\
591 You can call print while debugging emacs, and pass it this function\n\
592 to make it write to the debugging output.\n")
593 (character)
594 Lisp_Object character;
596 CHECK_NUMBER (character, 0);
597 putc (XINT (character), stderr);
599 return character;
602 /* This is the interface for debugging printing. */
604 void
605 debug_print (arg)
606 Lisp_Object arg;
608 Fprin1 (arg, Qexternal_debugging_output);
611 #ifdef LISP_FLOAT_TYPE
614 * The buffer should be at least as large as the max string size of the
615 * largest float, printed in the biggest notation. This is undoubtably
616 * 20d float_output_format, with the negative of the C-constant "HUGE"
617 * from <math.h>.
619 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
621 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
622 * case of -1e307 in 20d float_output_format. What is one to do (short of
623 * re-writing _doprnt to be more sane)?
624 * -wsr
627 void
628 float_to_string (buf, data)
629 unsigned char *buf;
630 double data;
632 unsigned char *cp;
633 int width;
635 if (NILP (Vfloat_output_format)
636 || XTYPE (Vfloat_output_format) != Lisp_String)
637 lose:
639 sprintf (buf, "%.17g", data);
640 width = -1;
642 else /* oink oink */
644 /* Check that the spec we have is fully valid.
645 This means not only valid for printf,
646 but meant for floats, and reasonable. */
647 cp = XSTRING (Vfloat_output_format)->data;
649 if (cp[0] != '%')
650 goto lose;
651 if (cp[1] != '.')
652 goto lose;
654 cp += 2;
656 /* Check the width specification. */
657 width = -1;
658 if ('0' <= *cp && *cp <= '9')
659 for (width = 0; (*cp >= '0' && *cp <= '9'); cp++)
660 width = (width * 10) + (*cp - '0');
662 if (*cp != 'e' && *cp != 'f' && *cp != 'g')
663 goto lose;
665 /* A precision of zero is valid for %f; everything else requires
666 at least one. Width may be omitted anywhere. */
667 if (width != -1
668 && (width < (*cp != 'f')
669 || width > DBL_DIG))
670 goto lose;
672 if (cp[1] != 0)
673 goto lose;
675 sprintf (buf, XSTRING (Vfloat_output_format)->data, data);
678 /* Make sure there is a decimal point with digit after, or an
679 exponent, so that the value is readable as a float. But don't do
680 this with "%.0f"; it's valid for that not to produce a decimal
681 point. Note that width can be 0 only for %.0f. */
682 if (width != 0)
684 for (cp = buf; *cp; cp++)
685 if ((*cp < '0' || *cp > '9') && *cp != '-')
686 break;
688 if (*cp == '.' && cp[1] == 0)
690 cp[1] = '0';
691 cp[2] = 0;
694 if (*cp == 0)
696 *cp++ = '.';
697 *cp++ = '0';
698 *cp++ = 0;
702 #endif /* LISP_FLOAT_TYPE */
704 static void
705 print (obj, printcharfun, escapeflag)
706 Lisp_Object obj;
707 register Lisp_Object printcharfun;
708 int escapeflag;
710 char buf[30];
712 QUIT;
714 #if 1 /* I'm not sure this is really worth doing. */
715 /* Detect circularities and truncate them.
716 No need to offer any alternative--this is better than an error. */
717 if (XTYPE (obj) == Lisp_Cons || XTYPE (obj) == Lisp_Vector
718 || XTYPE (obj) == Lisp_Compiled)
720 int i;
721 for (i = 0; i < print_depth; i++)
722 if (EQ (obj, being_printed[i]))
724 sprintf (buf, "#%d", i);
725 strout (buf, -1, printcharfun);
726 return;
729 #endif
731 being_printed[print_depth] = obj;
732 print_depth++;
734 if (print_depth > PRINT_CIRCLE)
735 error ("Apparently circular structure being printed");
736 #ifdef MAX_PRINT_CHARS
737 if (max_print && print_chars > max_print)
739 PRINTCHAR ('\n');
740 print_chars = 0;
742 #endif /* MAX_PRINT_CHARS */
744 #ifdef SWITCH_ENUM_BUG
745 switch ((int) XTYPE (obj))
746 #else
747 switch (XTYPE (obj))
748 #endif
750 default:
751 /* We're in trouble if this happens!
752 Probably should just abort () */
753 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, printcharfun);
754 sprintf (buf, "(#o%3o)", (int) XTYPE (obj));
755 strout (buf, -1, printcharfun);
756 strout (" Save your buffers immediately and please report this bug>",
757 -1, printcharfun);
758 break;
760 #ifdef LISP_FLOAT_TYPE
761 case Lisp_Float:
763 char pigbuf[350]; /* see comments in float_to_string */
765 float_to_string (pigbuf, XFLOAT(obj)->data);
766 strout (pigbuf, -1, printcharfun);
768 break;
769 #endif /* LISP_FLOAT_TYPE */
771 case Lisp_Int:
772 sprintf (buf, "%d", XINT (obj));
773 strout (buf, -1, printcharfun);
774 break;
776 case Lisp_String:
777 if (!escapeflag)
778 print_string (obj, printcharfun);
779 else
781 register int i;
782 register unsigned char c;
783 struct gcpro gcpro1;
785 GCPRO1 (obj);
787 #ifdef USE_TEXT_PROPERTIES
788 if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
790 PRINTCHAR ('#');
791 PRINTCHAR ('(');
793 #endif
795 PRINTCHAR ('\"');
796 for (i = 0; i < XSTRING (obj)->size; i++)
798 QUIT;
799 c = XSTRING (obj)->data[i];
800 if (c == '\n' && print_escape_newlines)
802 PRINTCHAR ('\\');
803 PRINTCHAR ('n');
805 else if (c == '\f' && print_escape_newlines)
807 PRINTCHAR ('\\');
808 PRINTCHAR ('f');
810 else
812 if (c == '\"' || c == '\\')
813 PRINTCHAR ('\\');
814 PRINTCHAR (c);
817 PRINTCHAR ('\"');
819 #ifdef USE_TEXT_PROPERTIES
820 if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
822 traverse_intervals (XSTRING (obj)->intervals,
823 0, 0, print_interval, printcharfun);
824 PRINTCHAR (')');
826 #endif
828 UNGCPRO;
830 break;
832 case Lisp_Symbol:
834 register int confusing;
835 register unsigned char *p = XSYMBOL (obj)->name->data;
836 register unsigned char *end = p + XSYMBOL (obj)->name->size;
837 register unsigned char c;
839 if (p != end && (*p == '-' || *p == '+')) p++;
840 if (p == end)
841 confusing = 0;
842 else
844 while (p != end && *p >= '0' && *p <= '9')
845 p++;
846 confusing = (end == p);
849 p = XSYMBOL (obj)->name->data;
850 while (p != end)
852 QUIT;
853 c = *p++;
854 if (escapeflag)
856 if (c == '\"' || c == '\\' || c == '\'' || c == ';' || c == '#' ||
857 c == '(' || c == ')' || c == ',' || c =='.' || c == '`' ||
858 c == '[' || c == ']' || c == '?' || c <= 040 || confusing)
859 PRINTCHAR ('\\'), confusing = 0;
861 PRINTCHAR (c);
864 break;
866 case Lisp_Cons:
867 /* If deeper than spec'd depth, print placeholder. */
868 if (XTYPE (Vprint_level) == Lisp_Int
869 && print_depth > XINT (Vprint_level))
871 strout ("...", -1, printcharfun);
872 break;
875 PRINTCHAR ('(');
877 register int i = 0;
878 register int max = 0;
880 if (XTYPE (Vprint_length) == Lisp_Int)
881 max = XINT (Vprint_length);
882 /* Could recognize circularities in cdrs here,
883 but that would make printing of long lists quadratic.
884 It's not worth doing. */
885 while (CONSP (obj))
887 if (i++)
888 PRINTCHAR (' ');
889 if (max && i > max)
891 strout ("...", 3, printcharfun);
892 break;
894 print (Fcar (obj), printcharfun, escapeflag);
895 obj = Fcdr (obj);
898 if (!NILP (obj) && !CONSP (obj))
900 strout (" . ", 3, printcharfun);
901 print (obj, printcharfun, escapeflag);
903 PRINTCHAR (')');
904 break;
906 case Lisp_Compiled:
907 strout ("#", -1, printcharfun);
908 case Lisp_Vector:
909 PRINTCHAR ('[');
911 register int i;
912 register Lisp_Object tem;
913 for (i = 0; i < XVECTOR (obj)->size; i++)
915 if (i) PRINTCHAR (' ');
916 tem = XVECTOR (obj)->contents[i];
917 print (tem, printcharfun, escapeflag);
920 PRINTCHAR (']');
921 break;
923 #ifndef standalone
924 case Lisp_Buffer:
925 if (NILP (XBUFFER (obj)->name))
926 strout ("#<killed buffer>", -1, printcharfun);
927 else if (escapeflag)
929 strout ("#<buffer ", -1, printcharfun);
930 print_string (XBUFFER (obj)->name, printcharfun);
931 PRINTCHAR ('>');
933 else
934 print_string (XBUFFER (obj)->name, printcharfun);
935 break;
937 case Lisp_Process:
938 if (escapeflag)
940 strout ("#<process ", -1, printcharfun);
941 print_string (XPROCESS (obj)->name, printcharfun);
942 PRINTCHAR ('>');
944 else
945 print_string (XPROCESS (obj)->name, printcharfun);
946 break;
948 case Lisp_Window:
949 strout ("#<window ", -1, printcharfun);
950 sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number));
951 strout (buf, -1, printcharfun);
952 if (!NILP (XWINDOW (obj)->buffer))
954 strout (" on ", -1, printcharfun);
955 print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun);
957 PRINTCHAR ('>');
958 break;
960 case Lisp_Window_Configuration:
961 strout ("#<window-configuration>", -1, printcharfun);
962 break;
964 #ifdef MULTI_FRAME
965 case Lisp_Frame:
966 strout ((FRAME_LIVE_P (XFRAME (obj))
967 ? "#<frame " : "#<dead frame "),
968 -1, printcharfun);
969 print_string (XFRAME (obj)->name, printcharfun);
970 sprintf (buf, " 0x%x", (unsigned int) (XFRAME (obj)));
971 strout (buf, -1, printcharfun);
972 strout (">", -1, printcharfun);
973 break;
974 #endif /* MULTI_FRAME */
976 case Lisp_Marker:
977 strout ("#<marker ", -1, printcharfun);
978 if (!(XMARKER (obj)->buffer))
979 strout ("in no buffer", -1, printcharfun);
980 else
982 sprintf (buf, "at %d", marker_position (obj));
983 strout (buf, -1, printcharfun);
984 strout (" in ", -1, printcharfun);
985 print_string (XMARKER (obj)->buffer->name, printcharfun);
987 PRINTCHAR ('>');
988 break;
990 case Lisp_Overlay:
991 strout ("#<overlay ", -1, printcharfun);
992 if (!(XMARKER (OVERLAY_START (obj))->buffer))
993 strout ("in no buffer", -1, printcharfun);
994 else
996 sprintf (buf, "from %d to %d in ",
997 marker_position (OVERLAY_START (obj)),
998 marker_position (OVERLAY_END (obj)));
999 strout (buf, -1, printcharfun);
1000 print_string (XMARKER (OVERLAY_START (obj))->buffer->name,
1001 printcharfun);
1003 PRINTCHAR ('>');
1004 break;
1006 #endif /* standalone */
1008 case Lisp_Subr:
1009 strout ("#<subr ", -1, printcharfun);
1010 strout (XSUBR (obj)->symbol_name, -1, printcharfun);
1011 PRINTCHAR ('>');
1012 break;
1015 print_depth--;
1018 #ifdef USE_TEXT_PROPERTIES
1020 /* Print a description of INTERVAL using PRINTCHARFUN.
1021 This is part of printing a string that has text properties. */
1023 void
1024 print_interval (interval, printcharfun)
1025 INTERVAL interval;
1026 Lisp_Object printcharfun;
1028 PRINTCHAR (' ');
1029 print (make_number (interval->position), printcharfun, 1);
1030 PRINTCHAR (' ');
1031 print (make_number (interval->position + LENGTH (interval)),
1032 printcharfun, 1);
1033 PRINTCHAR (' ');
1034 print (interval->plist, printcharfun, 1);
1037 #endif /* USE_TEXT_PROPERTIES */
1039 void
1040 syms_of_print ()
1042 staticpro (&Qprint_escape_newlines);
1043 Qprint_escape_newlines = intern ("print-escape-newlines");
1045 DEFVAR_LISP ("standard-output", &Vstandard_output,
1046 "Output stream `print' uses by default for outputting a character.\n\
1047 This may be any function of one argument.\n\
1048 It may also be a buffer (output is inserted before point)\n\
1049 or a marker (output is inserted and the marker is advanced)\n\
1050 or the symbol t (output appears in the minibuffer line).");
1051 Vstandard_output = Qt;
1052 Qstandard_output = intern ("standard-output");
1053 staticpro (&Qstandard_output);
1055 #ifdef LISP_FLOAT_TYPE
1056 DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
1057 "The format descriptor string used to print floats.\n\
1058 This is a %-spec like those accepted by `printf' in C,\n\
1059 but with some restrictions. It must start with the two characters `%.'.\n\
1060 After that comes an integer precision specification,\n\
1061 and then a letter which controls the format.\n\
1062 The letters allowed are `e', `f' and `g'.\n\
1063 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1064 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1065 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1066 The precision in any of these cases is the number of digits following\n\
1067 the decimal point. With `f', a precision of 0 means to omit the\n\
1068 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1069 A value of nil means to use `%.17g'.");
1070 Vfloat_output_format = Qnil;
1071 Qfloat_output_format = intern ("float-output-format");
1072 staticpro (&Qfloat_output_format);
1073 #endif /* LISP_FLOAT_TYPE */
1075 DEFVAR_LISP ("print-length", &Vprint_length,
1076 "Maximum length of list to print before abbreviating.\n\
1077 A value of nil means no limit.");
1078 Vprint_length = Qnil;
1080 DEFVAR_LISP ("print-level", &Vprint_level,
1081 "Maximum depth of list nesting to print before abbreviating.\n\
1082 A value of nil means no limit.");
1083 Vprint_level = Qnil;
1085 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
1086 "Non-nil means print newlines in strings as backslash-n.\n\
1087 Also print formfeeds as backslash-f.");
1088 print_escape_newlines = 0;
1090 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1091 staticpro (&Vprin1_to_string_buffer);
1093 defsubr (&Sprin1);
1094 defsubr (&Sprin1_to_string);
1095 defsubr (&Sprinc);
1096 defsubr (&Sprint);
1097 defsubr (&Sterpri);
1098 defsubr (&Swrite_char);
1099 defsubr (&Sexternal_debugging_output);
1101 Qexternal_debugging_output = intern ("external-debugging-output");
1102 staticpro (&Qexternal_debugging_output);
1104 #ifndef standalone
1105 defsubr (&Swith_output_to_temp_buffer);
1106 #endif /* not standalone */