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