annotate src/print.c @ 24:4103f0995bd7 r19-15b95

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