Mercurial > emacs
annotate src/print.c @ 14482:479987ba2c8d
(x_frame_parms): Add "title" element.
(x_set_title): New function.
(x_set_name): Let title prop override name prop for title use.
(x_set_icon_name): Use title parm before name parm, if no icon_name.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 04 Feb 1996 03:00:25 +0000 |
parents | ee40177f6c68 |
children | 22867e90511f |
rev | line source |
---|---|
329 | 1 /* Lisp object printing and output streams. |
11235 | 2 Copyright (C) 1985, 86, 88, 93, 94, 95 Free Software Foundation, Inc. |
329 | 3 |
4 This file is part of GNU Emacs. | |
5 | |
6 GNU Emacs is free software; you can redistribute it and/or modify | |
7 it under the terms of the GNU General Public License as published by | |
621 | 8 the Free Software Foundation; either version 2, or (at your option) |
329 | 9 any later version. |
10 | |
11 GNU Emacs is distributed in the hope that it will be useful, | |
12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 GNU General Public License for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with GNU Emacs; see the file COPYING. If not, write to | |
14186
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
14084
diff
changeset
|
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
14084
diff
changeset
|
19 Boston, MA 02111-1307, USA. */ |
329 | 20 |
21 | |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
4224
diff
changeset
|
22 #include <config.h> |
329 | 23 #include <stdio.h> |
24 #include "lisp.h" | |
25 | |
26 #ifndef standalone | |
27 #include "buffer.h" | |
766 | 28 #include "frame.h" |
329 | 29 #include "window.h" |
30 #include "process.h" | |
31 #include "dispextern.h" | |
32 #include "termchar.h" | |
11341 | 33 #include "keyboard.h" |
329 | 34 #endif /* not standalone */ |
35 | |
1967 | 36 #ifdef USE_TEXT_PROPERTIES |
37 #include "intervals.h" | |
38 #endif | |
39 | |
329 | 40 Lisp_Object Vstandard_output, Qstandard_output; |
41 | |
42 #ifdef LISP_FLOAT_TYPE | |
43 Lisp_Object Vfloat_output_format, Qfloat_output_format; | |
44 #endif /* LISP_FLOAT_TYPE */ | |
45 | |
46 /* Avoid actual stack overflow in print. */ | |
47 int print_depth; | |
48 | |
379
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
49 /* Detect most circularities to print finite output. */ |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
50 #define PRINT_CIRCLE 200 |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
51 Lisp_Object being_printed[PRINT_CIRCLE]; |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
52 |
329 | 53 /* Maximum length of list to print in full; noninteger means |
54 effectively infinity */ | |
55 | |
56 Lisp_Object Vprint_length; | |
57 | |
58 /* Maximum depth of list to print in full; noninteger means | |
59 effectively infinity. */ | |
60 | |
61 Lisp_Object Vprint_level; | |
62 | |
63 /* Nonzero means print newlines in strings as \n. */ | |
64 | |
65 int print_escape_newlines; | |
66 | |
67 Lisp_Object Qprint_escape_newlines; | |
68 | |
10418
fdad41459fd6
(printchar, strout): Call message_dolog.
Karl Heuer <kwzh@gnu.org>
parents:
10301
diff
changeset
|
69 /* Nonzero means print newline to stdout before next minibuffer message. |
329 | 70 Defined in xdisp.c */ |
71 | |
72 extern int noninteractive_need_newline; | |
10418
fdad41459fd6
(printchar, strout): Call message_dolog.
Karl Heuer <kwzh@gnu.org>
parents:
10301
diff
changeset
|
73 |
329 | 74 #ifdef MAX_PRINT_CHARS |
75 static int print_chars; | |
76 static int max_print; | |
77 #endif /* MAX_PRINT_CHARS */ | |
1967 | 78 |
79 void print_interval (); | |
329 | 80 |
81 #if 0 | |
82 /* Convert between chars and GLYPHs */ | |
83 | |
84 int | |
85 glyphlen (glyphs) | |
86 register GLYPH *glyphs; | |
87 { | |
88 register int i = 0; | |
89 | |
90 while (glyphs[i]) | |
91 i++; | |
92 return i; | |
93 } | |
94 | |
95 void | |
96 str_to_glyph_cpy (str, glyphs) | |
97 char *str; | |
98 GLYPH *glyphs; | |
99 { | |
100 register GLYPH *gp = glyphs; | |
101 register char *cp = str; | |
102 | |
103 while (*cp) | |
104 *gp++ = *cp++; | |
105 } | |
106 | |
107 void | |
108 str_to_glyph_ncpy (str, glyphs, n) | |
109 char *str; | |
110 GLYPH *glyphs; | |
111 register int n; | |
112 { | |
113 register GLYPH *gp = glyphs; | |
114 register char *cp = str; | |
115 | |
116 while (n-- > 0) | |
117 *gp++ = *cp++; | |
118 } | |
119 | |
120 void | |
121 glyph_to_str_cpy (glyphs, str) | |
122 GLYPH *glyphs; | |
123 char *str; | |
124 { | |
125 register GLYPH *gp = glyphs; | |
126 register char *cp = str; | |
127 | |
128 while (*gp) | |
129 *str++ = *gp++ & 0377; | |
130 } | |
131 #endif | |
132 | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3377
diff
changeset
|
133 /* Low level output routines for characters and strings */ |
329 | 134 |
135 /* Lisp functions to do output using a stream | |
136 must have the stream in a variable called printcharfun | |
137 and must start with PRINTPREPARE and end with PRINTFINISH. | |
138 Use PRINTCHAR to output one character, | |
139 or call strout to output a block of characters. | |
140 Also, each one must have the declarations | |
141 struct buffer *old = current_buffer; | |
142 int old_point = -1, start_point; | |
143 Lisp_Object original; | |
144 */ | |
145 | |
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
146 #define PRINTPREPARE \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
147 original = printcharfun; \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
148 if (NILP (printcharfun)) printcharfun = Qt; \ |
9117
f69e6cf74874
(PRINTPREPARE, PRINTFINISH, float_to_string, print): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8854
diff
changeset
|
149 if (BUFFERP (printcharfun)) \ |
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
150 { if (XBUFFER (printcharfun) != current_buffer) \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
151 Fset_buffer (printcharfun); \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
152 printcharfun = Qnil;} \ |
9117
f69e6cf74874
(PRINTPREPARE, PRINTFINISH, float_to_string, print): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8854
diff
changeset
|
153 if (MARKERP (printcharfun)) \ |
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
154 { if (!(XMARKER (original)->buffer)) \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
155 error ("Marker does not point anywhere"); \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
156 if (XMARKER (original)->buffer != current_buffer) \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
157 set_buffer_internal (XMARKER (original)->buffer); \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
158 old_point = point; \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
159 SET_PT (marker_position (printcharfun)); \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
160 start_point = point; \ |
329 | 161 printcharfun = Qnil;} |
162 | |
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
163 #define PRINTFINISH \ |
9117
f69e6cf74874
(PRINTPREPARE, PRINTFINISH, float_to_string, print): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8854
diff
changeset
|
164 if (MARKERP (original)) \ |
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
165 Fset_marker (original, make_number (point), Qnil); \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
166 if (old_point >= 0) \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
167 SET_PT (old_point + (old_point >= start_point \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
168 ? point - start_point : 0)); \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
169 if (old != current_buffer) \ |
329 | 170 set_buffer_internal (old) |
171 | |
172 #define PRINTCHAR(ch) printchar (ch, printcharfun) | |
173 | |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
174 /* Index of first unused element of FRAME_MESSAGE_BUF(mini_frame). */ |
329 | 175 static int printbufidx; |
176 | |
177 static void | |
178 printchar (ch, fun) | |
179 unsigned char ch; | |
180 Lisp_Object fun; | |
181 { | |
182 Lisp_Object ch1; | |
183 | |
184 #ifdef MAX_PRINT_CHARS | |
185 if (max_print) | |
186 print_chars++; | |
187 #endif /* MAX_PRINT_CHARS */ | |
188 #ifndef standalone | |
189 if (EQ (fun, Qnil)) | |
190 { | |
191 QUIT; | |
192 insert (&ch, 1); | |
193 return; | |
194 } | |
195 | |
196 if (EQ (fun, Qt)) | |
197 { | |
6808
514a324b3681
(printchar, strout): Use FRAME_PTR, not struct frame *.
Karl Heuer <kwzh@gnu.org>
parents:
6802
diff
changeset
|
198 FRAME_PTR mini_frame |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
199 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window))); |
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
200 |
329 | 201 if (noninteractive) |
202 { | |
203 putchar (ch); | |
204 noninteractive_need_newline = 1; | |
205 return; | |
206 } | |
207 | |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
208 if (echo_area_glyphs != FRAME_MESSAGE_BUF (mini_frame) |
329 | 209 || !message_buf_print) |
210 { | |
10568
275f62e27ee2
(printchar, strout): Use message_log_maybe_newline.
Karl Heuer <kwzh@gnu.org>
parents:
10482
diff
changeset
|
211 message_log_maybe_newline (); |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
212 echo_area_glyphs = FRAME_MESSAGE_BUF (mini_frame); |
329 | 213 printbufidx = 0; |
5233
83e771f33251
(printchar, strout): Set echo_area_glyphs_length.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
214 echo_area_glyphs_length = 0; |
329 | 215 message_buf_print = 1; |
216 } | |
217 | |
10418
fdad41459fd6
(printchar, strout): Call message_dolog.
Karl Heuer <kwzh@gnu.org>
parents:
10301
diff
changeset
|
218 message_dolog (&ch, 1, 0); |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
219 if (printbufidx < FRAME_WIDTH (mini_frame) - 1) |
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
220 FRAME_MESSAGE_BUF (mini_frame)[printbufidx++] = ch; |
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
221 FRAME_MESSAGE_BUF (mini_frame)[printbufidx] = 0; |
5233
83e771f33251
(printchar, strout): Set echo_area_glyphs_length.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
222 echo_area_glyphs_length = printbufidx; |
329 | 223 |
224 return; | |
225 } | |
226 #endif /* not standalone */ | |
227 | |
9317
58f6a917533b
(printchar): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents:
9276
diff
changeset
|
228 XSETFASTINT (ch1, ch); |
329 | 229 call1 (fun, ch1); |
230 } | |
231 | |
232 static void | |
233 strout (ptr, size, printcharfun) | |
234 char *ptr; | |
235 int size; | |
236 Lisp_Object printcharfun; | |
237 { | |
238 int i = 0; | |
239 | |
240 if (EQ (printcharfun, Qnil)) | |
241 { | |
242 insert (ptr, size >= 0 ? size : strlen (ptr)); | |
243 #ifdef MAX_PRINT_CHARS | |
244 if (max_print) | |
245 print_chars += size >= 0 ? size : strlen(ptr); | |
246 #endif /* MAX_PRINT_CHARS */ | |
247 return; | |
248 } | |
249 if (EQ (printcharfun, Qt)) | |
250 { | |
6808
514a324b3681
(printchar, strout): Use FRAME_PTR, not struct frame *.
Karl Heuer <kwzh@gnu.org>
parents:
6802
diff
changeset
|
251 FRAME_PTR mini_frame |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
252 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window))); |
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
253 |
329 | 254 i = size >= 0 ? size : strlen (ptr); |
255 #ifdef MAX_PRINT_CHARS | |
256 if (max_print) | |
257 print_chars += i; | |
258 #endif /* MAX_PRINT_CHARS */ | |
259 | |
260 if (noninteractive) | |
261 { | |
262 fwrite (ptr, 1, i, stdout); | |
263 noninteractive_need_newline = 1; | |
264 return; | |
265 } | |
266 | |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
267 if (echo_area_glyphs != FRAME_MESSAGE_BUF (mini_frame) |
329 | 268 || !message_buf_print) |
269 { | |
10568
275f62e27ee2
(printchar, strout): Use message_log_maybe_newline.
Karl Heuer <kwzh@gnu.org>
parents:
10482
diff
changeset
|
270 message_log_maybe_newline (); |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
271 echo_area_glyphs = FRAME_MESSAGE_BUF (mini_frame); |
329 | 272 printbufidx = 0; |
5233
83e771f33251
(printchar, strout): Set echo_area_glyphs_length.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
273 echo_area_glyphs_length = 0; |
329 | 274 message_buf_print = 1; |
275 } | |
276 | |
10418
fdad41459fd6
(printchar, strout): Call message_dolog.
Karl Heuer <kwzh@gnu.org>
parents:
10301
diff
changeset
|
277 message_dolog (ptr, i, 0); |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
278 if (i > FRAME_WIDTH (mini_frame) - printbufidx - 1) |
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
279 i = FRAME_WIDTH (mini_frame) - printbufidx - 1; |
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
280 bcopy (ptr, &FRAME_MESSAGE_BUF (mini_frame) [printbufidx], i); |
329 | 281 printbufidx += i; |
5233
83e771f33251
(printchar, strout): Set echo_area_glyphs_length.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
282 echo_area_glyphs_length = printbufidx; |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
283 FRAME_MESSAGE_BUF (mini_frame) [printbufidx] = 0; |
329 | 284 |
285 return; | |
286 } | |
287 | |
288 if (size >= 0) | |
289 while (i < size) | |
290 PRINTCHAR (ptr[i++]); | |
291 else | |
292 while (ptr[i]) | |
293 PRINTCHAR (ptr[i++]); | |
294 } | |
295 | |
296 /* Print the contents of a string STRING using PRINTCHARFUN. | |
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
297 It isn't safe to use strout in many cases, |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
298 because printing one char can relocate. */ |
329 | 299 |
300 print_string (string, printcharfun) | |
301 Lisp_Object string; | |
302 Lisp_Object printcharfun; | |
303 { | |
12782
029baa39289d
(print_string): Use insert_from_string for output to buffer.
Richard M. Stallman <rms@gnu.org>
parents:
11798
diff
changeset
|
304 if (EQ (printcharfun, Qt)) |
029baa39289d
(print_string): Use insert_from_string for output to buffer.
Richard M. Stallman <rms@gnu.org>
parents:
11798
diff
changeset
|
305 /* strout is safe for output to a frame (echo area). */ |
329 | 306 strout (XSTRING (string)->data, XSTRING (string)->size, printcharfun); |
12782
029baa39289d
(print_string): Use insert_from_string for output to buffer.
Richard M. Stallman <rms@gnu.org>
parents:
11798
diff
changeset
|
307 else if (EQ (printcharfun, Qnil)) |
029baa39289d
(print_string): Use insert_from_string for output to buffer.
Richard M. Stallman <rms@gnu.org>
parents:
11798
diff
changeset
|
308 { |
029baa39289d
(print_string): Use insert_from_string for output to buffer.
Richard M. Stallman <rms@gnu.org>
parents:
11798
diff
changeset
|
309 #ifdef MAX_PRINT_CHARS |
029baa39289d
(print_string): Use insert_from_string for output to buffer.
Richard M. Stallman <rms@gnu.org>
parents:
11798
diff
changeset
|
310 if (max_print) |
029baa39289d
(print_string): Use insert_from_string for output to buffer.
Richard M. Stallman <rms@gnu.org>
parents:
11798
diff
changeset
|
311 print_chars += XSTRING (string)->size; |
029baa39289d
(print_string): Use insert_from_string for output to buffer.
Richard M. Stallman <rms@gnu.org>
parents:
11798
diff
changeset
|
312 #endif /* MAX_PRINT_CHARS */ |
029baa39289d
(print_string): Use insert_from_string for output to buffer.
Richard M. Stallman <rms@gnu.org>
parents:
11798
diff
changeset
|
313 insert_from_string (string, 0, XSTRING (string)->size, 1); |
029baa39289d
(print_string): Use insert_from_string for output to buffer.
Richard M. Stallman <rms@gnu.org>
parents:
11798
diff
changeset
|
314 } |
329 | 315 else |
316 { | |
317 /* Otherwise, fetch the string address for each character. */ | |
318 int i; | |
319 int size = XSTRING (string)->size; | |
320 struct gcpro gcpro1; | |
321 GCPRO1 (string); | |
322 for (i = 0; i < size; i++) | |
323 PRINTCHAR (XSTRING (string)->data[i]); | |
324 UNGCPRO; | |
325 } | |
326 } | |
327 | |
328 DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0, | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
329 "Output character CHARACTER to stream PRINTCHARFUN.\n\ |
7185 | 330 PRINTCHARFUN defaults to the value of `standard-output' (which see).") |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
331 (character, printcharfun) |
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
332 Lisp_Object character, printcharfun; |
329 | 333 { |
334 struct buffer *old = current_buffer; | |
335 int old_point = -1; | |
336 int start_point; | |
337 Lisp_Object original; | |
338 | |
520 | 339 if (NILP (printcharfun)) |
329 | 340 printcharfun = Vstandard_output; |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
341 CHECK_NUMBER (character, 0); |
329 | 342 PRINTPREPARE; |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
343 PRINTCHAR (XINT (character)); |
329 | 344 PRINTFINISH; |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
345 return character; |
329 | 346 } |
347 | |
348 /* Used from outside of print.c to print a block of SIZE chars at DATA | |
349 on the default output stream. | |
350 Do not use this on the contents of a Lisp string. */ | |
351 | |
352 write_string (data, size) | |
353 char *data; | |
354 int size; | |
355 { | |
356 struct buffer *old = current_buffer; | |
357 Lisp_Object printcharfun; | |
358 int old_point = -1; | |
359 int start_point; | |
360 Lisp_Object original; | |
361 | |
362 printcharfun = Vstandard_output; | |
363 | |
364 PRINTPREPARE; | |
365 strout (data, size, printcharfun); | |
366 PRINTFINISH; | |
367 } | |
368 | |
369 /* Used from outside of print.c to print a block of SIZE chars at DATA | |
370 on a specified stream PRINTCHARFUN. | |
371 Do not use this on the contents of a Lisp string. */ | |
372 | |
373 write_string_1 (data, size, printcharfun) | |
374 char *data; | |
375 int size; | |
376 Lisp_Object printcharfun; | |
377 { | |
378 struct buffer *old = current_buffer; | |
379 int old_point = -1; | |
380 int start_point; | |
381 Lisp_Object original; | |
382 | |
383 PRINTPREPARE; | |
384 strout (data, size, printcharfun); | |
385 PRINTFINISH; | |
386 } | |
387 | |
388 | |
389 #ifndef standalone | |
390 | |
391 void | |
392 temp_output_buffer_setup (bufname) | |
393 char *bufname; | |
394 { | |
395 register struct buffer *old = current_buffer; | |
396 register Lisp_Object buf; | |
397 | |
398 Fset_buffer (Fget_buffer_create (build_string (bufname))); | |
399 | |
11114
c8ab5c627f74
(temp_output_buffer_setup): (Re)set the default
Richard M. Stallman <rms@gnu.org>
parents:
11010
diff
changeset
|
400 current_buffer->directory = old->directory; |
329 | 401 current_buffer->read_only = Qnil; |
402 Ferase_buffer (); | |
403 | |
9276
ae62e12feac5
(temp_output_buffer_setup): Use new accessor macros instead of calling XSET
Karl Heuer <kwzh@gnu.org>
parents:
9117
diff
changeset
|
404 XSETBUFFER (buf, current_buffer); |
329 | 405 specbind (Qstandard_output, buf); |
406 | |
407 set_buffer_internal (old); | |
408 } | |
409 | |
410 Lisp_Object | |
411 internal_with_output_to_temp_buffer (bufname, function, args) | |
412 char *bufname; | |
413 Lisp_Object (*function) (); | |
414 Lisp_Object args; | |
415 { | |
416 int count = specpdl_ptr - specpdl; | |
417 Lisp_Object buf, val; | |
8315
8921d0012bd5
(internal_with_output_to_temp_buffer): gcpro things.
Richard M. Stallman <rms@gnu.org>
parents:
7185
diff
changeset
|
418 struct gcpro gcpro1; |
329 | 419 |
8315
8921d0012bd5
(internal_with_output_to_temp_buffer): gcpro things.
Richard M. Stallman <rms@gnu.org>
parents:
7185
diff
changeset
|
420 GCPRO1 (args); |
329 | 421 record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); |
422 temp_output_buffer_setup (bufname); | |
423 buf = Vstandard_output; | |
8315
8921d0012bd5
(internal_with_output_to_temp_buffer): gcpro things.
Richard M. Stallman <rms@gnu.org>
parents:
7185
diff
changeset
|
424 UNGCPRO; |
329 | 425 |
426 val = (*function) (args); | |
427 | |
8315
8921d0012bd5
(internal_with_output_to_temp_buffer): gcpro things.
Richard M. Stallman <rms@gnu.org>
parents:
7185
diff
changeset
|
428 GCPRO1 (val); |
329 | 429 temp_output_buffer_show (buf); |
8315
8921d0012bd5
(internal_with_output_to_temp_buffer): gcpro things.
Richard M. Stallman <rms@gnu.org>
parents:
7185
diff
changeset
|
430 UNGCPRO; |
329 | 431 |
432 return unbind_to (count, val); | |
433 } | |
434 | |
435 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer, | |
436 1, UNEVALLED, 0, | |
437 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\ | |
438 The buffer is cleared out initially, and marked as unmodified when done.\n\ | |
439 All output done by BODY is inserted in that buffer by default.\n\ | |
440 The buffer is displayed in another window, but not selected.\n\ | |
441 The value of the last form in BODY is returned.\n\ | |
442 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\ | |
3337
f5f76ebe6286
(Fwith_output_to_temp_buffer): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
2782
diff
changeset
|
443 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\ |
329 | 444 to get the buffer displayed. It gets one argument, the buffer to display.") |
445 (args) | |
446 Lisp_Object args; | |
447 { | |
448 struct gcpro gcpro1; | |
449 Lisp_Object name; | |
450 int count = specpdl_ptr - specpdl; | |
451 Lisp_Object buf, val; | |
452 | |
453 GCPRO1(args); | |
454 name = Feval (Fcar (args)); | |
455 UNGCPRO; | |
456 | |
457 CHECK_STRING (name, 0); | |
458 temp_output_buffer_setup (XSTRING (name)->data); | |
459 buf = Vstandard_output; | |
460 | |
461 val = Fprogn (Fcdr (args)); | |
462 | |
463 temp_output_buffer_show (buf); | |
464 | |
465 return unbind_to (count, val); | |
466 } | |
467 #endif /* not standalone */ | |
468 | |
469 static void print (); | |
470 | |
471 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0, | |
7185 | 472 "Output a newline to stream PRINTCHARFUN.\n\ |
473 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.") | |
329 | 474 (printcharfun) |
475 Lisp_Object printcharfun; | |
476 { | |
477 struct buffer *old = current_buffer; | |
478 int old_point = -1; | |
479 int start_point; | |
480 Lisp_Object original; | |
481 | |
520 | 482 if (NILP (printcharfun)) |
329 | 483 printcharfun = Vstandard_output; |
484 PRINTPREPARE; | |
485 PRINTCHAR ('\n'); | |
486 PRINTFINISH; | |
487 return Qt; | |
488 } | |
489 | |
490 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0, | |
491 "Output the printed representation of OBJECT, any Lisp object.\n\ | |
492 Quoting characters are printed when needed to make output that `read'\n\ | |
493 can handle, whenever this is possible.\n\ | |
7185 | 494 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).") |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
495 (object, printcharfun) |
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
496 Lisp_Object object, printcharfun; |
329 | 497 { |
498 struct buffer *old = current_buffer; | |
499 int old_point = -1; | |
500 int start_point; | |
501 Lisp_Object original; | |
502 | |
503 #ifdef MAX_PRINT_CHARS | |
504 max_print = 0; | |
505 #endif /* MAX_PRINT_CHARS */ | |
520 | 506 if (NILP (printcharfun)) |
329 | 507 printcharfun = Vstandard_output; |
508 PRINTPREPARE; | |
509 print_depth = 0; | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
510 print (object, printcharfun, 1); |
329 | 511 PRINTFINISH; |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
512 return object; |
329 | 513 } |
514 | |
515 /* a buffer which is used to hold output being built by prin1-to-string */ | |
516 Lisp_Object Vprin1_to_string_buffer; | |
517 | |
518 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0, | |
519 "Return a string containing the printed representation of OBJECT,\n\ | |
520 any Lisp object. Quoting characters are used when needed to make output\n\ | |
521 that `read' can handle, whenever this is possible, unless the optional\n\ | |
522 second argument NOESCAPE is non-nil.") | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
523 (object, noescape) |
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
524 Lisp_Object object, noescape; |
329 | 525 { |
526 struct buffer *old = current_buffer; | |
527 int old_point = -1; | |
528 int start_point; | |
529 Lisp_Object original, printcharfun; | |
530 struct gcpro gcpro1; | |
531 | |
532 printcharfun = Vprin1_to_string_buffer; | |
533 PRINTPREPARE; | |
534 print_depth = 0; | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
535 print (object, printcharfun, NILP (noescape)); |
329 | 536 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */ |
537 PRINTFINISH; | |
538 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer)); | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
539 object = Fbuffer_string (); |
329 | 540 |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
541 GCPRO1 (object); |
329 | 542 Ferase_buffer (); |
543 set_buffer_internal (old); | |
544 UNGCPRO; | |
545 | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
546 return object; |
329 | 547 } |
548 | |
549 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0, | |
550 "Output the printed representation of OBJECT, any Lisp object.\n\ | |
551 No quoting characters are used; no delimiters are printed around\n\ | |
552 the contents of strings.\n\ | |
7185 | 553 Output stream is PRINTCHARFUN, or value of standard-output (which see).") |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
554 (object, printcharfun) |
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
555 Lisp_Object object, printcharfun; |
329 | 556 { |
557 struct buffer *old = current_buffer; | |
558 int old_point = -1; | |
559 int start_point; | |
560 Lisp_Object original; | |
561 | |
520 | 562 if (NILP (printcharfun)) |
329 | 563 printcharfun = Vstandard_output; |
564 PRINTPREPARE; | |
565 print_depth = 0; | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
566 print (object, printcharfun, 0); |
329 | 567 PRINTFINISH; |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
568 return object; |
329 | 569 } |
570 | |
571 DEFUN ("print", Fprint, Sprint, 1, 2, 0, | |
572 "Output the printed representation of OBJECT, with newlines around it.\n\ | |
573 Quoting characters are printed when needed to make output that `read'\n\ | |
574 can handle, whenever this is possible.\n\ | |
7185 | 575 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).") |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
576 (object, printcharfun) |
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
577 Lisp_Object object, printcharfun; |
329 | 578 { |
579 struct buffer *old = current_buffer; | |
580 int old_point = -1; | |
581 int start_point; | |
582 Lisp_Object original; | |
583 struct gcpro gcpro1; | |
584 | |
585 #ifdef MAX_PRINT_CHARS | |
586 print_chars = 0; | |
587 max_print = MAX_PRINT_CHARS; | |
588 #endif /* MAX_PRINT_CHARS */ | |
520 | 589 if (NILP (printcharfun)) |
329 | 590 printcharfun = Vstandard_output; |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
591 GCPRO1 (object); |
329 | 592 PRINTPREPARE; |
593 print_depth = 0; | |
594 PRINTCHAR ('\n'); | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
595 print (object, printcharfun, 1); |
329 | 596 PRINTCHAR ('\n'); |
597 PRINTFINISH; | |
598 #ifdef MAX_PRINT_CHARS | |
599 max_print = 0; | |
600 print_chars = 0; | |
601 #endif /* MAX_PRINT_CHARS */ | |
602 UNGCPRO; | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
603 return object; |
329 | 604 } |
605 | |
606 /* The subroutine object for external-debugging-output is kept here | |
607 for the convenience of the debugger. */ | |
608 Lisp_Object Qexternal_debugging_output; | |
609 | |
621 | 610 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0, |
611 "Write CHARACTER to stderr.\n\ | |
329 | 612 You can call print while debugging emacs, and pass it this function\n\ |
613 to make it write to the debugging output.\n") | |
621 | 614 (character) |
615 Lisp_Object character; | |
329 | 616 { |
617 CHECK_NUMBER (character, 0); | |
618 putc (XINT (character), stderr); | |
619 | |
620 return character; | |
621 } | |
6533
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
622 |
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
623 /* This is the interface for debugging printing. */ |
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
624 |
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
625 void |
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
626 debug_print (arg) |
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
627 Lisp_Object arg; |
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
628 { |
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
629 Fprin1 (arg, Qexternal_debugging_output); |
13456
b66f0626addb
(debug_print): Explicitly print a CR.
Richard M. Stallman <rms@gnu.org>
parents:
13405
diff
changeset
|
630 fprintf (stderr, "\r\n"); |
6533
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
631 } |
329 | 632 |
13776
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
633 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string, |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
634 1, 1, 0, |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
635 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.") |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
636 (obj) |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
637 Lisp_Object obj; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
638 { |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
639 struct buffer *old = current_buffer; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
640 Lisp_Object original, printcharfun, value; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
641 struct gcpro gcpro1; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
642 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
643 print_error_message (obj, Vprin1_to_string_buffer, NULL); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
644 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
645 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer)); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
646 value = Fbuffer_string (); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
647 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
648 GCPRO1 (value); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
649 Ferase_buffer (); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
650 set_buffer_internal (old); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
651 UNGCPRO; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
652 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
653 return value; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
654 } |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
655 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
656 /* Print an error message for the error DATA |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
657 onto Lisp output stream STREAM (suitable for the print functions). */ |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
658 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
659 print_error_message (data, stream) |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
660 Lisp_Object data, stream; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
661 { |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
662 Lisp_Object errname, errmsg, file_error, tail; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
663 struct gcpro gcpro1; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
664 int i; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
665 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
666 errname = Fcar (data); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
667 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
668 if (EQ (errname, Qerror)) |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
669 { |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
670 data = Fcdr (data); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
671 if (!CONSP (data)) data = Qnil; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
672 errmsg = Fcar (data); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
673 file_error = Qnil; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
674 } |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
675 else |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
676 { |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
677 errmsg = Fget (errname, Qerror_message); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
678 file_error = Fmemq (Qfile_error, |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
679 Fget (errname, Qerror_conditions)); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
680 } |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
681 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
682 /* Print an error message including the data items. */ |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
683 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
684 tail = Fcdr_safe (data); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
685 GCPRO1 (tail); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
686 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
687 /* For file-error, make error message by concatenating |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
688 all the data items. They are all strings. */ |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
689 if (!NILP (file_error) && !NILP (tail)) |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
690 errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
691 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
692 if (STRINGP (errmsg)) |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
693 Fprinc (errmsg, stream); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
694 else |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
695 write_string_1 ("peculiar error", -1, stream); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
696 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
697 for (i = 0; CONSP (tail); tail = Fcdr (tail), i++) |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
698 { |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
699 write_string_1 (i ? ", " : ": ", 2, stream); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
700 if (!NILP (file_error)) |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
701 Fprinc (Fcar (tail), stream); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
702 else |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
703 Fprin1 (Fcar (tail), stream); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
704 } |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
705 UNGCPRO; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
706 } |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
707 |
329 | 708 #ifdef LISP_FLOAT_TYPE |
709 | |
710 /* | |
1759
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
711 * The buffer should be at least as large as the max string size of the |
14036 | 712 * largest float, printed in the biggest notation. This is undoubtedly |
329 | 713 * 20d float_output_format, with the negative of the C-constant "HUGE" |
714 * from <math.h>. | |
715 * | |
716 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes. | |
717 * | |
718 * I assume that IEEE-754 format numbers can take 329 bytes for the worst | |
719 * case of -1e307 in 20d float_output_format. What is one to do (short of | |
720 * re-writing _doprnt to be more sane)? | |
721 * -wsr | |
722 */ | |
1759
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
723 |
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
724 void |
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
725 float_to_string (buf, data) |
1991
0f88f314fc34
* print.c (float_to_string): Define buf to be an unsigned char, to
Jim Blandy <jimb@redhat.com>
parents:
1967
diff
changeset
|
726 unsigned char *buf; |
329 | 727 double data; |
728 { | |
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
729 unsigned char *cp; |
4224
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
730 int width; |
329 | 731 |
520 | 732 if (NILP (Vfloat_output_format) |
9117
f69e6cf74874
(PRINTPREPARE, PRINTFINISH, float_to_string, print): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8854
diff
changeset
|
733 || !STRINGP (Vfloat_output_format)) |
329 | 734 lose: |
4224
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
735 { |
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
736 sprintf (buf, "%.17g", data); |
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
737 width = -1; |
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
738 } |
329 | 739 else /* oink oink */ |
740 { | |
741 /* Check that the spec we have is fully valid. | |
742 This means not only valid for printf, | |
743 but meant for floats, and reasonable. */ | |
744 cp = XSTRING (Vfloat_output_format)->data; | |
745 | |
746 if (cp[0] != '%') | |
747 goto lose; | |
748 if (cp[1] != '.') | |
749 goto lose; | |
750 | |
751 cp += 2; | |
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
752 |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
753 /* Check the width specification. */ |
4224
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
754 width = -1; |
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
755 if ('0' <= *cp && *cp <= '9') |
11798
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
756 { |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
757 width = 0; |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
758 do |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
759 width = (width * 10) + (*cp++ - '0'); |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
760 while (*cp >= '0' && *cp <= '9'); |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
761 |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
762 /* A precision of zero is valid only for %f. */ |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
763 if (width > DBL_DIG |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
764 || (width == 0 && *cp != 'f')) |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
765 goto lose; |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
766 } |
329 | 767 |
768 if (*cp != 'e' && *cp != 'f' && *cp != 'g') | |
769 goto lose; | |
770 | |
771 if (cp[1] != 0) | |
772 goto lose; | |
773 | |
774 sprintf (buf, XSTRING (Vfloat_output_format)->data, data); | |
775 } | |
1759
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
776 |
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
777 /* Make sure there is a decimal point with digit after, or an |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
778 exponent, so that the value is readable as a float. But don't do |
4224
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
779 this with "%.0f"; it's valid for that not to produce a decimal |
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
780 point. Note that width can be 0 only for %.0f. */ |
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
781 if (width != 0) |
1764
94ff5d9ef48a
(float_to_string): Add final 0 if text ends with decimal pt.
Richard M. Stallman <rms@gnu.org>
parents:
1759
diff
changeset
|
782 { |
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
783 for (cp = buf; *cp; cp++) |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
784 if ((*cp < '0' || *cp > '9') && *cp != '-') |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
785 break; |
1764
94ff5d9ef48a
(float_to_string): Add final 0 if text ends with decimal pt.
Richard M. Stallman <rms@gnu.org>
parents:
1759
diff
changeset
|
786 |
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
787 if (*cp == '.' && cp[1] == 0) |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
788 { |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
789 cp[1] = '0'; |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
790 cp[2] = 0; |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
791 } |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
792 |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
793 if (*cp == 0) |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
794 { |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
795 *cp++ = '.'; |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
796 *cp++ = '0'; |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
797 *cp++ = 0; |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
798 } |
1759
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
799 } |
329 | 800 } |
801 #endif /* LISP_FLOAT_TYPE */ | |
802 | |
803 static void | |
804 print (obj, printcharfun, escapeflag) | |
805 Lisp_Object obj; | |
806 register Lisp_Object printcharfun; | |
807 int escapeflag; | |
808 { | |
809 char buf[30]; | |
810 | |
811 QUIT; | |
812 | |
379
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
813 #if 1 /* I'm not sure this is really worth doing. */ |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
814 /* Detect circularities and truncate them. |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
815 No need to offer any alternative--this is better than an error. */ |
9117
f69e6cf74874
(PRINTPREPARE, PRINTFINISH, float_to_string, print): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8854
diff
changeset
|
816 if (CONSP (obj) || VECTORP (obj) || COMPILEDP (obj)) |
379
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
817 { |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
818 int i; |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
819 for (i = 0; i < print_depth; i++) |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
820 if (EQ (obj, being_printed[i])) |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
821 { |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
822 sprintf (buf, "#%d", i); |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
823 strout (buf, -1, printcharfun); |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
824 return; |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
825 } |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
826 } |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
827 #endif |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
828 |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
829 being_printed[print_depth] = obj; |
329 | 830 print_depth++; |
831 | |
379
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
832 if (print_depth > PRINT_CIRCLE) |
329 | 833 error ("Apparently circular structure being printed"); |
834 #ifdef MAX_PRINT_CHARS | |
835 if (max_print && print_chars > max_print) | |
836 { | |
837 PRINTCHAR ('\n'); | |
838 print_chars = 0; | |
839 } | |
840 #endif /* MAX_PRINT_CHARS */ | |
841 | |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
842 switch (XGCTYPE (obj)) |
329 | 843 { |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
844 case Lisp_Int: |
11697
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
845 if (sizeof (int) == sizeof (EMACS_INT)) |
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
846 sprintf (buf, "%d", XINT (obj)); |
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
847 else if (sizeof (long) == sizeof (EMACS_INT)) |
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
848 sprintf (buf, "%ld", XINT (obj)); |
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
849 else |
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
850 abort (); |
329 | 851 strout (buf, -1, printcharfun); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
852 break; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
853 |
10001 | 854 #ifdef LISP_FLOAT_TYPE |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
855 case Lisp_Float: |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
856 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
857 char pigbuf[350]; /* see comments in float_to_string */ |
329 | 858 |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
859 float_to_string (pigbuf, XFLOAT(obj)->data); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
860 strout (pigbuf, -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
861 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
862 break; |
10001 | 863 #endif |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
864 |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
865 case Lisp_String: |
329 | 866 if (!escapeflag) |
867 print_string (obj, printcharfun); | |
868 else | |
869 { | |
870 register int i; | |
871 register unsigned char c; | |
872 struct gcpro gcpro1; | |
873 | |
1967 | 874 GCPRO1 (obj); |
875 | |
876 #ifdef USE_TEXT_PROPERTIES | |
877 if (!NULL_INTERVAL_P (XSTRING (obj)->intervals)) | |
878 { | |
879 PRINTCHAR ('#'); | |
880 PRINTCHAR ('('); | |
881 } | |
882 #endif | |
329 | 883 |
884 PRINTCHAR ('\"'); | |
885 for (i = 0; i < XSTRING (obj)->size; i++) | |
886 { | |
887 QUIT; | |
888 c = XSTRING (obj)->data[i]; | |
889 if (c == '\n' && print_escape_newlines) | |
890 { | |
891 PRINTCHAR ('\\'); | |
892 PRINTCHAR ('n'); | |
893 } | |
5852
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
894 else if (c == '\f' && print_escape_newlines) |
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
895 { |
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
896 PRINTCHAR ('\\'); |
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
897 PRINTCHAR ('f'); |
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
898 } |
329 | 899 else |
900 { | |
901 if (c == '\"' || c == '\\') | |
902 PRINTCHAR ('\\'); | |
903 PRINTCHAR (c); | |
904 } | |
905 } | |
906 PRINTCHAR ('\"'); | |
1967 | 907 |
908 #ifdef USE_TEXT_PROPERTIES | |
909 if (!NULL_INTERVAL_P (XSTRING (obj)->intervals)) | |
910 { | |
911 traverse_intervals (XSTRING (obj)->intervals, | |
912 0, 0, print_interval, printcharfun); | |
913 PRINTCHAR (')'); | |
914 } | |
915 #endif | |
916 | |
329 | 917 UNGCPRO; |
918 } | |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
919 break; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
920 |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
921 case Lisp_Symbol: |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
922 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
923 register int confusing; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
924 register unsigned char *p = XSYMBOL (obj)->name->data; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
925 register unsigned char *end = p + XSYMBOL (obj)->name->size; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
926 register unsigned char c; |
329 | 927 |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
928 if (p != end && (*p == '-' || *p == '+')) p++; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
929 if (p == end) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
930 confusing = 0; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
931 else |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
932 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
933 while (p != end && *p >= '0' && *p <= '9') |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
934 p++; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
935 confusing = (end == p); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
936 } |
329 | 937 |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
938 p = XSYMBOL (obj)->name->data; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
939 while (p != end) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
940 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
941 QUIT; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
942 c = *p++; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
943 if (escapeflag) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
944 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
945 if (c == '\"' || c == '\\' || c == '\'' || c == ';' || c == '#' || |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
946 c == '(' || c == ')' || c == ',' || c =='.' || c == '`' || |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
947 c == '[' || c == ']' || c == '?' || c <= 040 || confusing) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
948 PRINTCHAR ('\\'), confusing = 0; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
949 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
950 PRINTCHAR (c); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
951 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
952 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
953 break; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
954 |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
955 case Lisp_Cons: |
329 | 956 /* If deeper than spec'd depth, print placeholder. */ |
9117
f69e6cf74874
(PRINTPREPARE, PRINTFINISH, float_to_string, print): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8854
diff
changeset
|
957 if (INTEGERP (Vprint_level) |
329 | 958 && print_depth > XINT (Vprint_level)) |
10001 | 959 strout ("...", -1, printcharfun); |
960 else | |
329 | 961 { |
10001 | 962 PRINTCHAR ('('); |
329 | 963 { |
10001 | 964 register int i = 0; |
965 register int max = 0; | |
966 | |
967 if (INTEGERP (Vprint_length)) | |
968 max = XINT (Vprint_length); | |
969 /* Could recognize circularities in cdrs here, | |
970 but that would make printing of long lists quadratic. | |
971 It's not worth doing. */ | |
972 while (CONSP (obj)) | |
329 | 973 { |
10001 | 974 if (i++) |
975 PRINTCHAR (' '); | |
976 if (max && i > max) | |
977 { | |
978 strout ("...", 3, printcharfun); | |
979 break; | |
980 } | |
981 print (Fcar (obj), printcharfun, escapeflag); | |
982 obj = Fcdr (obj); | |
329 | 983 } |
984 } | |
10001 | 985 if (!NILP (obj) && !CONSP (obj)) |
986 { | |
987 strout (" . ", 3, printcharfun); | |
988 print (obj, printcharfun, escapeflag); | |
989 } | |
990 PRINTCHAR (')'); | |
329 | 991 } |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
992 break; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
993 |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
994 case Lisp_Vectorlike: |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
995 if (PROCESSP (obj)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
996 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
997 if (escapeflag) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
998 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
999 strout ("#<process ", -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1000 print_string (XPROCESS (obj)->name, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1001 PRINTCHAR ('>'); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1002 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1003 else |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1004 print_string (XPROCESS (obj)->name, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1005 } |
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1006 else if (BOOL_VECTOR_P (obj)) |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1007 { |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1008 register int i; |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1009 register unsigned char c; |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1010 struct gcpro gcpro1; |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1011 int size_in_chars |
13363
941c37982f37
(BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG):
Karl Heuer <kwzh@gnu.org>
parents:
13361
diff
changeset
|
1012 = (XBOOL_VECTOR (obj)->size + BITS_PER_CHAR) / BITS_PER_CHAR; |
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1013 |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1014 GCPRO1 (obj); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1015 |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1016 PRINTCHAR ('#'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1017 PRINTCHAR ('&'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1018 sprintf (buf, "%d", XBOOL_VECTOR (obj)->size); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1019 strout (buf, -1, printcharfun); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1020 PRINTCHAR ('\"'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1021 for (i = 0; i < size_in_chars; i++) |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1022 { |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1023 QUIT; |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1024 c = XBOOL_VECTOR (obj)->data[i]; |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1025 if (c == '\n' && print_escape_newlines) |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1026 { |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1027 PRINTCHAR ('\\'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1028 PRINTCHAR ('n'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1029 } |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1030 else if (c == '\f' && print_escape_newlines) |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1031 { |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1032 PRINTCHAR ('\\'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1033 PRINTCHAR ('f'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1034 } |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1035 else |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1036 { |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1037 if (c == '\"' || c == '\\') |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1038 PRINTCHAR ('\\'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1039 PRINTCHAR (c); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1040 } |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1041 } |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1042 PRINTCHAR ('\"'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1043 |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1044 UNGCPRO; |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1045 } |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1046 else if (SUBRP (obj)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1047 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1048 strout ("#<subr ", -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1049 strout (XSUBR (obj)->symbol_name, -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1050 PRINTCHAR ('>'); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1051 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1052 #ifndef standalone |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1053 else if (WINDOWP (obj)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1054 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1055 strout ("#<window ", -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1056 sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number)); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1057 strout (buf, -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1058 if (!NILP (XWINDOW (obj)->buffer)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1059 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1060 strout (" on ", -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1061 print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1062 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1063 PRINTCHAR ('>'); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1064 } |
10301
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1065 else if (BUFFERP (obj)) |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1066 { |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1067 if (NILP (XBUFFER (obj)->name)) |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1068 strout ("#<killed buffer>", -1, printcharfun); |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1069 else if (escapeflag) |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1070 { |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1071 strout ("#<buffer ", -1, printcharfun); |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1072 print_string (XBUFFER (obj)->name, printcharfun); |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1073 PRINTCHAR ('>'); |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1074 } |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1075 else |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1076 print_string (XBUFFER (obj)->name, printcharfun); |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1077 } |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1078 else if (WINDOW_CONFIGURATIONP (obj)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1079 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1080 strout ("#<window-configuration>", -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1081 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1082 #ifdef MULTI_FRAME |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1083 else if (FRAMEP (obj)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1084 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1085 strout ((FRAME_LIVE_P (XFRAME (obj)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1086 ? "#<frame " : "#<dead frame "), |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1087 -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1088 print_string (XFRAME (obj)->name, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1089 sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj))); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1090 strout (buf, -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1091 PRINTCHAR ('>'); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1092 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1093 #endif |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1094 #endif /* not standalone */ |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1095 else |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1096 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1097 int size = XVECTOR (obj)->size; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1098 if (COMPILEDP (obj)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1099 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1100 PRINTCHAR ('#'); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1101 size &= PSEUDOVECTOR_SIZE_MASK; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1102 } |
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1103 if (CHAR_TABLE_P (obj)) |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1104 { |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1105 /* We print a char-table as if it were a vector, |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1106 lumping the parent and default slots in with the |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1107 character slots. But we add #^ as a prefix. */ |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1108 PRINTCHAR ('#'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1109 PRINTCHAR ('^'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1110 size &= PSEUDOVECTOR_SIZE_MASK; |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1111 } |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1112 if (size & PSEUDOVECTOR_FLAG) |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1113 goto badtype; |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1114 |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1115 PRINTCHAR ('['); |
329 | 1116 { |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1117 register int i; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1118 register Lisp_Object tem; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1119 for (i = 0; i < size; i++) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1120 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1121 if (i) PRINTCHAR (' '); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1122 tem = XVECTOR (obj)->contents[i]; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1123 print (tem, printcharfun, escapeflag); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1124 } |
329 | 1125 } |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1126 PRINTCHAR (']'); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1127 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1128 break; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1129 |
329 | 1130 #ifndef standalone |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1131 case Lisp_Misc: |
11241
5fed07fb66fb
(print): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11235
diff
changeset
|
1132 switch (XMISCTYPE (obj)) |
329 | 1133 { |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1134 case Lisp_Misc_Marker: |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1135 strout ("#<marker ", -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1136 if (!(XMARKER (obj)->buffer)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1137 strout ("in no buffer", -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1138 else |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1139 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1140 sprintf (buf, "at %d", marker_position (obj)); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1141 strout (buf, -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1142 strout (" in ", -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1143 print_string (XMARKER (obj)->buffer->name, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1144 } |
329 | 1145 PRINTCHAR ('>'); |
10301
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1146 break; |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1147 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1148 case Lisp_Misc_Overlay: |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1149 strout ("#<overlay ", -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1150 if (!(XMARKER (OVERLAY_START (obj))->buffer)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1151 strout ("in no buffer", -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1152 else |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1153 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1154 sprintf (buf, "from %d to %d in ", |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1155 marker_position (OVERLAY_START (obj)), |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1156 marker_position (OVERLAY_END (obj))); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1157 strout (buf, -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1158 print_string (XMARKER (OVERLAY_START (obj))->buffer->name, |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1159 printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1160 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1161 PRINTCHAR ('>'); |
10301
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1162 break; |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1163 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1164 /* Remaining cases shouldn't happen in normal usage, but let's print |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1165 them anyway for the benefit of the debugger. */ |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1166 case Lisp_Misc_Free: |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1167 strout ("#<misc free cell>", -1, printcharfun); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1168 break; |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1169 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1170 case Lisp_Misc_Intfwd: |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1171 sprintf (buf, "#<intfwd to %d>", *XINTFWD (obj)->intvar); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1172 strout (buf, -1, printcharfun); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1173 break; |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1174 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1175 case Lisp_Misc_Boolfwd: |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1176 sprintf (buf, "#<boolfwd to %s>", |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1177 (*XBOOLFWD (obj)->boolvar ? "t" : "nil")); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1178 strout (buf, -1, printcharfun); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1179 break; |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1180 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1181 case Lisp_Misc_Objfwd: |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1182 strout (buf, "#<objfwd to ", -1, printcharfun); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1183 print (*XOBJFWD (obj)->objvar, printcharfun, escapeflag); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1184 PRINTCHAR ('>'); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1185 break; |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1186 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1187 case Lisp_Misc_Buffer_Objfwd: |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1188 strout (buf, "#<buffer_objfwd to ", -1, printcharfun); |
10583
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1189 print (*(Lisp_Object *)((char *)current_buffer |
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1190 + XBUFFER_OBJFWD (obj)->offset), |
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1191 printcharfun, escapeflag); |
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1192 PRINTCHAR ('>'); |
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1193 break; |
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1194 |
11010
45ae0022c48a
(print): Rename perdisplay to kboard.
Karl Heuer <kwzh@gnu.org>
parents:
10993
diff
changeset
|
1195 case Lisp_Misc_Kboard_Objfwd: |
45ae0022c48a
(print): Rename perdisplay to kboard.
Karl Heuer <kwzh@gnu.org>
parents:
10993
diff
changeset
|
1196 strout (buf, "#<kboard_objfwd to ", -1, printcharfun); |
45ae0022c48a
(print): Rename perdisplay to kboard.
Karl Heuer <kwzh@gnu.org>
parents:
10993
diff
changeset
|
1197 print (*(Lisp_Object *)((char *) current_kboard |
45ae0022c48a
(print): Rename perdisplay to kboard.
Karl Heuer <kwzh@gnu.org>
parents:
10993
diff
changeset
|
1198 + XKBOARD_OBJFWD (obj)->offset), |
10993
e72bd65cab70
(print): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents:
10651
diff
changeset
|
1199 printcharfun, escapeflag); |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1200 PRINTCHAR ('>'); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1201 break; |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1202 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1203 case Lisp_Misc_Buffer_Local_Value: |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1204 strout ("#<buffer_local_value ", -1, printcharfun); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1205 goto do_buffer_local; |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1206 case Lisp_Misc_Some_Buffer_Local_Value: |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1207 strout ("#<some_buffer_local_value ", -1, printcharfun); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1208 do_buffer_local: |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1209 strout ("[realvalue] ", -1, printcharfun); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1210 print (XBUFFER_LOCAL_VALUE (obj)->car, printcharfun, escapeflag); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1211 strout ("[buffer] ", -1, printcharfun); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1212 print (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->car, |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1213 printcharfun, escapeflag); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1214 strout ("[alist-elt] ", -1, printcharfun); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1215 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr)->car, |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1216 printcharfun, escapeflag); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1217 strout ("[default-value] ", -1, printcharfun); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1218 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr)->cdr, |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1219 printcharfun, escapeflag); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1220 PRINTCHAR ('>'); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1221 break; |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1222 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1223 default: |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1224 goto badtype; |
329 | 1225 } |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1226 break; |
329 | 1227 #endif /* standalone */ |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1228 |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1229 default: |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1230 badtype: |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1231 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1232 /* We're in trouble if this happens! |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1233 Probably should just abort () */ |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1234 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, printcharfun); |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1235 if (MISCP (obj)) |
11241
5fed07fb66fb
(print): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11235
diff
changeset
|
1236 sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj)); |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1237 else if (VECTORLIKEP (obj)) |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1238 sprintf (buf, "(PVEC 0x%08x)", (int) XVECTOR (obj)->size); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1239 else |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1240 sprintf (buf, "(0x%02x)", (int) XTYPE (obj)); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1241 strout (buf, -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1242 strout (" Save your buffers immediately and please report this bug>", |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1243 -1, printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1244 } |
329 | 1245 } |
1246 | |
1247 print_depth--; | |
1248 } | |
1249 | |
1967 | 1250 #ifdef USE_TEXT_PROPERTIES |
1251 | |
1252 /* Print a description of INTERVAL using PRINTCHARFUN. | |
1253 This is part of printing a string that has text properties. */ | |
1254 | |
1255 void | |
1256 print_interval (interval, printcharfun) | |
1257 INTERVAL interval; | |
1258 Lisp_Object printcharfun; | |
1259 { | |
4003
49918d6c6dda
* print.c: Get rid of extra space at the end of print syntax for
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
1260 PRINTCHAR (' '); |
1967 | 1261 print (make_number (interval->position), printcharfun, 1); |
1262 PRINTCHAR (' '); | |
1263 print (make_number (interval->position + LENGTH (interval)), | |
1264 printcharfun, 1); | |
1265 PRINTCHAR (' '); | |
1266 print (interval->plist, printcharfun, 1); | |
1267 } | |
1268 | |
1269 #endif /* USE_TEXT_PROPERTIES */ | |
1270 | |
329 | 1271 void |
1272 syms_of_print () | |
1273 { | |
1274 staticpro (&Qprint_escape_newlines); | |
1275 Qprint_escape_newlines = intern ("print-escape-newlines"); | |
1276 | |
1277 DEFVAR_LISP ("standard-output", &Vstandard_output, | |
1278 "Output stream `print' uses by default for outputting a character.\n\ | |
1279 This may be any function of one argument.\n\ | |
1280 It may also be a buffer (output is inserted before point)\n\ | |
1281 or a marker (output is inserted and the marker is advanced)\n\ | |
13776
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1282 or the symbol t (output appears in the echo area)."); |
329 | 1283 Vstandard_output = Qt; |
1284 Qstandard_output = intern ("standard-output"); | |
1285 staticpro (&Qstandard_output); | |
1286 | |
1287 #ifdef LISP_FLOAT_TYPE | |
1288 DEFVAR_LISP ("float-output-format", &Vfloat_output_format, | |
687
e2b747dd6a6e
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
1289 "The format descriptor string used to print floats.\n\ |
329 | 1290 This is a %-spec like those accepted by `printf' in C,\n\ |
1291 but with some restrictions. It must start with the two characters `%.'.\n\ | |
1292 After that comes an integer precision specification,\n\ | |
1293 and then a letter which controls the format.\n\ | |
1294 The letters allowed are `e', `f' and `g'.\n\ | |
1295 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\ | |
1296 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\ | |
1297 Use `g' to choose the shorter of those two formats for the number at hand.\n\ | |
1298 The precision in any of these cases is the number of digits following\n\ | |
1299 the decimal point. With `f', a precision of 0 means to omit the\n\ | |
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1300 decimal point. 0 is not allowed with `e' or `g'.\n\n\ |
4224
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
1301 A value of nil means to use `%.17g'."); |
329 | 1302 Vfloat_output_format = Qnil; |
1303 Qfloat_output_format = intern ("float-output-format"); | |
1304 staticpro (&Qfloat_output_format); | |
1305 #endif /* LISP_FLOAT_TYPE */ | |
1306 | |
1307 DEFVAR_LISP ("print-length", &Vprint_length, | |
686
bd3068742807
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
621
diff
changeset
|
1308 "Maximum length of list to print before abbreviating.\n\ |
329 | 1309 A value of nil means no limit."); |
1310 Vprint_length = Qnil; | |
1311 | |
1312 DEFVAR_LISP ("print-level", &Vprint_level, | |
686
bd3068742807
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
621
diff
changeset
|
1313 "Maximum depth of list nesting to print before abbreviating.\n\ |
329 | 1314 A value of nil means no limit."); |
1315 Vprint_level = Qnil; | |
1316 | |
1317 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines, | |
6802
7d69da13c140
(syms_of_print): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
6533
diff
changeset
|
1318 "Non-nil means print newlines in strings as backslash-n.\n\ |
5852
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
1319 Also print formfeeds as backslash-f."); |
329 | 1320 print_escape_newlines = 0; |
1321 | |
1322 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */ | |
1323 staticpro (&Vprin1_to_string_buffer); | |
1324 | |
1325 defsubr (&Sprin1); | |
1326 defsubr (&Sprin1_to_string); | |
13776
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1327 defsubr (&Serror_message_string); |
329 | 1328 defsubr (&Sprinc); |
1329 defsubr (&Sprint); | |
1330 defsubr (&Sterpri); | |
1331 defsubr (&Swrite_char); | |
1332 defsubr (&Sexternal_debugging_output); | |
1333 | |
1334 Qexternal_debugging_output = intern ("external-debugging-output"); | |
1335 staticpro (&Qexternal_debugging_output); | |
1336 | |
1337 #ifndef standalone | |
1338 defsubr (&Swith_output_to_temp_buffer); | |
1339 #endif /* not standalone */ | |
1340 } |