Mercurial > hg > xemacs-beta

comparison src/print.c @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 1986, 1988, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995, 1996 Ben Wing.
4
5 This file is part of XEmacs.
6
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 /* Synched up with: Not synched with FSF. */
23
24 /* This file has been Mule-ized. */
25
26 /* Seriously hacked on by Ben Wing for Mule. */
27
28 #include <config.h>
29 #include "lisp.h"
30
31 #ifndef standalone
32 #include "backtrace.h"
33 #include "buffer.h"
34 #include "bytecode.h"
35 #include "console-tty.h"
36 #include "console-stream.h"
37 #include "extents.h"
38 #include "frame.h"
39 #include "emacsfns.h"
40 #include "insdel.h"
41 #include "lstream.h"
42
43 #endif /* not standalone */
44
45 Lisp_Object Vstandard_output, Qstandard_output;
46
47 /* The subroutine object for external-debugging-output is kept here
48 for the convenience of the debugger. */
49 Lisp_Object Qexternal_debugging_output;
50 Lisp_Object Qalternate_debugging_output;
51
52 /* Avoid actual stack overflow in print. */
53 static int print_depth;
54
55 /* Maximum length of list or vector to print in full; noninteger means
56 effectively infinity */
57
58 Lisp_Object Vprint_length;
59 Lisp_Object Qprint_length;
60
61 /* Maximum length of string to print in full; noninteger means
62 effectively infinity */
63
64 Lisp_Object Vprint_string_length;
65 Lisp_Object Qprint_string_length;
66
67 /* Maximum depth of list to print in full; noninteger means
68 effectively infinity. */
69
70 Lisp_Object Vprint_level;
71
72 /* Label to use when making echo-area messages. */
73
74 Lisp_Object Vprint_message_label;
75
76 /* Nonzero means print newlines in strings as \n. */
77
78 int print_escape_newlines;
79 int print_readably;
80 int print_gensym;
81
82 Lisp_Object Qprint_escape_newlines;
83 Lisp_Object Qprint_readably;
84
85 /* Force immediate output of all printed data. Used for debugging. */
86 int print_unbuffered;
87
88 FILE *termscript; /* Stdio stream being used for copy of all output. */
89
90
91
92 int stdout_needs_newline;
93
94 /* Write a string (in internal format) to stdio stream STREAM. */
95
96 void
97 write_string_to_stdio_stream (FILE *stream, struct console *con,
98 CONST Bufbyte *str,
99 Bytecount offset, Bytecount len,
100 enum external_data_format fmt)
101 {
102 int extlen;
103 CONST Extbyte *extptr;
104
105 GET_CHARPTR_EXT_DATA_ALLOCA (str + offset, len, fmt, extptr, extlen);
106 if (stream)
107 fwrite (extptr, 1, extlen, stream);
108 else
109 {
110 assert (CONSOLE_TTY_P (con));
111 Lstream_write (XLSTREAM (CONSOLE_TTY_DATA (con)->outstream),
112 extptr, extlen);
113 }
114 if (stream == stdout || stream == stderr ||
115 (!stream && CONSOLE_TTY_DATA (con)->is_stdio))
116 {
117 if (termscript)
118 {
119 fwrite (extptr, 1, extlen, termscript);
120 fflush (termscript);
121 }
122 stdout_needs_newline = (extptr[extlen - 1] != '\n');
123 }
124 }
125
126 /* Write a string to the output location specified in FUNCTION.
127 Arguments NONRELOC, RELOC, OFFSET, and LEN are as in
128 buffer_insert_string_1() in insdel.c. */
129
130 static void
131 output_string (Lisp_Object function, CONST Bufbyte *nonreloc,
132 Lisp_Object reloc, Bytecount offset, Bytecount len)
133 {
134 /* This function can GC */
135 Charcount ccoff, cclen;
136 /* We change the value of nonreloc (fetching it from reloc as
137 necessary), but we don't want to pass this changed value on to
138 other functions that take both a nonreloc and a reloc, or things
139 may get confused and an assertion failure in
140 fixup_internal_substring() may get triggered. */
141 CONST Bufbyte *newnonreloc = nonreloc;
142 struct gcpro gcpro1, gcpro2;
143
144 /* Emacs won't print whilst GCing, but an external debugger might */
145 if (gc_in_progress) return;
146
147 /* Perhaps not necessary but probably safer. */
148 GCPRO2 (function, reloc);
149
150 fixup_internal_substring (newnonreloc, reloc, offset, &len);
151
152 if (STRINGP (reloc))
153 newnonreloc = string_data (XSTRING (reloc));
154
155 ccoff = bytecount_to_charcount (newnonreloc, offset);
156 cclen = bytecount_to_charcount (newnonreloc + offset, len);
157
158 if (LSTREAMP (function))
159 {
160 /* Lstream_write() could easily cause GC inside of it, if the
161 stream is a print-stream. (It will call output_string()
162 recursively.) This is probably the fastest way to fix this
163 problem. (alloca() is very fast on machines that have it
164 built-in, and you avoid some nasty problems with recursion
165 that could result from using a static buffer somewhere.)
166
167 The other possibility is to inhibit GC, but that of course
168 would require an unwind-protect, which is usually a lot
169 slower than the small amount of memcpy()ing that happens
170 here. */
171 if (STRINGP (reloc))
172 {
173 Bufbyte *copied = (Bufbyte *) alloca (len);
174 memcpy (copied, newnonreloc + offset, len);
175 Lstream_write (XLSTREAM (function), copied, len);
176 }
177 else
178 Lstream_write (XLSTREAM (function), newnonreloc + offset, len);
179
180 if (print_unbuffered)
181 Lstream_flush (XLSTREAM (function));
182 }
183
184 #ifndef standalone
185 else if (BUFFERP (function))
186 {
187 CHECK_LIVE_BUFFER (function);
188 buffer_insert_string (XBUFFER (function), nonreloc, reloc, offset, len);
189 }
190 else if (MARKERP (function))
191 {
192 /* marker_position will err if marker doesn't point anywhere */
193 Bufpos spoint = marker_position (function);
194
195 buffer_insert_string_1 (XBUFFER (Fmarker_buffer (function)),
196 spoint, nonreloc, reloc, offset, len,
197 0);
198 Fset_marker (function, make_int (spoint + cclen),
199 Fmarker_buffer (function));
200 }
201 else if (FRAMEP (function))
202 {
203 struct frame *f = XFRAME (function);
204 if (!EQ (Vprint_message_label, echo_area_status (f)))
205 clear_echo_area_from_print (f, Qnil, 1);
206 echo_area_append (f, nonreloc, reloc, offset, len, Vprint_message_label);
207 }
208 #endif /* not standalone */
209 else if (EQ (function, Qt) || EQ (function, Qnil))
210 {
211 write_string_to_stdio_stream (stdout, 0, newnonreloc, offset, len,
212 FORMAT_DISPLAY);
213 }
214 else
215 {
216 Charcount iii;
217
218 for (iii = ccoff; iii < cclen + ccoff; iii++)
219 {
220 call1 (function,
221 make_char (charptr_emchar_n (newnonreloc, iii)));
222 if (STRINGP (reloc))
223 newnonreloc = string_data (XSTRING (reloc));
224 }
225 }
226
227 UNGCPRO;
228 }
229
230 struct print_stream
231 {
232 FILE *file;
233 Lisp_Object fun;
234 };
235
236 #define get_print_stream(stream) \
237 ((struct print_stream *) Lstream_data (stream))
238
239 DEFINE_LSTREAM_IMPLEMENTATION ("print", lstream_print,
240 sizeof (struct print_stream));
241
242 static Lisp_Object
243 make_print_output_stream (FILE *file, Lisp_Object fun)
244 {
245 Lstream *str = Lstream_new (lstream_print, "w");
246 struct print_stream *ps = get_print_stream (str);
247 Lisp_Object val = Qnil;
248
249 Lstream_set_character_mode (str);
250 ps->file = file;
251 ps->fun = fun;
252 XSETLSTREAM (val, str);
253 return val;
254 }
255
256 /* #### This isn't being used anywhere at the moment. Is it supposed
257 to be? */
258 #if 0
259 static void
260 reset_print_stream (Lstream *str, FILE *file, Lisp_Object fun)
261 {
262 struct print_stream *ps = get_print_stream (str);
263
264 Lstream_reopen (str);
265 ps->file = file;
266 ps->fun = fun;
267 }
268 #endif
269
270 static Lisp_Object
271 print_marker (Lisp_Object obj, void (*markobj) (Lisp_Object))
272 {
273 return get_print_stream (XLSTREAM (obj))->fun;
274 }
275
276 static int
277 print_writer (Lstream *stream, CONST unsigned char *data, int size)
278 {
279 struct print_stream *ps = get_print_stream (stream);
280
281 if (ps->file)
282 {
283 write_string_to_stdio_stream (ps->file, 0, data, 0, size,
284 FORMAT_DISPLAY);
285 /* Make sure it really gets written now. */
286 if (print_unbuffered)
287 fflush (ps->file);
288 }
289 else
290 output_string (ps->fun, data, Qnil, 0, size);
291 return size;
292 }
293
294 static Lisp_Object
295 canonicalize_printcharfun (Lisp_Object printcharfun)
296 {
297 if (NILP (printcharfun))
298 printcharfun = Vstandard_output;
299
300 if (EQ (printcharfun, Qt) || NILP (printcharfun))
301 {
302 #ifndef standalone
303 printcharfun = Fselected_frame (Qnil); /* print to minibuffer */
304 #endif
305 }
306 return (printcharfun);
307 }
308
309
310 static Lisp_Object
311 print_prepare (Lisp_Object printcharfun)
312 {
313 FILE *stdio_stream = 0;
314
315 /* Emacs won't print whilst GCing, but an external debugger might */
316 if (gc_in_progress)
317 return (Qnil);
318
319 printcharfun = canonicalize_printcharfun (printcharfun);
320 if (EQ (printcharfun, Qnil))
321 {
322 stdio_stream = stdout;
323 }
324 #if 0 /* Don't bother */
325 else if (SUBRP (indirect_function (printcharfun, 0))
326 && (XSUBR (indirect_function (printcharfun, 0))
327 == Sexternal_debugging_output))
328 {
329 stdio_stream = stderr;
330 }
331 #endif
332
333 return make_print_output_stream (stdio_stream, printcharfun);
334 }
335
336 static void
337 print_finish (Lisp_Object stream)
338 {
339 /* Emacs won't print whilst GCing, but an external debugger might */
340 if (gc_in_progress)
341 return;
342
343 Lstream_delete (XLSTREAM (stream));
344 }
345
346 #if 1 /* Prefer space over "speed" */
347 #define write_char_internal(string_of_length_1, stream) \
348 write_string_1 ((CONST Bufbyte *) (string_of_length_1), 1, (stream))
349 #else
350 #define write_char_internal(string_of_length_1, stream) \
351 output_string ((stream), (CONST Bufbyte *) (string_of_length_1), Qnil, 0, 1)
352 #endif
353
354 /* NOTE: Do not call this with the data of a Lisp_String,
355 * as printcharfun might cause a GC, which might cause
356 * the string's data to be relocated.
357 * Use print_object_internal (string, printcharfun, 0)
358 * to princ a Lisp_String
359 * Note: "stream" should be the result of "canonicalize_printcharfun"
360 * (ie Qnil means stdout, not Vstandard_output, etc)
361 */
362 void
363 write_string_1 (CONST Bufbyte *str, Bytecount size, Lisp_Object stream)
364 {
365 /* This function can GC */
366 assert (size >= 0);
367 output_string (stream, str, Qnil, 0, size);
368 }
369
370 void
371 write_c_string (CONST char *str, Lisp_Object stream)
372 {
373 /* This function can GC */
374 write_string_1 ((CONST Bufbyte *) str, strlen (str), stream);
375 }
376
377
378 DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0 /*
379 Output character CH to stream STREAM.
380 STREAM defaults to the value of `standard-output' (which see).
381 */ )
382 (ch, stream)
383 Lisp_Object ch, stream;
384 {
385 /* This function can GC */
386 Bufbyte str[MAX_EMCHAR_LEN];
387 Bytecount len;
388
389 CHECK_CHAR_COERCE_INT (ch);
390 len = set_charptr_emchar (str, XCHAR (ch));
391 output_string (canonicalize_printcharfun (stream), str, Qnil, 0, len);
392 return ch;
393 }
394
395 #ifndef standalone
396
397 void
398 temp_output_buffer_setup (CONST char *bufname)
399 {
400 /* This function can GC */
401 struct buffer *old = current_buffer;
402 Lisp_Object buf;
403
404 #ifdef I18N3
405 /* #### This function should accept a Lisp_Object instead of a char *,
406 so that proper translation on the buffer name can occur. */
407 #endif
408
409 Fset_buffer (Fget_buffer_create (build_string (bufname)));
410
411 current_buffer->read_only = Qnil;
412 Ferase_buffer (Fcurrent_buffer ());
413
414 XSETBUFFER (buf, current_buffer);
415 specbind (Qstandard_output, buf);
416
417 set_buffer_internal (old);
418 }
419
420 Lisp_Object
421 internal_with_output_to_temp_buffer (CONST char *bufname,
422 Lisp_Object (*function) (Lisp_Object arg),
423 Lisp_Object arg,
424 Lisp_Object same_frame)
425 {
426 int speccount = specpdl_depth ();
427 struct gcpro gcpro1, gcpro2, gcpro3;
428 Lisp_Object buf = Qnil;
429
430 GCPRO3 (buf, arg, same_frame);
431
432 temp_output_buffer_setup (GETTEXT (bufname));
433 buf = Vstandard_output;
434
435 arg = (*function) (arg);
436
437 temp_output_buffer_show (buf, same_frame);
438 UNGCPRO;
439
440 return unbind_to (speccount, arg);
441 }
442
443 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
444 1, UNEVALLED, 0 /*
445 Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
446 The buffer is cleared out initially, and marked as unmodified when done.
447 All output done by BODY is inserted in that buffer by default.
448 The buffer is displayed in another window, but not selected.
449 The value of the last form in BODY is returned.
450 If BODY does not finish normally, the buffer BUFNAME is not displayed.
451
452 If variable `temp-buffer-show-function' is non-nil, call it at the end
453 to get the buffer displayed. It gets one argument, the buffer to display.
454 */ )
455 (args)
456 Lisp_Object args;
457 {
458 /* This function can GC */
459 struct gcpro gcpro1;
460 Lisp_Object name;
461 int speccount = specpdl_depth ();
462 Lisp_Object buf, val;
463
464 #ifdef I18N3
465 /* #### should set the buffer to be translating. See print_internal(). */
466 #endif
467
468 GCPRO1 (args);
469 name = Feval (Fcar (args));
470 UNGCPRO;
471
472 CHECK_STRING (name);
473 temp_output_buffer_setup ((char *) string_data (XSTRING (name)));
474 buf = Vstandard_output;
475
476 val = Fprogn (Fcdr (args));
477
478 temp_output_buffer_show (buf, Qnil);
479
480 return unbind_to (speccount, val);
481 }
482 #endif /* not standalone */
483
484 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0 /*
485 Output a newline to STREAM.
486 If STREAM is omitted or nil, the value of `standard-output' is used.
487 */ )
488 (stream)
489 Lisp_Object stream;
490 {
491 /* This function can GC */
492 Bufbyte str[1];
493 str[0] = '\n';
494 output_string (canonicalize_printcharfun (stream), str, Qnil, 0, 1);
495 return Qt;
496 }
497
498 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0 /*
499 Output the printed representation of OBJECT, any Lisp object.
500 Quoting characters are printed when needed to make output that `read'
501 can handle, whenever this is possible.
502 Output stream is STREAM, or value of `standard-output' (which see).
503 */ )
504 (object, stream)
505 Lisp_Object object, stream;
506 {
507 /* This function can GC */
508 Lisp_Object the_stream = Qnil;
509 struct gcpro gcpro1, gcpro2, gcpro3;
510
511 GCPRO3 (object, stream, the_stream);
512 print_depth = 0;
513 the_stream = print_prepare (stream);
514 print_internal (object, the_stream, 1);
515 print_finish (the_stream);
516 UNGCPRO;
517 return object;
518 }
519
520 /* a buffer which is used to hold output being built by prin1-to-string */
521 Lisp_Object Vprin1_to_string_buffer;
522
523 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0 /*
524 Return a string containing the printed representation of OBJECT,
525 any Lisp object. Quoting characters are used when needed to make output
526 that `read' can handle, whenever this is possible, unless the optional
527 second argument NOESCAPE is non-nil.
528 */ )
529 (object, noescape)
530 Lisp_Object object, noescape;
531 {
532 /* This function can GC */
533 Lisp_Object old = Fcurrent_buffer ();
534 struct buffer *out = XBUFFER (Vprin1_to_string_buffer);
535 Lisp_Object stream = Qnil;
536 struct gcpro gcpro1, gcpro2, gcpro3;
537
538 GCPRO3 (object, old, stream);
539 stream = print_prepare (Vprin1_to_string_buffer);
540 set_buffer_internal (out);
541 Ferase_buffer (Fcurrent_buffer ());
542 print_depth = 0;
543 print_internal (object, stream, NILP (noescape));
544 print_finish (stream);
545 stream = Qnil; /* No GC surprises! */
546 object = make_string_from_buffer (out,
547 BUF_BEG (out),
548 BUF_Z (out) - 1);
549 Ferase_buffer (Fcurrent_buffer ());
550 Fset_buffer (old);
551 UNGCPRO;
552 return (object);
553 }
554
555 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0 /*
556 Output the printed representation of OBJECT, any Lisp object.
557 No quoting characters are used; no delimiters are printed around
558 the contents of strings.
559 Output stream is STREAM, or value of standard-output (which see).
560 */ )
561 (obj, stream)
562 Lisp_Object obj, stream;
563 {
564 /* This function can GC */
565 Lisp_Object the_stream = Qnil;
566 struct gcpro gcpro1, gcpro2, gcpro3;
567
568 GCPRO3 (obj, stream, the_stream);
569 the_stream = print_prepare (stream);
570 print_depth = 0;
571 print_internal (obj, the_stream, 0);
572 print_finish (the_stream);
573 UNGCPRO;
574 return (obj);
575 }
576
577 DEFUN ("print", Fprint, Sprint, 1, 2, 0 /*
578 Output the printed representation of OBJECT, with newlines around it.
579 Quoting characters are printed when needed to make output that `read'
580 can handle, whenever this is possible.
581 Output stream is STREAM, or value of `standard-output' (which see).
582 */ )
583 (obj, stream)
584 Lisp_Object obj, stream;
585 {
586 /* This function can GC */
587 Lisp_Object the_stream = Qnil;
588 struct gcpro gcpro1, gcpro2, gcpro3;
589
590 GCPRO3 (obj, stream, the_stream);
591 the_stream = print_prepare (stream);
592 print_depth = 0;
593 write_char_internal ("\n", the_stream);
594 print_internal (obj, the_stream, 1);
595 write_char_internal ("\n", the_stream);
596 print_finish (the_stream);
597 UNGCPRO;
598 return obj;
599 }
600
601 #ifdef LISP_FLOAT_TYPE
602
603 Lisp_Object Vfloat_output_format;
604 Lisp_Object Qfloat_output_format;
605
606 void
607 float_to_string (char *buf, double data)
608 /*
609 * This buffer should be at least as large as the max string size of the
610 * largest float, printed in the biggest notation. This is undoubtably
611 * 20d float_output_format, with the negative of the C-constant "HUGE"
612 * from <math.h>.
613 *
614 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
615 *
616 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
617 * case of -1e307 in 20d float_output_format. What is one to do (short of
618 * re-writing _doprnt to be more sane)?
619 * -wsr
620 */
621 {
622 Bufbyte *cp, c;
623 int width;
624
625 if (NILP (Vfloat_output_format)
626 || !STRINGP (Vfloat_output_format))
627 lose:
628 sprintf (buf, "%.16g", data);
629 else /* oink oink */
630 {
631 /* Check that the spec we have is fully valid.
632 This means not only valid for printf,
633 but meant for floats, and reasonable. */
634 cp = string_data (XSTRING (Vfloat_output_format));
635
636 if (cp[0] != '%')
637 goto lose;
638 if (cp[1] != '.')
639 goto lose;
640
641 cp += 2;
642 for (width = 0; (c = *cp, isdigit (c)); cp++)
643 {
644 width *= 10;
645 width += c - '0';
646 }
647
648 if (*cp != 'e' && *cp != 'f' && *cp != 'g' && *cp != 'E' && *cp != 'G')
649 goto lose;
650
651 if (width < (int) (*cp != 'e' && *cp != 'E') || width > DBL_DIG)
652 goto lose;
653
654 if (cp[1] != 0)
655 goto lose;
656
657 sprintf (buf, (char *) string_data (XSTRING (Vfloat_output_format)),
658 data);
659 }
660
661 /* added by jwz: don't allow "1.0" to print as "1"; that destroys
662 the read-equivalence of lisp objects. (* x 1) and (* x 1.0) do
663 not do the same thing, so it's important that the printed
664 representation of that form not be corrupted by the printer.
665 */
666 {
667 Bufbyte *s = (Bufbyte *) buf; /* don't use signed chars here!
668 isdigit() can't hack them! */
669 if (*s == '-') s++;
670 for (; *s; s++)
671 /* if there's a non-digit, then there is a decimal point, or
672 it's in exponential notation, both of which are ok. */
673 if (!isdigit (*s))
674 goto DONE_LABEL;
675 /* otherwise, we need to hack it. */
676 *s++ = '.';
677 *s++ = '0';
678 *s = 0;
679 }
680 DONE_LABEL:
681
682 /* Some machines print "0.4" as ".4". I don't like that. */
683 if (buf [0] == '.' || (buf [0] == '-' && buf [1] == '.'))
684 {
685 int i;
686 for (i = strlen (buf) + 1; i >= 0; i--)
687 buf [i+1] = buf [i];
688 buf [(buf [0] == '-' ? 1 : 0)] = '0';
689 }
690 }
691 #endif /* LISP_FLOAT_TYPE */
692
693 static void
694 print_vector_internal (CONST char *start, CONST char *end,
695 Lisp_Object obj,
696 Lisp_Object printcharfun, int escapeflag)
697 {
698 /* This function can GC */
699 int i;
700 int len = vector_length (XVECTOR (obj));
701 int last = len;
702 struct gcpro gcpro1, gcpro2;
703 GCPRO2 (obj, printcharfun);
704
705 if (INTP (Vprint_length))
706 {
707 int max = XINT (Vprint_length);
708 if (max < len) last = max;
709 }
710
711 write_c_string (start, printcharfun);
712 for (i = 0; i < last; i++)
713 {
714 Lisp_Object elt = vector_data (XVECTOR (obj))[i];
715 if (i != 0) write_char_internal (" ", printcharfun);
716 print_internal (elt, printcharfun, escapeflag);
717 }
718 UNGCPRO;
719 if (last != len)
720 write_c_string (" ...", printcharfun);
721 write_c_string (end, printcharfun);
722 }
723
724 static void
725 default_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
726 int escapeflag)
727 {
728 struct lcrecord_header *header =
729 (struct lcrecord_header *) XPNTR (obj);
730 char buf[200];
731
732 if (print_readably)
733 error ("printing unreadable object #<%s 0x%x>",
734 header->lheader.implementation->name, header->uid);
735
736 sprintf (buf, "#<%s 0x%x>", header->lheader.implementation->name,
737 header->uid);
738 write_c_string (buf, printcharfun);
739 }
740
741 void
742 internal_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
743 int escapeflag)
744 {
745 char buf[200];
746 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s) 0x%x>",
747 XRECORD_LHEADER (obj)->implementation->name,
748 (EMACS_INT) XPNTR (obj));
749 write_c_string (buf, printcharfun);
750 }
751
752 void
753 print_internal (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
754 {
755 /* This function can GC */
756 char buf[256];
757
758 QUIT;
759
760 /* Emacs won't print whilst GCing, but an external debugger might */
761 if (gc_in_progress) return;
762
763 #ifdef I18N3
764 /* #### Both input and output streams should have a flag associated
765 with them indicating whether output to that stream, or strings
766 read from the stream, get translated using Fgettext(). Such a
767 stream is called a "translating stream". For the minibuffer and
768 external-debugging-output this is always true on output, and
769 with-output-to-temp-buffer sets the flag to true for the buffer
770 it creates. This flag should also be user-settable. Perhaps it
771 should be split up into two flags, one for input and one for
772 output. */
773 #endif
774
775 print_depth++;
776
777 if (print_depth > 200)
778 error ("Apparently circular structure being printed");
779
780 switch (XTYPE (obj))
781 {
782 case Lisp_Int:
783 {
784 sprintf (buf, "%d", XINT (obj));
785 write_c_string (buf, printcharfun);
786 break;
787 }
788
789 case Lisp_String:
790 {
791 Bytecount size = string_length (XSTRING (obj));
792 struct gcpro gcpro1, gcpro2;
793 int max = size;
794 GCPRO2 (obj, printcharfun);
795
796 if (INTP (Vprint_string_length) &&
797 XINT (Vprint_string_length) < max)
798 max = XINT (Vprint_string_length);
799 if (max < 0)
800 max = 0;
801
802 /* !!#### This handles MAX incorrectly for Mule. */
803 if (!escapeflag)
804 {
805 /* This deals with GC-relocation */
806 output_string (printcharfun, 0, obj, 0, max);
807 if (max < size)
808 write_c_string (" ...", printcharfun);
809 }
810 else
811 {
812 Bytecount i;
813 struct Lisp_String *s = XSTRING (obj);
814 Bytecount last = 0;
815
816 write_char_internal ("\"", printcharfun);
817 for (i = 0; i < max; i++)
818 {
819 Bufbyte ch = string_byte (s, i);
820 if (ch == '\"' || ch == '\\'
821 || (ch == '\n' && print_escape_newlines))
822 {
823 if (i > last)
824 {
825 output_string (printcharfun, 0, obj, last,
826 i - last);
827 }
828 if (ch == '\n')
829 {
830 write_c_string ("\\n", printcharfun);
831 }
832 else
833 {
834 write_char_internal ("\\", printcharfun);
835 /* This is correct for Mule because the
836 character is either \ or " */
837 write_char_internal ((char *) (string_data (s) + i),
838 printcharfun);
839 }
840 last = i + 1;
841 }
842 }
843 if (max > last)
844 {
845 output_string (printcharfun, 0, obj, last,
846 max - last);
847 }
848 if (max < size)
849 write_c_string (" ...", printcharfun);
850 write_char_internal ("\"", printcharfun);
851 }
852 UNGCPRO;
853 break;
854 }
855
856 case Lisp_Cons:
857 {
858 struct gcpro gcpro1, gcpro2;
859
860 /* If deeper than spec'd depth, print placeholder. */
861 if (INTP (Vprint_level)
862 && print_depth > XINT (Vprint_level))
863 {
864 write_c_string ("...", printcharfun);
865 break;
866 }
867
868 /* If print_readably is on, print (quote -foo-) as '-foo-
869 (Yeah, this should really be what print-pretty does, but we
870 don't have the rest of a pretty printer, and this actually
871 has non-negligible impact on size/speed of .elc files.)
872 */
873 if (print_readably &&
874 EQ (XCAR (obj), Qquote) &&
875 CONSP (XCDR (obj)) &&
876 NILP (XCDR (XCDR (obj))))
877 {
878 obj = XCAR (XCDR (obj));
879 GCPRO2 (obj, printcharfun);
880 write_char_internal ("'", printcharfun);
881 UNGCPRO;
882 print_internal (obj, printcharfun, escapeflag);
883 break;
884 }
885
886 GCPRO2 (obj, printcharfun);
887 write_char_internal ("(", printcharfun);
888 {
889 int i = 0;
890 int max = 0;
891
892 if (INTP (Vprint_length))
893 max = XINT (Vprint_length);
894 while (CONSP (obj))
895 {
896 if (i++)
897 write_char_internal (" ", printcharfun);
898 if (max && i > max)
899 {
900 write_c_string ("...", printcharfun);
901 break;
902 }
903 print_internal (Fcar (obj), printcharfun,
904 escapeflag);
905 obj = Fcdr (obj);
906 }
907 }
908 if (!NILP (obj) && !CONSP (obj))
909 {
910 write_c_string (" . ", printcharfun);
911 print_internal (obj, printcharfun, escapeflag);
912 }
913 UNGCPRO;
914 write_char_internal (")", printcharfun);
915 break;
916 }
917
918 #ifndef LRECORD_VECTOR
919 case Lisp_Vector:
920 {
921 /* If deeper than spec'd depth, print placeholder. */
922 if (INTP (Vprint_level)
923 && print_depth > XINT (Vprint_level))
924 {
925 write_c_string ("...", printcharfun);
926 break;
927 }
928
929 /* God intended that this be #(...), you know. */
930 print_vector_internal ("[", "]", obj, printcharfun, escapeflag);
931 break;
932 }
933 #endif /* !LRECORD_VECTOR */
934
935 #ifndef LRECORD_SYMBOL
936 case Lisp_Symbol:
937 {
938 print_symbol (obj, printcharfun, escapeflag);
939 break;
940 }
941 #endif /* !LRECORD_SYMBOL */
942
943 case Lisp_Record:
944 {
945 struct lrecord_header *lheader = XRECORD_LHEADER (obj);
946 struct gcpro gcpro1, gcpro2;
947
948 GCPRO2 (obj, printcharfun);
949 if (lheader->implementation->printer)
950 ((lheader->implementation->printer)
951 (obj, printcharfun, escapeflag));
952 else
953 default_object_printer (obj, printcharfun, escapeflag);
954 UNGCPRO;
955 break;
956 }
957
958 default:
959 {
960 /* We're in trouble if this happens!
961 Probably should just abort () */
962 if (print_readably)
963 error ("printing illegal data type #o%03o",
964 (int) XTYPE (obj));
965 write_c_string ("#<EMACS BUG: ILLEGAL DATATYPE ",
966 printcharfun);
967 sprintf (buf, "(#o%3o)", (int) XTYPE (obj));
968 write_c_string (buf, printcharfun);
969 write_c_string
970 (" Save your buffers immediately and please report this bug>",
971 printcharfun);
972 break;
973 }
974 }
975
976 print_depth--;
977 }
978
979 static void
980 print_compiled_function_internal (CONST char *start, CONST char *end,
981 Lisp_Object obj,
982 Lisp_Object printcharfun, int escapeflag)
983 {
984 /* This function can GC */
985 struct Lisp_Compiled_Function *b =
986 XCOMPILED_FUNCTION (obj); /* GC doesn't relocate */
987 int docp = b->flags.documentationp;
988 int intp = b->flags.interactivep;
989 struct gcpro gcpro1, gcpro2;
990 char buf[100];
991 GCPRO2 (obj, printcharfun);
992
993 write_c_string (start, printcharfun);
994 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
995 if (!print_readably)
996 {
997 Lisp_Object ann = compiled_function_annotation (b);
998 if (!NILP (ann))
999 {
1000 write_c_string ("(from ", printcharfun);
1001 print_internal (ann, printcharfun, 1);
1002 write_c_string (") ", printcharfun);
1003 }
1004 }
1005 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
1006 /* COMPILED_ARGLIST = 0 */
1007 print_internal (b->arglist, printcharfun, escapeflag);
1008 /* COMPILED_BYTECODE = 1 */
1009 write_char_internal (" ", printcharfun);
1010 /* we don't really want to see that junk in the bytecode instructions. */
1011 if (STRINGP (b->bytecodes) && !print_readably)
1012 {
1013 sprintf (buf, "\"...(%ld)\"", string_length (XSTRING (b->bytecodes)));
1014 write_c_string (buf, printcharfun);
1015 }
1016 else
1017 print_internal (b->bytecodes, printcharfun, escapeflag);
1018 /* COMPILED_CONSTANTS = 2 */
1019 write_char_internal (" ", printcharfun);
1020 print_internal (b->constants, printcharfun, escapeflag);
1021 /* COMPILED_STACK_DEPTH = 3 */
1022 sprintf (buf, " %d", b->maxdepth);
1023 write_c_string (buf, printcharfun);
1024 /* COMPILED_DOC_STRING = 4 */
1025 if (docp || intp)
1026 {
1027 write_char_internal (" ", printcharfun);
1028 print_internal (compiled_function_documentation (b), printcharfun,
1029 escapeflag);
1030 }
1031 /* COMPILED_INTERACTIVE = 5 */
1032 if (intp)
1033 {
1034 write_char_internal (" ", printcharfun);
1035 print_internal (compiled_function_interactive (b), printcharfun,
1036 escapeflag);
1037 }
1038 UNGCPRO;
1039 write_c_string (end, printcharfun);
1040 }
1041
1042 void
1043 print_compiled_function (Lisp_Object obj, Lisp_Object printcharfun,
1044 int escapeflag)
1045 {
1046 /* This function can GC */
1047 print_compiled_function_internal (((print_readably) ? "#[" :
1048 "#<compiled-function "),
1049 ((print_readably) ? "]" : ">"),
1050 obj, printcharfun, escapeflag);
1051 }
1052
1053 #ifdef LISP_FLOAT_TYPE
1054 void
1055 print_float (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1056 {
1057 char pigbuf[350]; /* see comments in float_to_string */
1058
1059 float_to_string (pigbuf, float_data (XFLOAT (obj)));
1060 write_c_string (pigbuf, printcharfun);
1061 }
1062 #endif /* LISP_FLOAT_TYPE */
1063
1064 void
1065 print_symbol (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1066 {
1067 /* This function can GC */
1068 /* #### Bug!! (intern "") isn't printed in some distinguished way */
1069 /* #### (the reader also loses on it) */
1070 struct Lisp_String *name = XSYMBOL (obj)->name;
1071 Bytecount size = string_length (name);
1072 struct gcpro gcpro1, gcpro2;
1073
1074 if (!escapeflag)
1075 {
1076 /* This deals with GC-relocation */
1077 Lisp_Object nameobj;
1078 XSETSTRING (nameobj, name);
1079 output_string (printcharfun, 0, nameobj, 0, size);
1080 return;
1081 }
1082 GCPRO2 (obj, printcharfun);
1083
1084 if (print_gensym)
1085 {
1086 Lisp_Object tem = oblookup (Vobarray, string_data (name), size);
1087 if (!EQ (tem, obj))
1088 /* (read) would return a new symbol with the same name.
1089 This isn't quite correct, because that symbol might not
1090 really be uninterned (it might be interned in some other
1091 obarray) but there's no way to win in that case without
1092 implementing a real package system.
1093 */
1094 write_c_string ("#:", printcharfun);
1095 }
1096
1097 /* Does it look like an integer or a float? */
1098 {
1099 Bufbyte *data = string_data (name);
1100 Bytecount confusing = 0;
1101
1102 if (size == 0)
1103 goto not_yet_confused; /* Really confusing */
1104 else if (isdigit (data[0]))
1105 confusing = 0;
1106 else if (size == 1)
1107 goto not_yet_confused;
1108 else if (data[0] == '-' || data[0] == '+')
1109 confusing = 1;
1110 else
1111 goto not_yet_confused;
1112
1113 for (; confusing < size; confusing++)
1114 {
1115 if (!isdigit (data[confusing]))
1116 {
1117 confusing = 0;
1118 break;
1119 }
1120 }
1121 not_yet_confused:
1122
1123 #ifdef LISP_FLOAT_TYPE
1124 if (!confusing)
1125 confusing = isfloat_string ((char *) data);
1126 #endif
1127 if (confusing)
1128 write_char_internal ("\\", printcharfun);
1129 }
1130
1131 {
1132 Lisp_Object nameobj;
1133 Bytecount i;
1134 Bytecount last = 0;
1135
1136 XSETSTRING (nameobj, name);
1137 for (i = 0; i < size; i++)
1138 {
1139 Bufbyte c = string_byte (name, i);
1140
1141 if (c == '\"' || c == '\\' || c == '\'' || c == ';' || c == '#' ||
1142 c == '(' || c == ')' || c == ',' || c =='.' || c == '`' ||
1143 c == '[' || c == ']' || c == '?' || c <= 040)
1144 {
1145 if (i > last)
1146 {
1147 output_string (printcharfun, 0, nameobj, last,
1148 i - last);
1149 }
1150 write_char_internal ("\\", printcharfun);
1151 last = i;
1152 }
1153 }
1154 output_string (printcharfun, 0, nameobj, last, size - last);
1155 }
1156 UNGCPRO;
1157 }
1158
1159
1160 int alternate_do_pointer;
1161 char alternate_do_string[5000];
1162
1163 DEFUN ("alternate-debugging-output", Falternate_debugging_output,
1164 Salternate_debugging_output, 1, 1, 0 /*
1165 Append CHARACTER to the array `alternate_do_string'.
1166 This can be used in place of `external-debugging-output' as a function
1167 to be passed to `print'. Before calling `print', set `alternate_do_pointer'
1168 to 0.
1169
1170 */ )
1171 (character)
1172 Lisp_Object character;
1173 {
1174 Bufbyte str[MAX_EMCHAR_LEN];
1175 Bytecount len;
1176 int extlen;
1177 CONST Extbyte *extptr;
1178
1179 CHECK_CHAR_COERCE_INT (character);
1180 len = set_charptr_emchar (str, XCHAR (character));
1181 GET_CHARPTR_EXT_DATA_ALLOCA (str, len, FORMAT_DISPLAY, extptr, extlen);
1182 memcpy (alternate_do_string + alternate_do_pointer, extptr, extlen);
1183 alternate_do_pointer += extlen;
1184 alternate_do_string[alternate_do_pointer] = 0;
1185 return character;
1186 }
1187
1188 DEFUN ("external-debugging-output", Fexternal_debugging_output,
1189 Sexternal_debugging_output, 1, 3, 0 /*
1190 Write CHAR-OR-STRING to stderr or stdout.
1191 If optional arg STDOUT-P is non-nil, write to stdout; otherwise, write
1192 to stderr. You can use this function to write directly to the terminal.
1193 This function can be used as the STREAM argument of Fprint() or the like.
1194
1195 If you have opened a termscript file (using `open-termscript'), then
1196 the output also will be logged to this file.
1197 */ )
1198 (char_or_string, stdout_p, device)
1199 Lisp_Object char_or_string, stdout_p, device;
1200 {
1201 FILE *file = 0;
1202 struct console *con = 0;
1203
1204 if (NILP (device))
1205 {
1206 if (!NILP (stdout_p))
1207 file = stdout;
1208 else
1209 file = stderr;
1210 }
1211 else
1212 {
1213 CHECK_LIVE_DEVICE (device);
1214 if (!DEVICE_TTY_P (XDEVICE (device)) &&
1215 !DEVICE_STREAM_P (XDEVICE (device)))
1216 signal_simple_error ("Must be tty or stream device", device);
1217 con = XCONSOLE (DEVICE_CONSOLE (XDEVICE (device)));
1218 if (DEVICE_TTY_P (XDEVICE (device)))
1219 file = 0;
1220 else if (!NILP (stdout_p))
1221 file = CONSOLE_STREAM_DATA (con)->outfd;
1222 else
1223 file = CONSOLE_STREAM_DATA (con)->errfd;
1224 }
1225
1226 if (STRINGP (char_or_string))
1227 write_string_to_stdio_stream (file, con,
1228 string_data (XSTRING (char_or_string)),
1229 0, string_length (XSTRING (char_or_string)),
1230 FORMAT_DISPLAY);
1231 else
1232 {
1233 Bufbyte str[MAX_EMCHAR_LEN];
1234 Bytecount len;
1235
1236 CHECK_CHAR_COERCE_INT (char_or_string);
1237 len = set_charptr_emchar (str, XCHAR (char_or_string));
1238 write_string_to_stdio_stream (file, con, str, 0, len, FORMAT_DISPLAY);
1239 }
1240
1241 return char_or_string;
1242 }
1243
1244 DEFUN ("open-termscript", Fopen_termscript, Sopen_termscript,
1245 1, 1, "FOpen termscript file: " /*
1246 Start writing all terminal output to FILE as well as the terminal.
1247 FILE = nil means just close any termscript file currently open.
1248 */ )
1249 (file)
1250 Lisp_Object file;
1251 {
1252 /* This function can GC */
1253 if (termscript != 0)
1254 fclose (termscript);
1255 termscript = 0;
1256
1257 if (! NILP (file))
1258 {
1259 file = Fexpand_file_name (file, Qnil);
1260 termscript = fopen ((char *) string_data (XSTRING (file)), "w");
1261 if (termscript == 0)
1262 report_file_error ("Opening termscript", Fcons (file, Qnil));
1263 }
1264 return Qnil;
1265 }
1266
1267 #if 1
1268 /* Debugging kludge -- unbuffered */
1269 static int debug_print_length = 50;
1270 static int debug_print_level = 15;
1271 Lisp_Object debug_temp;
1272 void debug_print_no_newline (Lisp_Object debug_print_obj);
1273 void
1274 debug_print_no_newline (Lisp_Object debug_print_obj)
1275 {
1276 /* This function can GC */
1277 int old_print_readably = print_readably;
1278 int old_print_depth = print_depth;
1279 Lisp_Object old_print_length = Vprint_length;
1280 Lisp_Object old_print_level = Vprint_level;
1281 Lisp_Object old_inhibit_quit = Vinhibit_quit;
1282 struct gcpro gcpro1, gcpro2, gcpro3;
1283 GCPRO3 (old_print_level, old_print_length, old_inhibit_quit);
1284
1285 if (gc_in_progress)
1286 stderr_out ("** gc-in-progress! Bad idea to print anything! **\n");
1287
1288 print_depth = 0;
1289 print_readably = 0;
1290 print_unbuffered++;
1291 /* Could use unwind-protect, but why bother? */
1292 if (debug_print_length > 0)
1293 Vprint_length = make_int (debug_print_length);
1294 if (debug_print_level > 0)
1295 Vprint_level = make_int (debug_print_level);
1296 print_internal (debug_print_obj, Qexternal_debugging_output, 1);
1297 Vinhibit_quit = old_inhibit_quit;
1298 Vprint_level = old_print_level;
1299 Vprint_length = old_print_length;
1300 print_depth = old_print_depth;
1301 print_readably = old_print_readably;
1302 print_unbuffered--;
1303 UNGCPRO;
1304 }
1305
1306 void debug_print (Lisp_Object debug_print_obj);
1307 void
1308 debug_print (Lisp_Object debug_print_obj)
1309 {
1310 debug_print_no_newline (debug_print_obj);
1311 stderr_out ("\n");
1312 fflush (stderr);
1313 }
1314
1315 /* Debugging kludge -- unbuffered */
1316 void
1317 debug_backtrace (void)
1318 {
1319 /* This function can GC */
1320 int old_print_readably = print_readably;
1321 int old_print_depth = print_depth;
1322 Lisp_Object old_print_length = Vprint_length;
1323 Lisp_Object old_print_level = Vprint_level;
1324 Lisp_Object old_inhibit_quit = Vinhibit_quit;
1325 struct gcpro gcpro1, gcpro2, gcpro3;
1326 GCPRO3 (old_print_level, old_print_length, old_inhibit_quit);
1327
1328 if (gc_in_progress)
1329 stderr_out ("** gc-in-progress! Bad idea to print anything! **\n");
1330
1331 print_depth = 0;
1332 print_readably = 0;
1333 print_unbuffered++;
1334 /* Could use unwind-protect, but why bother? */
1335 if (debug_print_length > 0)
1336 Vprint_length = make_int (debug_print_length);
1337 if (debug_print_level > 0)
1338 Vprint_level = make_int (debug_print_level);
1339 Fbacktrace (Qexternal_debugging_output, Qt);
1340 stderr_out ("\n");
1341 fflush (stderr);
1342 Vinhibit_quit = old_inhibit_quit;
1343 Vprint_level = old_print_level;
1344 Vprint_length = old_print_length;
1345 print_depth = old_print_depth;
1346 print_readably = old_print_readably;
1347 print_unbuffered--;
1348 UNGCPRO;
1349 }
1350
1351 void
1352 debug_short_backtrace (int length)
1353 {
1354 int first = 1;
1355 struct backtrace *bt = backtrace_list;
1356 stderr_out (" [");
1357 fflush (stderr);
1358 while (length > 0 && bt)
1359 {
1360 if (!first)
1361 {
1362 stderr_out (", ");
1363 fflush (stderr);
1364 }
1365 if (COMPILED_FUNCTIONP (*bt->function))
1366 {
1367 Lisp_Object ann = Fcompiled_function_annotation (*bt->function);
1368 if (!NILP (ann))
1369 {
1370 stderr_out ("<compiled-function from ");
1371 fflush (stderr);
1372 debug_print_no_newline (ann);
1373 stderr_out (">");
1374 fflush (stderr);
1375 }
1376 else
1377 {
1378 stderr_out ("<compiled-function of unknown origin>");
1379 fflush (stderr);
1380 }
1381 }
1382 else
1383 debug_print_no_newline (*bt->function);
1384 first = 0;
1385 length--;
1386 bt = bt->next;
1387 }
1388 stderr_out ("]\n");
1389 fflush (stderr);
1390 }
1391
1392 #endif /* debugging kludge */
1393
1394
1395 void
1396 syms_of_print (void)
1397 {
1398 defsymbol (&Qprint_escape_newlines, "print-escape-newlines");
1399 defsymbol (&Qprint_readably, "print-readably");
1400
1401 defsymbol (&Qstandard_output, "standard-output");
1402
1403 #ifdef LISP_FLOAT_TYPE
1404 defsymbol (&Qfloat_output_format, "float-output-format");
1405 #endif
1406
1407 defsymbol (&Qprint_length, "print-length");
1408
1409 defsymbol (&Qprint_string_length, "print-string-length");
1410 defsubr (&Sprin1);
1411 defsubr (&Sprin1_to_string);
1412 defsubr (&Sprinc);
1413 defsubr (&Sprint);
1414 defsubr (&Sterpri);
1415 defsubr (&Swrite_char);
1416 defsubr (&Salternate_debugging_output);
1417 defsymbol (&Qalternate_debugging_output, "alternate-debugging-output");
1418 defsubr (&Sexternal_debugging_output);
1419 defsubr (&Sopen_termscript);
1420 defsymbol (&Qexternal_debugging_output, "external-debugging-output");
1421 #ifndef standalone
1422 defsubr (&Swith_output_to_temp_buffer);
1423 #endif /* not standalone */
1424 }
1425
1426 void
1427 lstream_type_create_print (void)
1428 {
1429 LSTREAM_HAS_METHOD (print, writer);
1430 LSTREAM_HAS_METHOD (print, marker);
1431 }
1432
1433 void
1434 vars_of_print (void)
1435 {
1436 alternate_do_pointer = 0;
1437
1438 DEFVAR_LISP ("standard-output", &Vstandard_output /*
1439 Output stream `print' uses by default for outputting a character.
1440 This may be any function of one argument.
1441 It may also be a buffer (output is inserted before point)
1442 or a marker (output is inserted and the marker is advanced)
1443 or the symbol t (output appears in the minibuffer line).
1444 */ );
1445 Vstandard_output = Qt;
1446
1447 #ifdef LISP_FLOAT_TYPE
1448 DEFVAR_LISP ("float-output-format", &Vfloat_output_format /*
1449 The format descriptor string that lisp uses to print floats.
1450 This is a %-spec like those accepted by `printf' in C,
1451 but with some restrictions. It must start with the two characters `%.'.
1452 After that comes an integer precision specification,
1453 and then a letter which controls the format.
1454 The letters allowed are `e', `f' and `g'.
1455 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
1456 Use `f' for decimal point notation \"DIGITS.DIGITS\".
1457 Use `g' to choose the shorter of those two formats for the number at hand.
1458 The precision in any of these cases is the number of digits following
1459 the decimal point. With `f', a precision of 0 means to omit the
1460 decimal point. 0 is not allowed with `f' or `g'.
1461
1462 A value of nil means to use `%.16g'.
1463
1464 Regardless of the value of `float-output-format', a floating point number
1465 will never be printed in such a way that it is ambiguous with an integer;
1466 that is, a floating-point number will always be printed with a decimal
1467 point and/or an exponent, even if the digits following the decimal point
1468 are all zero. This is to preserve read-equivalence.
1469 */ );
1470 Vfloat_output_format = Qnil;
1471 #endif /* LISP_FLOAT_TYPE */
1472
1473 DEFVAR_LISP ("print-length", &Vprint_length /*
1474 Maximum length of list or vector to print before abbreviating.
1475 A value of nil means no limit.
1476 */ );
1477 Vprint_length = Qnil;
1478
1479 DEFVAR_LISP ("print-string-length", &Vprint_string_length /*
1480 Maximum length of string to print before abbreviating.
1481 A value of nil means no limit.
1482 */ );
1483 Vprint_string_length = Qnil;
1484
1485 DEFVAR_LISP ("print-level", &Vprint_level /*
1486 Maximum depth of list nesting to print before abbreviating.
1487 A value of nil means no limit.
1488 */ );
1489 Vprint_level = Qnil;
1490
1491 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines /*
1492 Non-nil means print newlines in strings as backslash-n.
1493 */ );
1494 print_escape_newlines = 0;
1495
1496 DEFVAR_BOOL ("print-readably", &print_readably /*
1497 If non-nil, then all objects will be printed in a readable form.
1498 If an object has no readable representation, then an error is signalled.
1499 When print-readably is true, compiled-function objects will be written in
1500 #[...] form instead of in #<compiled-function [...]> form, and two-element
1501 lists of the form (quote object) will be written as the equivalent 'object.
1502 Do not SET this variable; bind it instead.
1503 */ );
1504 print_readably = 0;
1505
1506 DEFVAR_BOOL ("print-gensym", &print_gensym /*
1507 If non-nil, then uninterned symbols will be printed specially.
1508 Uninterned symbols are those which are not present in `obarray', that is,
1509 those which were made with `make-symbol' or by calling `intern' with a
1510 second argument.
1511
1512 When print-gensym is true, such symbols will be preceeded by \"#:\", which
1513 causes the reader to create a new symbol instead of interning and returning
1514 an existing one. Beware: the #: syntax creates a new symbol each time it is
1515 seen, so if you print an object which contains two pointers to the same
1516 uninterned symbol, `read' will not duplicate that structure.
1517
1518 Also, since XEmacs has no real notion of packages, there is no way for the
1519 printer to distinguish between symbols interned in no obarray, and symbols
1520 interned in an alternate obarray.
1521 */ );
1522 print_gensym = 0;
1523
1524 DEFVAR_LISP ("print-message-label", &Vprint_message_label /*
1525 Label for minibuffer messages created with `print'. This should
1526 generally be bound with `let' rather than set. (See `display-message'.)
1527 */ );
1528 Vprint_message_label = Qprint;
1529
1530 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1531 staticpro (&Vprin1_to_string_buffer);
1532 }