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