Mercurial > emacs
annotate src/print.c @ 22605:c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
inserting in a unibyte buffer.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 24 Jun 1998 18:32:53 +0000 |
parents | f2d3eeec754e |
children | f85d55276ec5 |
rev | line source |
---|---|
329 | 1 /* Lisp object printing and output streams. |
21250
c6212caa6fe2
(PRINTPREPARE): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 1998 |
c6212caa6fe2
(PRINTPREPARE): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
3 Free Software Foundation, Inc. |
329 | 4 |
5 This file is part of GNU Emacs. | |
6 | |
7 GNU Emacs is free software; you can redistribute it and/or modify | |
8 it under the terms of the GNU General Public License as published by | |
621 | 9 the Free Software Foundation; either version 2, or (at your option) |
329 | 10 any later version. |
11 | |
12 GNU Emacs is distributed in the hope that it will be useful, | |
13 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 GNU General Public License for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 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
|
19 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
|
20 Boston, MA 02111-1307, USA. */ |
329 | 21 |
22 | |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
4224
diff
changeset
|
23 #include <config.h> |
329 | 24 #include <stdio.h> |
25 #include "lisp.h" | |
26 | |
27 #ifndef standalone | |
28 #include "buffer.h" | |
17040 | 29 #include "charset.h" |
766 | 30 #include "frame.h" |
329 | 31 #include "window.h" |
32 #include "process.h" | |
33 #include "dispextern.h" | |
34 #include "termchar.h" | |
11341 | 35 #include "keyboard.h" |
329 | 36 #endif /* not standalone */ |
37 | |
1967 | 38 #ifdef USE_TEXT_PROPERTIES |
39 #include "intervals.h" | |
40 #endif | |
41 | |
329 | 42 Lisp_Object Vstandard_output, Qstandard_output; |
43 | |
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
44 /* These are used to print like we read. */ |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
45 extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
46 |
329 | 47 #ifdef LISP_FLOAT_TYPE |
48 Lisp_Object Vfloat_output_format, Qfloat_output_format; | |
20121 | 49 |
50 /* Work around a problem that happens because math.h on hpux 7 | |
51 defines two static variables--which, in Emacs, are not really static, | |
52 because `static' is defined as nothing. The problem is that they are | |
53 defined both here and in lread.c. | |
54 These macros prevent the name conflict. */ | |
55 #if defined (HPUX) && !defined (HPUX8) | |
56 #define _MAXLDBL print_maxldbl | |
57 #define _NMAXLDBL print_nmaxldbl | |
58 #endif | |
59 | |
60 #include <math.h> | |
61 | |
62 #if STDC_HEADERS | |
63 #include <float.h> | |
64 #include <stdlib.h> | |
65 #endif | |
66 | |
67 /* Default to values appropriate for IEEE floating point. */ | |
68 #ifndef FLT_RADIX | |
69 #define FLT_RADIX 2 | |
70 #endif | |
71 #ifndef DBL_MANT_DIG | |
72 #define DBL_MANT_DIG 53 | |
73 #endif | |
74 #ifndef DBL_DIG | |
75 #define DBL_DIG 15 | |
76 #endif | |
20200
b69f8ea35fef
(DBL_MIN): Use workaround if DBL_MIN_REPLACEMENT is defined.
Paul Eggert <eggert@twinsun.com>
parents:
20121
diff
changeset
|
77 #ifndef DBL_MIN |
b69f8ea35fef
(DBL_MIN): Use workaround if DBL_MIN_REPLACEMENT is defined.
Paul Eggert <eggert@twinsun.com>
parents:
20121
diff
changeset
|
78 #define DBL_MIN 2.2250738585072014e-308 |
b69f8ea35fef
(DBL_MIN): Use workaround if DBL_MIN_REPLACEMENT is defined.
Paul Eggert <eggert@twinsun.com>
parents:
20121
diff
changeset
|
79 #endif |
b69f8ea35fef
(DBL_MIN): Use workaround if DBL_MIN_REPLACEMENT is defined.
Paul Eggert <eggert@twinsun.com>
parents:
20121
diff
changeset
|
80 |
b69f8ea35fef
(DBL_MIN): Use workaround if DBL_MIN_REPLACEMENT is defined.
Paul Eggert <eggert@twinsun.com>
parents:
20121
diff
changeset
|
81 #ifdef DBL_MIN_REPLACEMENT |
b69f8ea35fef
(DBL_MIN): Use workaround if DBL_MIN_REPLACEMENT is defined.
Paul Eggert <eggert@twinsun.com>
parents:
20121
diff
changeset
|
82 #undef DBL_MIN |
b69f8ea35fef
(DBL_MIN): Use workaround if DBL_MIN_REPLACEMENT is defined.
Paul Eggert <eggert@twinsun.com>
parents:
20121
diff
changeset
|
83 #define DBL_MIN DBL_MIN_REPLACEMENT |
b69f8ea35fef
(DBL_MIN): Use workaround if DBL_MIN_REPLACEMENT is defined.
Paul Eggert <eggert@twinsun.com>
parents:
20121
diff
changeset
|
84 #endif |
20121 | 85 |
86 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits | |
87 needed to express a float without losing information. | |
88 The general-case formula is valid for the usual case, IEEE floating point, | |
89 but many compilers can't optimize the formula to an integer constant, | |
90 so make a special case for it. */ | |
91 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53 | |
92 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */ | |
93 #else | |
94 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG)))) | |
95 #endif | |
96 | |
329 | 97 #endif /* LISP_FLOAT_TYPE */ |
98 | |
99 /* Avoid actual stack overflow in print. */ | |
100 int print_depth; | |
101 | |
379
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
102 /* Detect most circularities to print finite output. */ |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
103 #define PRINT_CIRCLE 200 |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
104 Lisp_Object being_printed[PRINT_CIRCLE]; |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
105 |
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
106 /* 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
|
107 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
|
108 char *print_buffer; |
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
109 |
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
110 /* 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
|
111 int print_buffer_size; |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
112 /* Chars stored in print_buffer. */ |
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
113 int print_buffer_pos; |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
114 /* Bytes stored in print_buffer. */ |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
115 int print_buffer_pos_byte; |
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
116 |
329 | 117 /* Maximum length of list to print in full; noninteger means |
118 effectively infinity */ | |
119 | |
120 Lisp_Object Vprint_length; | |
121 | |
122 /* Maximum depth of list to print in full; noninteger means | |
123 effectively infinity. */ | |
124 | |
125 Lisp_Object Vprint_level; | |
126 | |
127 /* Nonzero means print newlines in strings as \n. */ | |
128 | |
129 int print_escape_newlines; | |
130 | |
131 Lisp_Object Qprint_escape_newlines; | |
132 | |
22240
4e4c377f3310
(print_escape_nonascii): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22231
diff
changeset
|
133 /* Nonzero means to print single-byte non-ascii characters in strings as |
4e4c377f3310
(print_escape_nonascii): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22231
diff
changeset
|
134 octal escapes. */ |
4e4c377f3310
(print_escape_nonascii): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22231
diff
changeset
|
135 |
4e4c377f3310
(print_escape_nonascii): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22231
diff
changeset
|
136 int print_escape_nonascii; |
4e4c377f3310
(print_escape_nonascii): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22231
diff
changeset
|
137 |
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
138 /* Nonzero means print (quote foo) forms as 'foo, etc. */ |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
139 |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
140 int print_quoted; |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
141 |
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
142 /* Non-nil means print #: before uninterned symbols. |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
143 Neither t nor nil means so that and don't clear Vprint_gensym_alist |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
144 on entry to and exit from print functions. */ |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
145 |
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
146 Lisp_Object Vprint_gensym; |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
147 |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
148 /* Association list of certain objects that are `eq' in the form being |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
149 printed and which should be `eq' when read back in, using the #n=object |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
150 and #n# reader forms. Each element has the form (object . n). */ |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
151 |
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
152 Lisp_Object Vprint_gensym_alist; |
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
153 |
10418
fdad41459fd6
(printchar, strout): Call message_dolog.
Karl Heuer <kwzh@gnu.org>
parents:
10301
diff
changeset
|
154 /* Nonzero means print newline to stdout before next minibuffer message. |
329 | 155 Defined in xdisp.c */ |
156 | |
157 extern int noninteractive_need_newline; | |
10418
fdad41459fd6
(printchar, strout): Call message_dolog.
Karl Heuer <kwzh@gnu.org>
parents:
10301
diff
changeset
|
158 |
19001
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
159 extern int minibuffer_auto_raise; |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
160 |
329 | 161 #ifdef MAX_PRINT_CHARS |
162 static int print_chars; | |
163 static int max_print; | |
164 #endif /* MAX_PRINT_CHARS */ | |
1967 | 165 |
166 void print_interval (); | |
329 | 167 |
168 #if 0 | |
169 /* Convert between chars and GLYPHs */ | |
170 | |
171 int | |
172 glyphlen (glyphs) | |
173 register GLYPH *glyphs; | |
174 { | |
175 register int i = 0; | |
176 | |
177 while (glyphs[i]) | |
178 i++; | |
179 return i; | |
180 } | |
181 | |
182 void | |
183 str_to_glyph_cpy (str, glyphs) | |
184 char *str; | |
185 GLYPH *glyphs; | |
186 { | |
187 register GLYPH *gp = glyphs; | |
188 register char *cp = str; | |
189 | |
190 while (*cp) | |
191 *gp++ = *cp++; | |
192 } | |
193 | |
194 void | |
195 str_to_glyph_ncpy (str, glyphs, n) | |
196 char *str; | |
197 GLYPH *glyphs; | |
198 register int n; | |
199 { | |
200 register GLYPH *gp = glyphs; | |
201 register char *cp = str; | |
202 | |
203 while (n-- > 0) | |
204 *gp++ = *cp++; | |
205 } | |
206 | |
207 void | |
208 glyph_to_str_cpy (glyphs, str) | |
209 GLYPH *glyphs; | |
210 char *str; | |
211 { | |
212 register GLYPH *gp = glyphs; | |
213 register char *cp = str; | |
214 | |
215 while (*gp) | |
216 *str++ = *gp++ & 0377; | |
217 } | |
218 #endif | |
219 | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3377
diff
changeset
|
220 /* Low level output routines for characters and strings */ |
329 | 221 |
222 /* Lisp functions to do output using a stream | |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
223 must have the stream in a variable called printcharfun |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
224 and must start with PRINTPREPARE, end with PRINTFINISH, |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
225 and use PRINTDECLARE to declare common variables. |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
226 Use PRINTCHAR to output one character, |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
227 or call strout to output a block of characters. |
329 | 228 */ |
229 | |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
230 #define PRINTDECLARE \ |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
231 struct buffer *old = current_buffer; \ |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
232 int old_point = -1, start_point; \ |
20549
ba676f083e7c
(PRINTDECLARE): Declare old_point_byte and start_point_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20377
diff
changeset
|
233 int old_point_byte, start_point_byte; \ |
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
234 int specpdl_count = specpdl_ptr - specpdl; \ |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
235 int free_print_buffer = 0; \ |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
236 Lisp_Object original |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
237 |
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
238 #define PRINTPREPARE \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
239 original = printcharfun; \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
240 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
|
241 if (BUFFERP (printcharfun)) \ |
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
242 { \ |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
243 if (XBUFFER (printcharfun) != current_buffer) \ |
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
244 Fset_buffer (printcharfun); \ |
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
245 printcharfun = Qnil; \ |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
246 } \ |
9117
f69e6cf74874
(PRINTPREPARE, PRINTFINISH, float_to_string, print): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8854
diff
changeset
|
247 if (MARKERP (printcharfun)) \ |
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
248 { \ |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
249 if (!(XMARKER (original)->buffer)) \ |
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
250 error ("Marker does not point anywhere"); \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
251 if (XMARKER (original)->buffer != current_buffer) \ |
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
252 set_buffer_internal (XMARKER (original)->buffer); \ |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15908
diff
changeset
|
253 old_point = PT; \ |
20549
ba676f083e7c
(PRINTDECLARE): Declare old_point_byte and start_point_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20377
diff
changeset
|
254 old_point_byte = PT_BYTE; \ |
ba676f083e7c
(PRINTDECLARE): Declare old_point_byte and start_point_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20377
diff
changeset
|
255 SET_PT_BOTH (marker_position (printcharfun), \ |
ba676f083e7c
(PRINTDECLARE): Declare old_point_byte and start_point_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20377
diff
changeset
|
256 marker_byte_position (printcharfun)); \ |
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15908
diff
changeset
|
257 start_point = PT; \ |
20549
ba676f083e7c
(PRINTDECLARE): Declare old_point_byte and start_point_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20377
diff
changeset
|
258 start_point_byte = PT_BYTE; \ |
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
259 printcharfun = Qnil; \ |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
260 } \ |
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
261 if (NILP (printcharfun)) \ |
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
262 { \ |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
263 Lisp_Object string; \ |
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
264 if (print_buffer != 0) \ |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
265 { \ |
21250
c6212caa6fe2
(PRINTPREPARE): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
266 string = make_string_from_bytes (print_buffer, \ |
c6212caa6fe2
(PRINTPREPARE): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
267 print_buffer_pos, \ |
c6212caa6fe2
(PRINTPREPARE): Use make_string_from_bytes.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
268 print_buffer_pos_byte); \ |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
269 record_unwind_protect (print_unwind, string); \ |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
270 } \ |
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
271 else \ |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
272 { \ |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
273 print_buffer_size = 1000; \ |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
274 print_buffer = (char *) xmalloc (print_buffer_size); \ |
16513
ecf0700e9550
(PRINTPREPARE): Really do set free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16512
diff
changeset
|
275 free_print_buffer = 1; \ |
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
276 } \ |
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
277 print_buffer_pos = 0; \ |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
278 print_buffer_pos_byte = 0; \ |
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
279 } \ |
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
280 if (!CONSP (Vprint_gensym)) \ |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
281 Vprint_gensym_alist = Qnil |
329 | 282 |
22605
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
283 #define PRINTFINISH \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
284 if (NILP (printcharfun)) \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
285 { \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
286 if (print_buffer_pos != print_buffer_pos_byte \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
287 && NILP (current_buffer->enable_multibyte_characters)) \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
288 { \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
289 unsigned char *temp \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
290 = (unsigned char *) alloca (print_buffer_pos + 1); \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
291 copy_text (print_buffer, temp, print_buffer_pos_byte, \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
292 1, 0); \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
293 insert_1_both (temp, print_buffer_pos, \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
294 print_buffer_pos, 0, 1, 0); \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
295 } \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
296 else \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
297 insert_1_both (print_buffer, print_buffer_pos, \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
298 print_buffer_pos_byte, 0, 1, 0); \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
299 } \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
300 if (free_print_buffer) \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
301 { \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
302 xfree (print_buffer); \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
303 print_buffer = 0; \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
304 } \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
305 unbind_to (specpdl_count, Qnil); \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
306 if (MARKERP (original)) \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
307 set_marker_both (original, Qnil, PT, PT_BYTE); \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
308 if (old_point >= 0) \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
309 SET_PT_BOTH (old_point + (old_point >= start_point \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
310 ? PT - start_point : 0), \ |
20549
ba676f083e7c
(PRINTDECLARE): Declare old_point_byte and start_point_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20377
diff
changeset
|
311 old_point_byte + (old_point_byte >= start_point_byte \ |
ba676f083e7c
(PRINTDECLARE): Declare old_point_byte and start_point_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20377
diff
changeset
|
312 ? PT_BYTE - start_point_byte : 0)); \ |
22605
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
313 if (old != current_buffer) \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
314 set_buffer_internal (old); \ |
c3ffffc994d1
(PRINTFINISH): Convert text to unibyte before
Richard M. Stallman <rms@gnu.org>
parents:
22544
diff
changeset
|
315 if (!CONSP (Vprint_gensym)) \ |
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
316 Vprint_gensym_alist = Qnil |
329 | 317 |
318 #define PRINTCHAR(ch) printchar (ch, printcharfun) | |
319 | |
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
320 /* Nonzero if there is no room to print any more characters |
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
321 so print might as well return right away. */ |
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
322 |
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
323 #define PRINTFULLP() \ |
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
324 (EQ (printcharfun, Qt) && !noninteractive \ |
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
325 && printbufidx >= FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window))))) |
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
326 |
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
327 /* This is used to restore the saved contents of print_buffer |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
328 when there is a recursive call to print. */ |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
329 static Lisp_Object |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
330 print_unwind (saved_text) |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
331 Lisp_Object saved_text; |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
332 { |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
333 bcopy (XSTRING (saved_text)->data, print_buffer, XSTRING (saved_text)->size); |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
334 } |
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
335 |
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
336 /* Index of first unused element of FRAME_MESSAGE_BUF (mini_frame). */ |
329 | 337 static int printbufidx; |
338 | |
339 static void | |
340 printchar (ch, fun) | |
17040 | 341 unsigned int ch; |
329 | 342 Lisp_Object fun; |
343 { | |
344 Lisp_Object ch1; | |
345 | |
346 #ifdef MAX_PRINT_CHARS | |
347 if (max_print) | |
348 print_chars++; | |
349 #endif /* MAX_PRINT_CHARS */ | |
350 #ifndef standalone | |
351 if (EQ (fun, Qnil)) | |
352 { | |
17040 | 353 int len; |
20303
13efdf0fe96e
(printchar): Declare `work' as unsigned char.
Andreas Schwab <schwab@suse.de>
parents:
20200
diff
changeset
|
354 unsigned char work[4], *str; |
17040 | 355 |
329 | 356 QUIT; |
17040 | 357 len = CHAR_STRING (ch, work, str); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
358 if (print_buffer_pos_byte + len >= print_buffer_size) |
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
359 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
|
360 print_buffer_size *= 2); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
361 bcopy (str, print_buffer + print_buffer_pos_byte, len); |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
362 print_buffer_pos += 1; |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
363 print_buffer_pos_byte += len; |
329 | 364 return; |
365 } | |
366 | |
367 if (EQ (fun, Qt)) | |
368 { | |
6808
514a324b3681
(printchar, strout): Use FRAME_PTR, not struct frame *.
Karl Heuer <kwzh@gnu.org>
parents:
6802
diff
changeset
|
369 FRAME_PTR mini_frame |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
370 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window))); |
17040 | 371 unsigned char work[4], *str; |
372 int len = CHAR_STRING (ch, work, str); | |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
373 |
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
374 QUIT; |
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
375 |
329 | 376 if (noninteractive) |
377 { | |
17040 | 378 while (len--) |
379 putchar (*str), str++; | |
329 | 380 noninteractive_need_newline = 1; |
381 return; | |
382 } | |
383 | |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
384 if (echo_area_glyphs != FRAME_MESSAGE_BUF (mini_frame) |
329 | 385 || !message_buf_print) |
386 { | |
10568
275f62e27ee2
(printchar, strout): Use message_log_maybe_newline.
Karl Heuer <kwzh@gnu.org>
parents:
10482
diff
changeset
|
387 message_log_maybe_newline (); |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
388 echo_area_glyphs = FRAME_MESSAGE_BUF (mini_frame); |
329 | 389 printbufidx = 0; |
5233
83e771f33251
(printchar, strout): Set echo_area_glyphs_length.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
390 echo_area_glyphs_length = 0; |
329 | 391 message_buf_print = 1; |
19001
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
392 |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
393 if (minibuffer_auto_raise) |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
394 { |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
395 Lisp_Object mini_window; |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
396 |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
397 /* Get the frame containing the minibuffer |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
398 that the selected frame is using. */ |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
399 mini_window = FRAME_MINIBUF_WINDOW (selected_frame); |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
400 |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
401 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window))); |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
402 } |
329 | 403 } |
404 | |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
405 message_dolog (str, len, 0, len > 1); |
20888
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
406 |
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
407 /* Convert message to multibyte if we are now adding multibyte text. */ |
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
408 if (! NILP (current_buffer->enable_multibyte_characters) |
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
409 && ! message_enable_multibyte |
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
410 && printbufidx > 0) |
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
411 { |
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
412 int size = count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame), |
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
413 printbufidx); |
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
414 unsigned char *tembuf = (unsigned char *) alloca (size + 1); |
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
415 copy_text (FRAME_MESSAGE_BUF (mini_frame), tembuf, printbufidx, |
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
416 0, 1); |
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
417 printbufidx = size; |
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
418 if (printbufidx > FRAME_MESSAGE_BUF_SIZE (mini_frame)) |
21499
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
419 { |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
420 printbufidx = FRAME_MESSAGE_BUF_SIZE (mini_frame); |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
421 /* Rewind incomplete multi-byte form. */ |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
422 while (printbufidx > 0 && tembuf[printbufidx] >= 0xA0) |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
423 printbufidx--; |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
424 } |
20888
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
425 bcopy (tembuf, FRAME_MESSAGE_BUF (mini_frame), printbufidx); |
21499
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
426 message_enable_multibyte = 1; |
20888
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
427 } |
98172ad9f511
(printchar): When outputting to echo area,
Richard M. Stallman <rms@gnu.org>
parents:
20862
diff
changeset
|
428 |
17040 | 429 if (printbufidx < FRAME_MESSAGE_BUF_SIZE (mini_frame) - len) |
430 bcopy (str, &FRAME_MESSAGE_BUF (mini_frame)[printbufidx], len), | |
431 printbufidx += len; | |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
432 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
|
433 echo_area_glyphs_length = printbufidx; |
329 | 434 |
435 return; | |
436 } | |
437 #endif /* not standalone */ | |
438 | |
9317
58f6a917533b
(printchar): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents:
9276
diff
changeset
|
439 XSETFASTINT (ch1, ch); |
329 | 440 call1 (fun, ch1); |
441 } | |
442 | |
443 static void | |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
444 strout (ptr, size, size_byte, printcharfun, multibyte) |
329 | 445 char *ptr; |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
446 int size, size_byte; |
329 | 447 Lisp_Object printcharfun; |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
448 int multibyte; |
329 | 449 { |
450 int i = 0; | |
451 | |
17040 | 452 if (size < 0) |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
453 size_byte = size = strlen (ptr); |
17040 | 454 |
329 | 455 if (EQ (printcharfun, Qnil)) |
456 { | |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
457 if (print_buffer_pos_byte + size_byte > print_buffer_size) |
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
458 { |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
459 print_buffer_size = print_buffer_size * 2 + size_byte; |
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
460 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
|
461 print_buffer_size); |
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
462 } |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
463 bcopy (ptr, print_buffer + print_buffer_pos_byte, size_byte); |
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
464 print_buffer_pos += size; |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
465 print_buffer_pos_byte += size_byte; |
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
466 |
329 | 467 #ifdef MAX_PRINT_CHARS |
468 if (max_print) | |
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
469 print_chars += size; |
329 | 470 #endif /* MAX_PRINT_CHARS */ |
471 return; | |
472 } | |
473 if (EQ (printcharfun, Qt)) | |
474 { | |
6808
514a324b3681
(printchar, strout): Use FRAME_PTR, not struct frame *.
Karl Heuer <kwzh@gnu.org>
parents:
6802
diff
changeset
|
475 FRAME_PTR mini_frame |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
476 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window))); |
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
477 |
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
478 QUIT; |
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
479 |
329 | 480 #ifdef MAX_PRINT_CHARS |
481 if (max_print) | |
17040 | 482 print_chars += size; |
329 | 483 #endif /* MAX_PRINT_CHARS */ |
484 | |
485 if (noninteractive) | |
486 { | |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
487 fwrite (ptr, 1, size_byte, stdout); |
329 | 488 noninteractive_need_newline = 1; |
489 return; | |
490 } | |
491 | |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
492 if (echo_area_glyphs != FRAME_MESSAGE_BUF (mini_frame) |
329 | 493 || !message_buf_print) |
494 { | |
10568
275f62e27ee2
(printchar, strout): Use message_log_maybe_newline.
Karl Heuer <kwzh@gnu.org>
parents:
10482
diff
changeset
|
495 message_log_maybe_newline (); |
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
496 echo_area_glyphs = FRAME_MESSAGE_BUF (mini_frame); |
329 | 497 printbufidx = 0; |
5233
83e771f33251
(printchar, strout): Set echo_area_glyphs_length.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
498 echo_area_glyphs_length = 0; |
329 | 499 message_buf_print = 1; |
19001
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
500 |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
501 if (minibuffer_auto_raise) |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
502 { |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
503 Lisp_Object mini_window; |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
504 |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
505 /* Get the frame containing the minibuffer |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
506 that the selected frame is using. */ |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
507 mini_window = FRAME_MINIBUF_WINDOW (selected_frame); |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
508 |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
509 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window))); |
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
510 } |
329 | 511 } |
512 | |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
513 message_dolog (ptr, size_byte, 0, multibyte); |
21499
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
514 |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
515 /* Convert message to multibyte if we are now adding multibyte text. */ |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
516 if (multibyte |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
517 && ! message_enable_multibyte |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
518 && printbufidx > 0) |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
519 { |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
520 int size = count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame), |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
521 printbufidx); |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
522 unsigned char *tembuf = (unsigned char *) alloca (size + 1); |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
523 copy_text (FRAME_MESSAGE_BUF (mini_frame), tembuf, printbufidx, |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
524 0, 1); |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
525 printbufidx = size; |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
526 if (printbufidx > FRAME_MESSAGE_BUF_SIZE (mini_frame)) |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
527 { |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
528 printbufidx = FRAME_MESSAGE_BUF_SIZE (mini_frame); |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
529 /* Rewind incomplete multi-byte form. */ |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
530 while (printbufidx > 0 && tembuf[printbufidx] >= 0xA0) |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
531 printbufidx--; |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
532 } |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
533 |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
534 bcopy (tembuf, FRAME_MESSAGE_BUF (mini_frame), printbufidx); |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
535 } |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
536 |
22528
917ec8bf0d89
(strout): Show multibyte message correctly.
Karl Heuer <kwzh@gnu.org>
parents:
22243
diff
changeset
|
537 if (multibyte) |
917ec8bf0d89
(strout): Show multibyte message correctly.
Karl Heuer <kwzh@gnu.org>
parents:
22243
diff
changeset
|
538 message_enable_multibyte = 1; |
917ec8bf0d89
(strout): Show multibyte message correctly.
Karl Heuer <kwzh@gnu.org>
parents:
22243
diff
changeset
|
539 |
21499
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
540 /* Compute how much of the new text will fit there. */ |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
541 if (size_byte > FRAME_MESSAGE_BUF_SIZE (mini_frame) - printbufidx - 1) |
17040 | 542 { |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
543 size_byte = FRAME_MESSAGE_BUF_SIZE (mini_frame) - printbufidx - 1; |
17040 | 544 /* Rewind incomplete multi-byte form. */ |
21499
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
545 while (size_byte && (unsigned char) ptr[size_byte] >= 0xA0) |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
546 size_byte--; |
17040 | 547 } |
21499
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
548 |
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
549 /* Put that part of the new text in. */ |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
550 bcopy (ptr, &FRAME_MESSAGE_BUF (mini_frame) [printbufidx], size_byte); |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
551 printbufidx += size_byte; |
21499
a063399999d8
(strout): Convert old echo area to multibyte, like printchar.
Karl Heuer <kwzh@gnu.org>
parents:
21484
diff
changeset
|
552 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
|
553 echo_area_glyphs_length = printbufidx; |
329 | 554 |
555 return; | |
556 } | |
557 | |
17040 | 558 i = 0; |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
559 if (size == size_byte) |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
560 while (i < size_byte) |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
561 { |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
562 int ch = ptr[i++]; |
17040 | 563 |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
564 PRINTCHAR (ch); |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
565 } |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
566 else |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
567 while (i < size_byte) |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
568 { |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
569 /* Here, we must convert each multi-byte form to the |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
570 corresponding character code before handing it to PRINTCHAR. */ |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
571 int len; |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
572 int ch = STRING_CHAR_AND_LENGTH (ptr + i, size_byte - i, len); |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
573 |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
574 PRINTCHAR (ch); |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
575 i += len; |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
576 } |
329 | 577 } |
578 | |
579 /* 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
|
580 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
|
581 because printing one char can relocate. */ |
329 | 582 |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
583 static void |
329 | 584 print_string (string, printcharfun) |
585 Lisp_Object string; | |
586 Lisp_Object printcharfun; | |
587 { | |
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
588 if (EQ (printcharfun, Qt) || NILP (printcharfun)) |
22544
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
589 { |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
590 int chars; |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
591 |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
592 if (STRING_MULTIBYTE (string)) |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
593 chars = XSTRING (string)->size; |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
594 else if (EQ (printcharfun, Qt) |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
595 ? ! NILP (buffer_defaults.enable_multibyte_characters) |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
596 : ! NILP (current_buffer->enable_multibyte_characters)) |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
597 chars = multibyte_chars_in_text (XSTRING (string)->data, |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
598 STRING_BYTES (XSTRING (string))); |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
599 else |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
600 chars = STRING_BYTES (XSTRING (string)); |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
601 |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
602 /* strout is safe for output to a frame (echo area) or to print_buffer. */ |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
603 strout (XSTRING (string)->data, |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
604 chars, STRING_BYTES (XSTRING (string)), |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
605 printcharfun, STRING_MULTIBYTE (string)); |
f2d3eeec754e
(print_string): Properly compute number of chars
Karl Heuer <kwzh@gnu.org>
parents:
22528
diff
changeset
|
606 } |
329 | 607 else |
608 { | |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
609 /* Otherwise, string may be relocated by printing one char. |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
610 So re-fetch the string address for each character. */ |
329 | 611 int i; |
612 int size = XSTRING (string)->size; | |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21142
diff
changeset
|
613 int size_byte = STRING_BYTES (XSTRING (string)); |
329 | 614 struct gcpro gcpro1; |
615 GCPRO1 (string); | |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
616 if (size == size_byte) |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
617 for (i = 0; i < size; i++) |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
618 PRINTCHAR (XSTRING (string)->data[i]); |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
619 else |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
620 for (i = 0; i < size_byte; i++) |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
621 { |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
622 /* Here, we must convert each multi-byte form to the |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
623 corresponding character code before handing it to PRINTCHAR. */ |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
624 int len; |
22183
3eedfddbbadd
(print_string): Don't ignore garbage bytes following a
Kenichi Handa <handa@m17n.org>
parents:
21514
diff
changeset
|
625 int ch = STRING_CHAR_AND_CHAR_LENGTH (XSTRING (string)->data + i, |
3eedfddbbadd
(print_string): Don't ignore garbage bytes following a
Kenichi Handa <handa@m17n.org>
parents:
21514
diff
changeset
|
626 size_byte - i, len); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
627 |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
628 PRINTCHAR (ch); |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
629 i += len; |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
630 } |
329 | 631 UNGCPRO; |
632 } | |
633 } | |
634 | |
635 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
|
636 "Output character CHARACTER to stream PRINTCHARFUN.\n\ |
7185 | 637 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
|
638 (character, printcharfun) |
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
639 Lisp_Object character, printcharfun; |
329 | 640 { |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
641 PRINTDECLARE; |
329 | 642 |
520 | 643 if (NILP (printcharfun)) |
329 | 644 printcharfun = Vstandard_output; |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
645 CHECK_NUMBER (character, 0); |
329 | 646 PRINTPREPARE; |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
647 PRINTCHAR (XINT (character)); |
329 | 648 PRINTFINISH; |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
649 return character; |
329 | 650 } |
651 | |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
652 /* Used from outside of print.c to print a block of SIZE |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
653 single-byte chars at DATA on the default output stream. |
329 | 654 Do not use this on the contents of a Lisp string. */ |
655 | |
20303
13efdf0fe96e
(printchar): Declare `work' as unsigned char.
Andreas Schwab <schwab@suse.de>
parents:
20200
diff
changeset
|
656 void |
329 | 657 write_string (data, size) |
658 char *data; | |
659 int size; | |
660 { | |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
661 PRINTDECLARE; |
329 | 662 Lisp_Object printcharfun; |
663 | |
664 printcharfun = Vstandard_output; | |
665 | |
666 PRINTPREPARE; | |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
667 strout (data, size, size, printcharfun, 0); |
329 | 668 PRINTFINISH; |
669 } | |
670 | |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
671 /* Used from outside of print.c to print a block of SIZE |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
672 single-byte chars at DATA on a specified stream PRINTCHARFUN. |
329 | 673 Do not use this on the contents of a Lisp string. */ |
674 | |
20303
13efdf0fe96e
(printchar): Declare `work' as unsigned char.
Andreas Schwab <schwab@suse.de>
parents:
20200
diff
changeset
|
675 void |
329 | 676 write_string_1 (data, size, printcharfun) |
677 char *data; | |
678 int size; | |
679 Lisp_Object printcharfun; | |
680 { | |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
681 PRINTDECLARE; |
329 | 682 |
683 PRINTPREPARE; | |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
684 strout (data, size, size, printcharfun, 0); |
329 | 685 PRINTFINISH; |
686 } | |
687 | |
688 | |
689 #ifndef standalone | |
690 | |
691 void | |
692 temp_output_buffer_setup (bufname) | |
693 char *bufname; | |
694 { | |
695 register struct buffer *old = current_buffer; | |
696 register Lisp_Object buf; | |
697 | |
698 Fset_buffer (Fget_buffer_create (build_string (bufname))); | |
699 | |
11114
c8ab5c627f74
(temp_output_buffer_setup): (Re)set the default
Richard M. Stallman <rms@gnu.org>
parents:
11010
diff
changeset
|
700 current_buffer->directory = old->directory; |
329 | 701 current_buffer->read_only = Qnil; |
21484
e4f63bf20c03
(temp_output_buffer_setup): Clear out overlays,
Karl Heuer <kwzh@gnu.org>
parents:
21480
diff
changeset
|
702 current_buffer->filename = Qnil; |
e4f63bf20c03
(temp_output_buffer_setup): Clear out overlays,
Karl Heuer <kwzh@gnu.org>
parents:
21480
diff
changeset
|
703 current_buffer->undo_list = Qt; |
e4f63bf20c03
(temp_output_buffer_setup): Clear out overlays,
Karl Heuer <kwzh@gnu.org>
parents:
21480
diff
changeset
|
704 current_buffer->overlays_before = Qnil; |
e4f63bf20c03
(temp_output_buffer_setup): Clear out overlays,
Karl Heuer <kwzh@gnu.org>
parents:
21480
diff
changeset
|
705 current_buffer->overlays_after = Qnil; |
e4f63bf20c03
(temp_output_buffer_setup): Clear out overlays,
Karl Heuer <kwzh@gnu.org>
parents:
21480
diff
changeset
|
706 current_buffer->enable_multibyte_characters |
e4f63bf20c03
(temp_output_buffer_setup): Clear out overlays,
Karl Heuer <kwzh@gnu.org>
parents:
21480
diff
changeset
|
707 = buffer_defaults.enable_multibyte_characters; |
329 | 708 Ferase_buffer (); |
709 | |
9276
ae62e12feac5
(temp_output_buffer_setup): Use new accessor macros instead of calling XSET
Karl Heuer <kwzh@gnu.org>
parents:
9117
diff
changeset
|
710 XSETBUFFER (buf, current_buffer); |
329 | 711 specbind (Qstandard_output, buf); |
712 | |
713 set_buffer_internal (old); | |
714 } | |
715 | |
716 Lisp_Object | |
717 internal_with_output_to_temp_buffer (bufname, function, args) | |
718 char *bufname; | |
21514 | 719 Lisp_Object (*function) P_ ((Lisp_Object)); |
329 | 720 Lisp_Object args; |
721 { | |
722 int count = specpdl_ptr - specpdl; | |
723 Lisp_Object buf, val; | |
8315
8921d0012bd5
(internal_with_output_to_temp_buffer): gcpro things.
Richard M. Stallman <rms@gnu.org>
parents:
7185
diff
changeset
|
724 struct gcpro gcpro1; |
329 | 725 |
8315
8921d0012bd5
(internal_with_output_to_temp_buffer): gcpro things.
Richard M. Stallman <rms@gnu.org>
parents:
7185
diff
changeset
|
726 GCPRO1 (args); |
329 | 727 record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); |
728 temp_output_buffer_setup (bufname); | |
729 buf = Vstandard_output; | |
8315
8921d0012bd5
(internal_with_output_to_temp_buffer): gcpro things.
Richard M. Stallman <rms@gnu.org>
parents:
7185
diff
changeset
|
730 UNGCPRO; |
329 | 731 |
732 val = (*function) (args); | |
733 | |
8315
8921d0012bd5
(internal_with_output_to_temp_buffer): gcpro things.
Richard M. Stallman <rms@gnu.org>
parents:
7185
diff
changeset
|
734 GCPRO1 (val); |
329 | 735 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
|
736 UNGCPRO; |
329 | 737 |
738 return unbind_to (count, val); | |
739 } | |
740 | |
741 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer, | |
742 1, UNEVALLED, 0, | |
743 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\ | |
744 The buffer is cleared out initially, and marked as unmodified when done.\n\ | |
745 All output done by BODY is inserted in that buffer by default.\n\ | |
746 The buffer is displayed in another window, but not selected.\n\ | |
747 The value of the last form in BODY is returned.\n\ | |
748 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
|
749 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\ |
329 | 750 to get the buffer displayed. It gets one argument, the buffer to display.") |
751 (args) | |
752 Lisp_Object args; | |
753 { | |
754 struct gcpro gcpro1; | |
755 Lisp_Object name; | |
756 int count = specpdl_ptr - specpdl; | |
757 Lisp_Object buf, val; | |
758 | |
759 GCPRO1(args); | |
760 name = Feval (Fcar (args)); | |
761 UNGCPRO; | |
762 | |
763 CHECK_STRING (name, 0); | |
764 temp_output_buffer_setup (XSTRING (name)->data); | |
765 buf = Vstandard_output; | |
766 | |
767 val = Fprogn (Fcdr (args)); | |
768 | |
769 temp_output_buffer_show (buf); | |
770 | |
771 return unbind_to (count, val); | |
772 } | |
773 #endif /* not standalone */ | |
774 | |
775 static void print (); | |
776 | |
777 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0, | |
7185 | 778 "Output a newline to stream PRINTCHARFUN.\n\ |
779 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.") | |
329 | 780 (printcharfun) |
781 Lisp_Object printcharfun; | |
782 { | |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
783 PRINTDECLARE; |
329 | 784 |
520 | 785 if (NILP (printcharfun)) |
329 | 786 printcharfun = Vstandard_output; |
787 PRINTPREPARE; | |
788 PRINTCHAR ('\n'); | |
789 PRINTFINISH; | |
790 return Qt; | |
791 } | |
792 | |
793 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0, | |
794 "Output the printed representation of OBJECT, any Lisp object.\n\ | |
795 Quoting characters are printed when needed to make output that `read'\n\ | |
796 can handle, whenever this is possible.\n\ | |
7185 | 797 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
|
798 (object, printcharfun) |
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
799 Lisp_Object object, printcharfun; |
329 | 800 { |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
801 PRINTDECLARE; |
329 | 802 |
803 #ifdef MAX_PRINT_CHARS | |
804 max_print = 0; | |
805 #endif /* MAX_PRINT_CHARS */ | |
520 | 806 if (NILP (printcharfun)) |
329 | 807 printcharfun = Vstandard_output; |
808 PRINTPREPARE; | |
809 print_depth = 0; | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
810 print (object, printcharfun, 1); |
329 | 811 PRINTFINISH; |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
812 return object; |
329 | 813 } |
814 | |
815 /* a buffer which is used to hold output being built by prin1-to-string */ | |
816 Lisp_Object Vprin1_to_string_buffer; | |
817 | |
818 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0, | |
819 "Return a string containing the printed representation of OBJECT,\n\ | |
820 any Lisp object. Quoting characters are used when needed to make output\n\ | |
821 that `read' can handle, whenever this is possible, unless the optional\n\ | |
822 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
|
823 (object, noescape) |
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
824 Lisp_Object object, noescape; |
329 | 825 { |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
826 PRINTDECLARE; |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
827 Lisp_Object printcharfun; |
15270
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
828 struct gcpro gcpro1, gcpro2; |
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
829 Lisp_Object tem; |
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
830 |
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
831 /* 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
|
832 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
|
833 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
|
834 tem = Vdeactivate_mark; |
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
835 GCPRO2 (object, tem); |
329 | 836 |
837 printcharfun = Vprin1_to_string_buffer; | |
838 PRINTPREPARE; | |
839 print_depth = 0; | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
840 print (object, printcharfun, NILP (noescape)); |
329 | 841 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */ |
842 PRINTFINISH; | |
843 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
|
844 object = Fbuffer_string (); |
329 | 845 |
846 Ferase_buffer (); | |
847 set_buffer_internal (old); | |
15270
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
848 |
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
849 Vdeactivate_mark = tem; |
329 | 850 UNGCPRO; |
851 | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
852 return object; |
329 | 853 } |
854 | |
855 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0, | |
856 "Output the printed representation of OBJECT, any Lisp object.\n\ | |
857 No quoting characters are used; no delimiters are printed around\n\ | |
858 the contents of strings.\n\ | |
7185 | 859 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
|
860 (object, printcharfun) |
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
861 Lisp_Object object, printcharfun; |
329 | 862 { |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
863 PRINTDECLARE; |
329 | 864 |
520 | 865 if (NILP (printcharfun)) |
329 | 866 printcharfun = Vstandard_output; |
867 PRINTPREPARE; | |
868 print_depth = 0; | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
869 print (object, printcharfun, 0); |
329 | 870 PRINTFINISH; |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
871 return object; |
329 | 872 } |
873 | |
874 DEFUN ("print", Fprint, Sprint, 1, 2, 0, | |
875 "Output the printed representation of OBJECT, with newlines around it.\n\ | |
876 Quoting characters are printed when needed to make output that `read'\n\ | |
877 can handle, whenever this is possible.\n\ | |
7185 | 878 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
|
879 (object, printcharfun) |
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
880 Lisp_Object object, printcharfun; |
329 | 881 { |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
882 PRINTDECLARE; |
329 | 883 struct gcpro gcpro1; |
884 | |
885 #ifdef MAX_PRINT_CHARS | |
886 print_chars = 0; | |
887 max_print = MAX_PRINT_CHARS; | |
888 #endif /* MAX_PRINT_CHARS */ | |
520 | 889 if (NILP (printcharfun)) |
329 | 890 printcharfun = Vstandard_output; |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
891 GCPRO1 (object); |
329 | 892 PRINTPREPARE; |
893 print_depth = 0; | |
894 PRINTCHAR ('\n'); | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
895 print (object, printcharfun, 1); |
329 | 896 PRINTCHAR ('\n'); |
897 PRINTFINISH; | |
898 #ifdef MAX_PRINT_CHARS | |
899 max_print = 0; | |
900 print_chars = 0; | |
901 #endif /* MAX_PRINT_CHARS */ | |
902 UNGCPRO; | |
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
903 return object; |
329 | 904 } |
905 | |
906 /* The subroutine object for external-debugging-output is kept here | |
907 for the convenience of the debugger. */ | |
908 Lisp_Object Qexternal_debugging_output; | |
909 | |
621 | 910 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0, |
911 "Write CHARACTER to stderr.\n\ | |
329 | 912 You can call print while debugging emacs, and pass it this function\n\ |
913 to make it write to the debugging output.\n") | |
621 | 914 (character) |
915 Lisp_Object character; | |
329 | 916 { |
917 CHECK_NUMBER (character, 0); | |
918 putc (XINT (character), stderr); | |
19882
b6aaf1f70676
(Fexternal_debugging_output): On Windows output to debugger.
Richard M. Stallman <rms@gnu.org>
parents:
19001
diff
changeset
|
919 |
b6aaf1f70676
(Fexternal_debugging_output): On Windows output to debugger.
Richard M. Stallman <rms@gnu.org>
parents:
19001
diff
changeset
|
920 #ifdef WINDOWSNT |
b6aaf1f70676
(Fexternal_debugging_output): On Windows output to debugger.
Richard M. Stallman <rms@gnu.org>
parents:
19001
diff
changeset
|
921 /* Send the output to a debugger (nothing happens if there isn't one). */ |
b6aaf1f70676
(Fexternal_debugging_output): On Windows output to debugger.
Richard M. Stallman <rms@gnu.org>
parents:
19001
diff
changeset
|
922 { |
b6aaf1f70676
(Fexternal_debugging_output): On Windows output to debugger.
Richard M. Stallman <rms@gnu.org>
parents:
19001
diff
changeset
|
923 char buf[2] = {(char) XINT (character), '\0'}; |
b6aaf1f70676
(Fexternal_debugging_output): On Windows output to debugger.
Richard M. Stallman <rms@gnu.org>
parents:
19001
diff
changeset
|
924 OutputDebugString (buf); |
b6aaf1f70676
(Fexternal_debugging_output): On Windows output to debugger.
Richard M. Stallman <rms@gnu.org>
parents:
19001
diff
changeset
|
925 } |
b6aaf1f70676
(Fexternal_debugging_output): On Windows output to debugger.
Richard M. Stallman <rms@gnu.org>
parents:
19001
diff
changeset
|
926 #endif |
b6aaf1f70676
(Fexternal_debugging_output): On Windows output to debugger.
Richard M. Stallman <rms@gnu.org>
parents:
19001
diff
changeset
|
927 |
329 | 928 return character; |
929 } | |
6533
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
930 |
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
931 /* This is the interface for debugging printing. */ |
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
932 |
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
933 void |
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
934 debug_print (arg) |
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
935 Lisp_Object arg; |
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
936 { |
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
937 Fprin1 (arg, Qexternal_debugging_output); |
13456
b66f0626addb
(debug_print): Explicitly print a CR.
Richard M. Stallman <rms@gnu.org>
parents:
13405
diff
changeset
|
938 fprintf (stderr, "\r\n"); |
6533
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
939 } |
329 | 940 |
13776
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
941 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
|
942 1, 1, 0, |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
943 "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
|
944 (obj) |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
945 Lisp_Object obj; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
946 { |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
947 struct buffer *old = current_buffer; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
948 Lisp_Object original, printcharfun, value; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
949 struct gcpro gcpro1; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
950 |
18342
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
951 /* If OBJ is (error STRING), just return STRING. |
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
952 That is not only faster, it also avoids the need to allocate |
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
953 space here when the error is due to memory full. */ |
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
954 if (CONSP (obj) && EQ (XCONS (obj)->car, Qerror) |
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
955 && CONSP (XCONS (obj)->cdr) |
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
956 && STRINGP (XCONS (XCONS (obj)->cdr)->car) |
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
957 && NILP (XCONS (XCONS (obj)->cdr)->cdr)) |
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
958 return XCONS (XCONS (obj)->cdr)->car; |
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
959 |
20303
13efdf0fe96e
(printchar): Declare `work' as unsigned char.
Andreas Schwab <schwab@suse.de>
parents:
20200
diff
changeset
|
960 print_error_message (obj, Vprin1_to_string_buffer); |
13776
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
961 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
962 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer)); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
963 value = Fbuffer_string (); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
964 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
965 GCPRO1 (value); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
966 Ferase_buffer (); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
967 set_buffer_internal (old); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
968 UNGCPRO; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
969 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
970 return value; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
971 } |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
972 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
973 /* Print an error message for the error DATA |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
974 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
|
975 |
20303
13efdf0fe96e
(printchar): Declare `work' as unsigned char.
Andreas Schwab <schwab@suse.de>
parents:
20200
diff
changeset
|
976 void |
13776
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
977 print_error_message (data, stream) |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
978 Lisp_Object data, stream; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
979 { |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
980 Lisp_Object errname, errmsg, file_error, tail; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
981 struct gcpro gcpro1; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
982 int i; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
983 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
984 errname = Fcar (data); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
985 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
986 if (EQ (errname, Qerror)) |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
987 { |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
988 data = Fcdr (data); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
989 if (!CONSP (data)) data = Qnil; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
990 errmsg = Fcar (data); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
991 file_error = Qnil; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
992 } |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
993 else |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
994 { |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
995 errmsg = Fget (errname, Qerror_message); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
996 file_error = Fmemq (Qfile_error, |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
997 Fget (errname, Qerror_conditions)); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
998 } |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
999 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1000 /* Print an error message including the data items. */ |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1001 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1002 tail = Fcdr_safe (data); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1003 GCPRO1 (tail); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1004 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1005 /* For file-error, make error message by concatenating |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1006 all the data items. They are all strings. */ |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1007 if (!NILP (file_error) && !NILP (tail)) |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1008 errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1009 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1010 if (STRINGP (errmsg)) |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1011 Fprinc (errmsg, stream); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1012 else |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1013 write_string_1 ("peculiar error", -1, stream); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1014 |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1015 for (i = 0; CONSP (tail); tail = Fcdr (tail), i++) |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1016 { |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1017 write_string_1 (i ? ", " : ": ", 2, stream); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1018 if (!NILP (file_error)) |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1019 Fprinc (Fcar (tail), stream); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1020 else |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1021 Fprin1 (Fcar (tail), stream); |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1022 } |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1023 UNGCPRO; |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1024 } |
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1025 |
329 | 1026 #ifdef LISP_FLOAT_TYPE |
1027 | |
1028 /* | |
1759
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
1029 * The buffer should be at least as large as the max string size of the |
14036 | 1030 * largest float, printed in the biggest notation. This is undoubtedly |
329 | 1031 * 20d float_output_format, with the negative of the C-constant "HUGE" |
1032 * from <math.h>. | |
1033 * | |
1034 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes. | |
1035 * | |
1036 * I assume that IEEE-754 format numbers can take 329 bytes for the worst | |
1037 * case of -1e307 in 20d float_output_format. What is one to do (short of | |
1038 * re-writing _doprnt to be more sane)? | |
1039 * -wsr | |
1040 */ | |
1759
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
1041 |
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
1042 void |
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
1043 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
|
1044 unsigned char *buf; |
329 | 1045 double data; |
1046 { | |
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1047 unsigned char *cp; |
4224
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
1048 int width; |
329 | 1049 |
20816
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1050 /* Check for plus infinity in a way that won't lose |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1051 if there is no plus infinity. */ |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1052 if (data == data / 2 && data > 1.0) |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1053 { |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1054 strcpy (buf, "1.0e+INF"); |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1055 return; |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1056 } |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1057 /* Likewise for minus infinity. */ |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1058 if (data == data / 2 && data < -1.0) |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1059 { |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1060 strcpy (buf, "-1.0e+INF"); |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1061 return; |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1062 } |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1063 /* Check for NaN in a way that won't fail if there are no NaNs. */ |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1064 if (! (data * 0.0 >= 0.0)) |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1065 { |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1066 strcpy (buf, "0.0e+NaN"); |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1067 return; |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1068 } |
6397d7a97277
(float_to_string): Handle infinities and NaN specially.
Richard M. Stallman <rms@gnu.org>
parents:
20706
diff
changeset
|
1069 |
520 | 1070 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
|
1071 || !STRINGP (Vfloat_output_format)) |
329 | 1072 lose: |
4224
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
1073 { |
20121 | 1074 /* Generate the fewest number of digits that represent the |
1075 floating point value without losing information. | |
1076 The following method is simple but a bit slow. | |
1077 For ideas about speeding things up, please see: | |
1078 | |
1079 Guy L Steele Jr & Jon L White, How to print floating-point numbers | |
1080 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126. | |
1081 | |
1082 Robert G Burger & R Kent Dybvig, Printing floating point numbers | |
1083 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */ | |
1084 | |
1085 width = fabs (data) < DBL_MIN ? 1 : DBL_DIG; | |
1086 do | |
1087 sprintf (buf, "%.*g", width, data); | |
1088 while (width++ < DOUBLE_DIGITS_BOUND && atof (buf) != data); | |
4224
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
1089 } |
329 | 1090 else /* oink oink */ |
1091 { | |
1092 /* Check that the spec we have is fully valid. | |
1093 This means not only valid for printf, | |
1094 but meant for floats, and reasonable. */ | |
1095 cp = XSTRING (Vfloat_output_format)->data; | |
1096 | |
1097 if (cp[0] != '%') | |
1098 goto lose; | |
1099 if (cp[1] != '.') | |
1100 goto lose; | |
1101 | |
1102 cp += 2; | |
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1103 |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1104 /* 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
|
1105 width = -1; |
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1106 if ('0' <= *cp && *cp <= '9') |
11798
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
1107 { |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
1108 width = 0; |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
1109 do |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
1110 width = (width * 10) + (*cp++ - '0'); |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
1111 while (*cp >= '0' && *cp <= '9'); |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
1112 |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
1113 /* 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
|
1114 if (width > DBL_DIG |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
1115 || (width == 0 && *cp != 'f')) |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
1116 goto lose; |
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
1117 } |
329 | 1118 |
1119 if (*cp != 'e' && *cp != 'f' && *cp != 'g') | |
1120 goto lose; | |
1121 | |
1122 if (cp[1] != 0) | |
1123 goto lose; | |
1124 | |
1125 sprintf (buf, XSTRING (Vfloat_output_format)->data, data); | |
1126 } | |
1759
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
1127 |
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1128 /* 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
|
1129 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
|
1130 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
|
1131 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
|
1132 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
|
1133 { |
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1134 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
|
1135 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
|
1136 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
|
1137 |
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1138 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
|
1139 { |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1140 cp[1] = '0'; |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1141 cp[2] = 0; |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1142 } |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1143 |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1144 if (*cp == 0) |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1145 { |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1146 *cp++ = '.'; |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1147 *cp++ = '0'; |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1148 *cp++ = 0; |
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1149 } |
1759
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
1150 } |
329 | 1151 } |
1152 #endif /* LISP_FLOAT_TYPE */ | |
1153 | |
1154 static void | |
1155 print (obj, printcharfun, escapeflag) | |
1156 Lisp_Object obj; | |
1157 register Lisp_Object printcharfun; | |
1158 int escapeflag; | |
1159 { | |
1160 char buf[30]; | |
1161 | |
1162 QUIT; | |
1163 | |
379
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1164 #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
|
1165 /* Detect circularities and truncate them. |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1166 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
|
1167 if (CONSP (obj) || VECTORP (obj) || COMPILEDP (obj)) |
379
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1168 { |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1169 int i; |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1170 for (i = 0; i < print_depth; i++) |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1171 if (EQ (obj, being_printed[i])) |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1172 { |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1173 sprintf (buf, "#%d", i); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1174 strout (buf, -1, -1, printcharfun, 0); |
379
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1175 return; |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1176 } |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1177 } |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1178 #endif |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1179 |
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1180 being_printed[print_depth] = obj; |
329 | 1181 print_depth++; |
1182 | |
379
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
1183 if (print_depth > PRINT_CIRCLE) |
329 | 1184 error ("Apparently circular structure being printed"); |
1185 #ifdef MAX_PRINT_CHARS | |
1186 if (max_print && print_chars > max_print) | |
1187 { | |
1188 PRINTCHAR ('\n'); | |
1189 print_chars = 0; | |
1190 } | |
1191 #endif /* MAX_PRINT_CHARS */ | |
1192 | |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1193 switch (XGCTYPE (obj)) |
329 | 1194 { |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1195 case Lisp_Int: |
11697
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1196 if (sizeof (int) == sizeof (EMACS_INT)) |
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1197 sprintf (buf, "%d", XINT (obj)); |
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1198 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
|
1199 sprintf (buf, "%ld", XINT (obj)); |
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1200 else |
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1201 abort (); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1202 strout (buf, -1, -1, printcharfun, 0); |
10293
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 |
10001 | 1205 #ifdef LISP_FLOAT_TYPE |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1206 case Lisp_Float: |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1207 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1208 char pigbuf[350]; /* see comments in float_to_string */ |
329 | 1209 |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1210 float_to_string (pigbuf, XFLOAT(obj)->data); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1211 strout (pigbuf, -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1212 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1213 break; |
10001 | 1214 #endif |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1215 |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1216 case Lisp_String: |
329 | 1217 if (!escapeflag) |
1218 print_string (obj, printcharfun); | |
1219 else | |
1220 { | |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1221 register int i, i_byte; |
329 | 1222 register unsigned char c; |
1223 struct gcpro gcpro1; | |
22183
3eedfddbbadd
(print_string): Don't ignore garbage bytes following a
Kenichi Handa <handa@m17n.org>
parents:
21514
diff
changeset
|
1224 unsigned char *str; |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1225 int size_byte; |
21373
e53943cd93b2
(print) <Lisp_String>: Follow a hex escape with `\ ' if nec.
Richard M. Stallman <rms@gnu.org>
parents:
21250
diff
changeset
|
1226 /* 1 means we must ensure that the next character we output |
e53943cd93b2
(print) <Lisp_String>: Follow a hex escape with `\ ' if nec.
Richard M. Stallman <rms@gnu.org>
parents:
21250
diff
changeset
|
1227 cannot be taken as part of a hex character escape. */ |
e53943cd93b2
(print) <Lisp_String>: Follow a hex escape with `\ ' if nec.
Richard M. Stallman <rms@gnu.org>
parents:
21250
diff
changeset
|
1228 int need_nonhex = 0; |
329 | 1229 |
1967 | 1230 GCPRO1 (obj); |
1231 | |
1232 #ifdef USE_TEXT_PROPERTIES | |
1233 if (!NULL_INTERVAL_P (XSTRING (obj)->intervals)) | |
1234 { | |
1235 PRINTCHAR ('#'); | |
1236 PRINTCHAR ('('); | |
1237 } | |
1238 #endif | |
329 | 1239 |
1240 PRINTCHAR ('\"'); | |
22183
3eedfddbbadd
(print_string): Don't ignore garbage bytes following a
Kenichi Handa <handa@m17n.org>
parents:
21514
diff
changeset
|
1241 str = XSTRING (obj)->data; |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21142
diff
changeset
|
1242 size_byte = STRING_BYTES (XSTRING (obj)); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1243 |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1244 for (i = 0, i_byte = 0; i_byte < size_byte;) |
329 | 1245 { |
20549
ba676f083e7c
(PRINTDECLARE): Declare old_point_byte and start_point_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20377
diff
changeset
|
1246 /* Here, we must convert each multi-byte form to the |
ba676f083e7c
(PRINTDECLARE): Declare old_point_byte and start_point_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20377
diff
changeset
|
1247 corresponding character code before handing it to PRINTCHAR. */ |
ba676f083e7c
(PRINTDECLARE): Declare old_point_byte and start_point_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20377
diff
changeset
|
1248 int len; |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1249 int c; |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1250 |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1251 if (STRING_MULTIBYTE (obj)) |
22183
3eedfddbbadd
(print_string): Don't ignore garbage bytes following a
Kenichi Handa <handa@m17n.org>
parents:
21514
diff
changeset
|
1252 { |
3eedfddbbadd
(print_string): Don't ignore garbage bytes following a
Kenichi Handa <handa@m17n.org>
parents:
21514
diff
changeset
|
1253 c = STRING_CHAR_AND_CHAR_LENGTH (str + i_byte, |
3eedfddbbadd
(print_string): Don't ignore garbage bytes following a
Kenichi Handa <handa@m17n.org>
parents:
21514
diff
changeset
|
1254 size_byte - i_byte, len); |
3eedfddbbadd
(print_string): Don't ignore garbage bytes following a
Kenichi Handa <handa@m17n.org>
parents:
21514
diff
changeset
|
1255 i_byte += len; |
3eedfddbbadd
(print_string): Don't ignore garbage bytes following a
Kenichi Handa <handa@m17n.org>
parents:
21514
diff
changeset
|
1256 } |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1257 else |
22183
3eedfddbbadd
(print_string): Don't ignore garbage bytes following a
Kenichi Handa <handa@m17n.org>
parents:
21514
diff
changeset
|
1258 c = str[i_byte++]; |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1259 |
329 | 1260 QUIT; |
20549
ba676f083e7c
(PRINTDECLARE): Declare old_point_byte and start_point_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20377
diff
changeset
|
1261 |
329 | 1262 if (c == '\n' && print_escape_newlines) |
1263 { | |
1264 PRINTCHAR ('\\'); | |
1265 PRINTCHAR ('n'); | |
1266 } | |
5852
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
1267 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
|
1268 { |
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
1269 PRINTCHAR ('\\'); |
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
1270 PRINTCHAR ('f'); |
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
1271 } |
20670
b818d996d923
(print) <Lisp_String>: When multibyte is enabled, print
Karl Heuer <kwzh@gnu.org>
parents:
20591
diff
changeset
|
1272 else if ((! SINGLE_BYTE_CHAR_P (c) |
b818d996d923
(print) <Lisp_String>: When multibyte is enabled, print
Karl Heuer <kwzh@gnu.org>
parents:
20591
diff
changeset
|
1273 && NILP (current_buffer->enable_multibyte_characters))) |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1274 { |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1275 /* When multibyte is disabled, |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1276 print multibyte string chars using hex escapes. */ |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1277 unsigned char outbuf[50]; |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1278 sprintf (outbuf, "\\x%x", c); |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1279 strout (outbuf, -1, -1, printcharfun, 0); |
21373
e53943cd93b2
(print) <Lisp_String>: Follow a hex escape with `\ ' if nec.
Richard M. Stallman <rms@gnu.org>
parents:
21250
diff
changeset
|
1280 need_nonhex = 1; |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1281 } |
20670
b818d996d923
(print) <Lisp_String>: When multibyte is enabled, print
Karl Heuer <kwzh@gnu.org>
parents:
20591
diff
changeset
|
1282 else if (SINGLE_BYTE_CHAR_P (c) |
b818d996d923
(print) <Lisp_String>: When multibyte is enabled, print
Karl Heuer <kwzh@gnu.org>
parents:
20591
diff
changeset
|
1283 && ! ASCII_BYTE_P (c) |
22240
4e4c377f3310
(print_escape_nonascii): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22231
diff
changeset
|
1284 && (! NILP (current_buffer->enable_multibyte_characters) |
4e4c377f3310
(print_escape_nonascii): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22231
diff
changeset
|
1285 || print_escape_nonascii)) |
20670
b818d996d923
(print) <Lisp_String>: When multibyte is enabled, print
Karl Heuer <kwzh@gnu.org>
parents:
20591
diff
changeset
|
1286 { |
22240
4e4c377f3310
(print_escape_nonascii): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22231
diff
changeset
|
1287 /* When multibyte is enabled or when explicitly requested, |
20670
b818d996d923
(print) <Lisp_String>: When multibyte is enabled, print
Karl Heuer <kwzh@gnu.org>
parents:
20591
diff
changeset
|
1288 print single-byte non-ASCII string chars |
b818d996d923
(print) <Lisp_String>: When multibyte is enabled, print
Karl Heuer <kwzh@gnu.org>
parents:
20591
diff
changeset
|
1289 using octal escapes. */ |
b818d996d923
(print) <Lisp_String>: When multibyte is enabled, print
Karl Heuer <kwzh@gnu.org>
parents:
20591
diff
changeset
|
1290 unsigned char outbuf[5]; |
b818d996d923
(print) <Lisp_String>: When multibyte is enabled, print
Karl Heuer <kwzh@gnu.org>
parents:
20591
diff
changeset
|
1291 sprintf (outbuf, "\\%03o", c); |
b818d996d923
(print) <Lisp_String>: When multibyte is enabled, print
Karl Heuer <kwzh@gnu.org>
parents:
20591
diff
changeset
|
1292 strout (outbuf, -1, -1, printcharfun, 0); |
b818d996d923
(print) <Lisp_String>: When multibyte is enabled, print
Karl Heuer <kwzh@gnu.org>
parents:
20591
diff
changeset
|
1293 } |
329 | 1294 else |
1295 { | |
21373
e53943cd93b2
(print) <Lisp_String>: Follow a hex escape with `\ ' if nec.
Richard M. Stallman <rms@gnu.org>
parents:
21250
diff
changeset
|
1296 /* If we just had a hex escape, and this character |
e53943cd93b2
(print) <Lisp_String>: Follow a hex escape with `\ ' if nec.
Richard M. Stallman <rms@gnu.org>
parents:
21250
diff
changeset
|
1297 could be taken as part of it, |
e53943cd93b2
(print) <Lisp_String>: Follow a hex escape with `\ ' if nec.
Richard M. Stallman <rms@gnu.org>
parents:
21250
diff
changeset
|
1298 output `\ ' to prevent that. */ |
21480
20aab049dc4a
(print) <Lisp_String>: Fix "\ " handling.
Karl Heuer <kwzh@gnu.org>
parents:
21455
diff
changeset
|
1299 if (need_nonhex) |
20aab049dc4a
(print) <Lisp_String>: Fix "\ " handling.
Karl Heuer <kwzh@gnu.org>
parents:
21455
diff
changeset
|
1300 { |
20aab049dc4a
(print) <Lisp_String>: Fix "\ " handling.
Karl Heuer <kwzh@gnu.org>
parents:
21455
diff
changeset
|
1301 need_nonhex = 0; |
20aab049dc4a
(print) <Lisp_String>: Fix "\ " handling.
Karl Heuer <kwzh@gnu.org>
parents:
21455
diff
changeset
|
1302 if ((c >= 'a' && c <= 'f') |
21373
e53943cd93b2
(print) <Lisp_String>: Follow a hex escape with `\ ' if nec.
Richard M. Stallman <rms@gnu.org>
parents:
21250
diff
changeset
|
1303 || (c >= 'A' && c <= 'F') |
21480
20aab049dc4a
(print) <Lisp_String>: Fix "\ " handling.
Karl Heuer <kwzh@gnu.org>
parents:
21455
diff
changeset
|
1304 || (c >= '0' && c <= '9')) |
20aab049dc4a
(print) <Lisp_String>: Fix "\ " handling.
Karl Heuer <kwzh@gnu.org>
parents:
21455
diff
changeset
|
1305 strout ("\\ ", -1, -1, printcharfun, 0); |
20aab049dc4a
(print) <Lisp_String>: Fix "\ " handling.
Karl Heuer <kwzh@gnu.org>
parents:
21455
diff
changeset
|
1306 } |
21373
e53943cd93b2
(print) <Lisp_String>: Follow a hex escape with `\ ' if nec.
Richard M. Stallman <rms@gnu.org>
parents:
21250
diff
changeset
|
1307 |
329 | 1308 if (c == '\"' || c == '\\') |
1309 PRINTCHAR ('\\'); | |
1310 PRINTCHAR (c); | |
1311 } | |
1312 } | |
1313 PRINTCHAR ('\"'); | |
1967 | 1314 |
1315 #ifdef USE_TEXT_PROPERTIES | |
1316 if (!NULL_INTERVAL_P (XSTRING (obj)->intervals)) | |
1317 { | |
1318 traverse_intervals (XSTRING (obj)->intervals, | |
1319 0, 0, print_interval, printcharfun); | |
1320 PRINTCHAR (')'); | |
1321 } | |
1322 #endif | |
1323 | |
329 | 1324 UNGCPRO; |
1325 } | |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1326 break; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1327 |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1328 case Lisp_Symbol: |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1329 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1330 register int confusing; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1331 register unsigned char *p = XSYMBOL (obj)->name->data; |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21142
diff
changeset
|
1332 register unsigned char *end = p + STRING_BYTES (XSYMBOL (obj)->name); |
20862
f4efe8aa6133
(print): Declare local variable C as `int' instead of
Richard M. Stallman <rms@gnu.org>
parents:
20816
diff
changeset
|
1333 register int c; |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1334 int i, i_byte, size_byte; |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1335 Lisp_Object name; |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1336 |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1337 XSETSTRING (name, XSYMBOL (obj)->name); |
329 | 1338 |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1339 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
|
1340 if (p == end) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1341 confusing = 0; |
17509
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1342 /* If symbol name begins with a digit, and ends with a digit, |
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1343 and contains nothing but digits and `e', it could be treated |
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1344 as a number. So set CONFUSING. |
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1345 |
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1346 Symbols that contain periods could also be taken as numbers, |
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1347 but periods are always escaped, so we don't have to worry |
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1348 about them here. */ |
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1349 else if (*p >= '0' && *p <= '9' |
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1350 && end[-1] >= '0' && end[-1] <= '9') |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1351 { |
17223
ed068c0c1648
(print): Generate a backslash in \2e10.
Richard M. Stallman <rms@gnu.org>
parents:
17040
diff
changeset
|
1352 while (p != end && ((*p >= '0' && *p <= '9') |
ed068c0c1648
(print): Generate a backslash in \2e10.
Richard M. Stallman <rms@gnu.org>
parents:
17040
diff
changeset
|
1353 /* Needed for \2e10. */ |
ed068c0c1648
(print): Generate a backslash in \2e10.
Richard M. Stallman <rms@gnu.org>
parents:
17040
diff
changeset
|
1354 || *p == 'e')) |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1355 p++; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1356 confusing = (end == p); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1357 } |
17509
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1358 else |
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1359 confusing = 0; |
329 | 1360 |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1361 /* If we print an uninterned symbol as part of a complex object and |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1362 the flag print-gensym is non-nil, prefix it with #n= to read the |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1363 object back with the #n# reader syntax later if needed. */ |
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1364 if (! NILP (Vprint_gensym) && NILP (XSYMBOL (obj)->obarray)) |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1365 { |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1366 if (print_depth > 1) |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1367 { |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1368 Lisp_Object tem; |
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1369 tem = Fassq (obj, Vprint_gensym_alist); |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1370 if (CONSP (tem)) |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1371 { |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1372 PRINTCHAR ('#'); |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1373 print (XCDR (tem), printcharfun, escapeflag); |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1374 PRINTCHAR ('#'); |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1375 break; |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1376 } |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1377 else |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1378 { |
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1379 if (CONSP (Vprint_gensym_alist)) |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1380 XSETFASTINT (tem, XFASTINT (XCDR (XCAR (Vprint_gensym_alist))) + 1); |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1381 else |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1382 XSETFASTINT (tem, 1); |
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1383 Vprint_gensym_alist = Fcons (Fcons (obj, tem), Vprint_gensym_alist); |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1384 |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1385 PRINTCHAR ('#'); |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1386 print (tem, printcharfun, escapeflag); |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1387 PRINTCHAR ('='); |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1388 } |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1389 } |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1390 PRINTCHAR ('#'); |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1391 PRINTCHAR (':'); |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1392 } |
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1393 |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21142
diff
changeset
|
1394 size_byte = STRING_BYTES (XSTRING (name)); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1395 |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1396 for (i = 0, i_byte = 0; i_byte < size_byte;) |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1397 { |
20549
ba676f083e7c
(PRINTDECLARE): Declare old_point_byte and start_point_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20377
diff
changeset
|
1398 /* Here, we must convert each multi-byte form to the |
ba676f083e7c
(PRINTDECLARE): Declare old_point_byte and start_point_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20377
diff
changeset
|
1399 corresponding character code before handing it to PRINTCHAR. */ |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1400 |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1401 if (STRING_MULTIBYTE (name)) |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1402 FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte); |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1403 else |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1404 c = XSTRING (name)->data[i_byte++]; |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1405 |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1406 QUIT; |
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1407 |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1408 if (escapeflag) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1409 { |
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1410 if (c == '\"' || c == '\\' || c == '\'' |
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1411 || c == ';' || c == '#' || c == '(' || c == ')' |
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1412 || c == ',' || c =='.' || c == '`' |
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1413 || c == '[' || c == ']' || c == '?' || c <= 040 |
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1414 || confusing) |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1415 PRINTCHAR ('\\'), confusing = 0; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1416 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1417 PRINTCHAR (c); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1418 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1419 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1420 break; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1421 |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1422 case Lisp_Cons: |
329 | 1423 /* 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
|
1424 if (INTEGERP (Vprint_level) |
329 | 1425 && print_depth > XINT (Vprint_level)) |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1426 strout ("...", -1, -1, printcharfun, 0); |
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1427 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
|
1428 && (EQ (XCAR (obj), Qquote))) |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1429 { |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1430 PRINTCHAR ('\''); |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1431 print (XCAR (XCDR (obj)), printcharfun, escapeflag); |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1432 } |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1433 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
|
1434 && (EQ (XCAR (obj), Qfunction))) |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1435 { |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1436 PRINTCHAR ('#'); |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1437 PRINTCHAR ('\''); |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1438 print (XCAR (XCDR (obj)), printcharfun, escapeflag); |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1439 } |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1440 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
|
1441 && ((EQ (XCAR (obj), Qbackquote) |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1442 || EQ (XCAR (obj), Qcomma) |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1443 || EQ (XCAR (obj), Qcomma_at) |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1444 || EQ (XCAR (obj), Qcomma_dot)))) |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1445 { |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1446 print (XCAR (obj), printcharfun, 0); |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1447 print (XCAR (XCDR (obj)), printcharfun, escapeflag); |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1448 } |
10001 | 1449 else |
329 | 1450 { |
10001 | 1451 PRINTCHAR ('('); |
329 | 1452 { |
10001 | 1453 register int i = 0; |
21455
4a457fda49b5
* print.c (print): Avoid `min'/`max' as variable names.
Karl Heuer <kwzh@gnu.org>
parents:
21373
diff
changeset
|
1454 register int print_length = 0; |
22231
35af9a276272
(print) <Lisp_Cons>: Detect circular list.
Richard M. Stallman <rms@gnu.org>
parents:
22183
diff
changeset
|
1455 Lisp_Object halftail = obj; |
10001 | 1456 |
1457 if (INTEGERP (Vprint_length)) | |
21455
4a457fda49b5
* print.c (print): Avoid `min'/`max' as variable names.
Karl Heuer <kwzh@gnu.org>
parents:
21373
diff
changeset
|
1458 print_length = XINT (Vprint_length); |
10001 | 1459 while (CONSP (obj)) |
329 | 1460 { |
22231
35af9a276272
(print) <Lisp_Cons>: Detect circular list.
Richard M. Stallman <rms@gnu.org>
parents:
22183
diff
changeset
|
1461 /* Detect circular list. */ |
35af9a276272
(print) <Lisp_Cons>: Detect circular list.
Richard M. Stallman <rms@gnu.org>
parents:
22183
diff
changeset
|
1462 if (i != 0 && EQ (obj, halftail)) |
35af9a276272
(print) <Lisp_Cons>: Detect circular list.
Richard M. Stallman <rms@gnu.org>
parents:
22183
diff
changeset
|
1463 { |
35af9a276272
(print) <Lisp_Cons>: Detect circular list.
Richard M. Stallman <rms@gnu.org>
parents:
22183
diff
changeset
|
1464 sprintf (buf, " . #%d", i / 2); |
35af9a276272
(print) <Lisp_Cons>: Detect circular list.
Richard M. Stallman <rms@gnu.org>
parents:
22183
diff
changeset
|
1465 strout (buf, -1, -1, printcharfun, 0); |
35af9a276272
(print) <Lisp_Cons>: Detect circular list.
Richard M. Stallman <rms@gnu.org>
parents:
22183
diff
changeset
|
1466 obj = Qnil; |
35af9a276272
(print) <Lisp_Cons>: Detect circular list.
Richard M. Stallman <rms@gnu.org>
parents:
22183
diff
changeset
|
1467 break; |
35af9a276272
(print) <Lisp_Cons>: Detect circular list.
Richard M. Stallman <rms@gnu.org>
parents:
22183
diff
changeset
|
1468 } |
10001 | 1469 if (i++) |
1470 PRINTCHAR (' '); | |
21455
4a457fda49b5
* print.c (print): Avoid `min'/`max' as variable names.
Karl Heuer <kwzh@gnu.org>
parents:
21373
diff
changeset
|
1471 if (print_length && i > print_length) |
10001 | 1472 { |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1473 strout ("...", 3, 3, printcharfun, 0); |
10001 | 1474 break; |
1475 } | |
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1476 print (XCAR (obj), printcharfun, escapeflag); |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1477 obj = XCDR (obj); |
22231
35af9a276272
(print) <Lisp_Cons>: Detect circular list.
Richard M. Stallman <rms@gnu.org>
parents:
22183
diff
changeset
|
1478 if (!(i & 1)) |
35af9a276272
(print) <Lisp_Cons>: Detect circular list.
Richard M. Stallman <rms@gnu.org>
parents:
22183
diff
changeset
|
1479 halftail = XCDR (halftail); |
329 | 1480 } |
1481 } | |
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1482 if (!NILP (obj)) |
10001 | 1483 { |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1484 strout (" . ", 3, 3, printcharfun, 0); |
10001 | 1485 print (obj, printcharfun, escapeflag); |
1486 } | |
1487 PRINTCHAR (')'); | |
329 | 1488 } |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1489 break; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1490 |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1491 case Lisp_Vectorlike: |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1492 if (PROCESSP (obj)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1493 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1494 if (escapeflag) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1495 { |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1496 strout ("#<process ", -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1497 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
|
1498 PRINTCHAR ('>'); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1499 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1500 else |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1501 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
|
1502 } |
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1503 else if (BOOL_VECTOR_P (obj)) |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1504 { |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1505 register int i; |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1506 register unsigned char c; |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1507 struct gcpro gcpro1; |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1508 int size_in_chars |
16893
5889a6e7c71b
(print): Round size of bool-vector properly.
Richard M. Stallman <rms@gnu.org>
parents:
16520
diff
changeset
|
1509 = (XBOOL_VECTOR (obj)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; |
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1510 |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1511 GCPRO1 (obj); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1512 |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1513 PRINTCHAR ('#'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1514 PRINTCHAR ('&'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1515 sprintf (buf, "%d", XBOOL_VECTOR (obj)->size); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1516 strout (buf, -1, -1, printcharfun, 0); |
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1517 PRINTCHAR ('\"'); |
15563
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1518 |
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1519 /* 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
|
1520 if (INTEGERP (Vprint_length) |
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1521 && XINT (Vprint_length) < size_in_chars) |
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1522 size_in_chars = XINT (Vprint_length); |
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1523 |
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1524 for (i = 0; i < size_in_chars; i++) |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1525 { |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1526 QUIT; |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1527 c = XBOOL_VECTOR (obj)->data[i]; |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1528 if (c == '\n' && print_escape_newlines) |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1529 { |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1530 PRINTCHAR ('\\'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1531 PRINTCHAR ('n'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1532 } |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1533 else if (c == '\f' && print_escape_newlines) |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1534 { |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1535 PRINTCHAR ('\\'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1536 PRINTCHAR ('f'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1537 } |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1538 else |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1539 { |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1540 if (c == '\"' || c == '\\') |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1541 PRINTCHAR ('\\'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1542 PRINTCHAR (c); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1543 } |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1544 } |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1545 PRINTCHAR ('\"'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1546 |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1547 UNGCPRO; |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1548 } |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1549 else if (SUBRP (obj)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1550 { |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1551 strout ("#<subr ", -1, -1, printcharfun, 0); |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1552 strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1553 PRINTCHAR ('>'); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1554 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1555 #ifndef standalone |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1556 else if (WINDOWP (obj)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1557 { |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1558 strout ("#<window ", -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1559 sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number)); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1560 strout (buf, -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1561 if (!NILP (XWINDOW (obj)->buffer)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1562 { |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1563 strout (" on ", -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1564 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
|
1565 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1566 PRINTCHAR ('>'); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1567 } |
10301
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1568 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
|
1569 { |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1570 if (NILP (XBUFFER (obj)->name)) |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1571 strout ("#<killed buffer>", -1, -1, printcharfun, 0); |
10301
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1572 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
|
1573 { |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1574 strout ("#<buffer ", -1, -1, printcharfun, 0); |
10301
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1575 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
|
1576 PRINTCHAR ('>'); |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1577 } |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1578 else |
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1579 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
|
1580 } |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1581 else if (WINDOW_CONFIGURATIONP (obj)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1582 { |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1583 strout ("#<window-configuration>", -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1584 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1585 else if (FRAMEP (obj)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1586 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1587 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
|
1588 ? "#<frame " : "#<dead frame "), |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1589 -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1590 print_string (XFRAME (obj)->name, printcharfun); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1591 sprintf (buf, " 0x%lx\\ ", (unsigned long) (XFRAME (obj))); |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1592 strout (buf, -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1593 PRINTCHAR ('>'); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1594 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1595 #endif /* not standalone */ |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1596 else |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1597 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1598 int size = XVECTOR (obj)->size; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1599 if (COMPILEDP (obj)) |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1600 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1601 PRINTCHAR ('#'); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1602 size &= PSEUDOVECTOR_SIZE_MASK; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1603 } |
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1604 if (CHAR_TABLE_P (obj)) |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1605 { |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1606 /* 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
|
1607 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
|
1608 character slots. But we add #^ as a prefix. */ |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1609 PRINTCHAR ('#'); |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1610 PRINTCHAR ('^'); |
17325
c19c552c486f
(read1): Adjusted for the new structure of Lisp_Char_Table.
Kenichi Handa <handa@m17n.org>
parents:
17223
diff
changeset
|
1611 if (SUB_CHAR_TABLE_P (obj)) |
c19c552c486f
(read1): Adjusted for the new structure of Lisp_Char_Table.
Kenichi Handa <handa@m17n.org>
parents:
17223
diff
changeset
|
1612 PRINTCHAR ('^'); |
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1613 size &= PSEUDOVECTOR_SIZE_MASK; |
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1614 } |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1615 if (size & PSEUDOVECTOR_FLAG) |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1616 goto badtype; |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1617 |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1618 PRINTCHAR ('['); |
329 | 1619 { |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1620 register int i; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1621 register Lisp_Object tem; |
15563
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1622 |
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1623 /* 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
|
1624 if (INTEGERP (Vprint_length) |
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1625 && XINT (Vprint_length) < size) |
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1626 size = XINT (Vprint_length); |
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1627 |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1628 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
|
1629 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1630 if (i) PRINTCHAR (' '); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1631 tem = XVECTOR (obj)->contents[i]; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1632 print (tem, printcharfun, escapeflag); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1633 } |
329 | 1634 } |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1635 PRINTCHAR (']'); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1636 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1637 break; |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1638 |
329 | 1639 #ifndef standalone |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1640 case Lisp_Misc: |
11241
5fed07fb66fb
(print): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11235
diff
changeset
|
1641 switch (XMISCTYPE (obj)) |
329 | 1642 { |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1643 case Lisp_Misc_Marker: |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1644 strout ("#<marker ", -1, -1, printcharfun, 0); |
17040 | 1645 /* Do you think this is necessary? */ |
1646 if (XMARKER (obj)->insertion_type != 0) | |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1647 strout ("(before-insertion) ", -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1648 if (!(XMARKER (obj)->buffer)) |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1649 strout ("in no buffer", -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1650 else |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1651 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1652 sprintf (buf, "at %d", marker_position (obj)); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1653 strout (buf, -1, -1, printcharfun, 0); |
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1654 strout (" in ", -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1655 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
|
1656 } |
329 | 1657 PRINTCHAR ('>'); |
10301
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1658 break; |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1659 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1660 case Lisp_Misc_Overlay: |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1661 strout ("#<overlay ", -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1662 if (!(XMARKER (OVERLAY_START (obj))->buffer)) |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1663 strout ("in no buffer", -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1664 else |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1665 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1666 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
|
1667 marker_position (OVERLAY_START (obj)), |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1668 marker_position (OVERLAY_END (obj))); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1669 strout (buf, -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1670 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
|
1671 printcharfun); |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1672 } |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1673 PRINTCHAR ('>'); |
10301
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1674 break; |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1675 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1676 /* 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
|
1677 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
|
1678 case Lisp_Misc_Free: |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1679 strout ("#<misc free cell>", -1, -1, printcharfun, 0); |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1680 break; |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1681 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1682 case Lisp_Misc_Intfwd: |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1683 sprintf (buf, "#<intfwd to %d>", *XINTFWD (obj)->intvar); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1684 strout (buf, -1, -1, printcharfun, 0); |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1685 break; |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1686 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1687 case Lisp_Misc_Boolfwd: |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1688 sprintf (buf, "#<boolfwd to %s>", |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1689 (*XBOOLFWD (obj)->boolvar ? "t" : "nil")); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1690 strout (buf, -1, -1, printcharfun, 0); |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1691 break; |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1692 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1693 case Lisp_Misc_Objfwd: |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1694 strout ("#<objfwd to ", -1, -1, printcharfun, 0); |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1695 print (*XOBJFWD (obj)->objvar, printcharfun, escapeflag); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1696 PRINTCHAR ('>'); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1697 break; |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1698 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1699 case Lisp_Misc_Buffer_Objfwd: |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1700 strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0); |
10583
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1701 print (*(Lisp_Object *)((char *)current_buffer |
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1702 + XBUFFER_OBJFWD (obj)->offset), |
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1703 printcharfun, escapeflag); |
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1704 PRINTCHAR ('>'); |
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1705 break; |
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1706 |
11010
45ae0022c48a
(print): Rename perdisplay to kboard.
Karl Heuer <kwzh@gnu.org>
parents:
10993
diff
changeset
|
1707 case Lisp_Misc_Kboard_Objfwd: |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1708 strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0); |
11010
45ae0022c48a
(print): Rename perdisplay to kboard.
Karl Heuer <kwzh@gnu.org>
parents:
10993
diff
changeset
|
1709 print (*(Lisp_Object *)((char *) current_kboard |
45ae0022c48a
(print): Rename perdisplay to kboard.
Karl Heuer <kwzh@gnu.org>
parents:
10993
diff
changeset
|
1710 + XKBOARD_OBJFWD (obj)->offset), |
10993
e72bd65cab70
(print): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents:
10651
diff
changeset
|
1711 printcharfun, escapeflag); |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1712 PRINTCHAR ('>'); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1713 break; |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1714 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1715 case Lisp_Misc_Buffer_Local_Value: |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1716 strout ("#<buffer_local_value ", -1, -1, printcharfun, 0); |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1717 goto do_buffer_local; |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1718 case Lisp_Misc_Some_Buffer_Local_Value: |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1719 strout ("#<some_buffer_local_value ", -1, -1, printcharfun, 0); |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1720 do_buffer_local: |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1721 strout ("[realvalue] ", -1, -1, printcharfun, 0); |
21142
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1722 print (XBUFFER_LOCAL_VALUE (obj)->realvalue, printcharfun, escapeflag); |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1723 if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer) |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1724 strout ("[local in buffer] ", -1, -1, printcharfun, 0); |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1725 else |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1726 strout ("[buffer] ", -1, -1, printcharfun, 0); |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1727 print (XBUFFER_LOCAL_VALUE (obj)->buffer, |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1728 printcharfun, escapeflag); |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1729 if (XBUFFER_LOCAL_VALUE (obj)->check_frame) |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1730 { |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1731 if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame) |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1732 strout ("[local in frame] ", -1, -1, printcharfun, 0); |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1733 else |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1734 strout ("[frame] ", -1, -1, printcharfun, 0); |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1735 print (XBUFFER_LOCAL_VALUE (obj)->frame, |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1736 printcharfun, escapeflag); |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1737 } |
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1738 strout ("[alist-elt] ", -1, -1, printcharfun, 0); |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1739 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
|
1740 printcharfun, escapeflag); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1741 strout ("[default-value] ", -1, -1, printcharfun, 0); |
21142
77b24424ae6b
(print): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
20888
diff
changeset
|
1742 print (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr, |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1743 printcharfun, escapeflag); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1744 PRINTCHAR ('>'); |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1745 break; |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1746 |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1747 default: |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1748 goto badtype; |
329 | 1749 } |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1750 break; |
329 | 1751 #endif /* standalone */ |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1752 |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1753 default: |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1754 badtype: |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1755 { |
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1756 /* 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
|
1757 Probably should just abort () */ |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1758 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun, 0); |
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1759 if (MISCP (obj)) |
11241
5fed07fb66fb
(print): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11235
diff
changeset
|
1760 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
|
1761 else if (VECTORLIKEP (obj)) |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1762 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
|
1763 else |
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1764 sprintf (buf, "(0x%02x)", (int) XTYPE (obj)); |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1765 strout (buf, -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1766 strout (" Save your buffers immediately and please report this bug>", |
20591
0b00b6a96288
(print_string): Now static.
Richard M. Stallman <rms@gnu.org>
parents:
20549
diff
changeset
|
1767 -1, -1, printcharfun, 0); |
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1768 } |
329 | 1769 } |
1770 | |
1771 print_depth--; | |
1772 } | |
1773 | |
1967 | 1774 #ifdef USE_TEXT_PROPERTIES |
1775 | |
1776 /* Print a description of INTERVAL using PRINTCHARFUN. | |
1777 This is part of printing a string that has text properties. */ | |
1778 | |
1779 void | |
1780 print_interval (interval, printcharfun) | |
1781 INTERVAL interval; | |
1782 Lisp_Object printcharfun; | |
1783 { | |
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
|
1784 PRINTCHAR (' '); |
1967 | 1785 print (make_number (interval->position), printcharfun, 1); |
1786 PRINTCHAR (' '); | |
1787 print (make_number (interval->position + LENGTH (interval)), | |
1788 printcharfun, 1); | |
1789 PRINTCHAR (' '); | |
1790 print (interval->plist, printcharfun, 1); | |
1791 } | |
1792 | |
1793 #endif /* USE_TEXT_PROPERTIES */ | |
1794 | |
329 | 1795 void |
1796 syms_of_print () | |
1797 { | |
1798 DEFVAR_LISP ("standard-output", &Vstandard_output, | |
1799 "Output stream `print' uses by default for outputting a character.\n\ | |
1800 This may be any function of one argument.\n\ | |
1801 It may also be a buffer (output is inserted before point)\n\ | |
1802 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
|
1803 or the symbol t (output appears in the echo area)."); |
329 | 1804 Vstandard_output = Qt; |
1805 Qstandard_output = intern ("standard-output"); | |
1806 staticpro (&Qstandard_output); | |
1807 | |
1808 #ifdef LISP_FLOAT_TYPE | |
1809 DEFVAR_LISP ("float-output-format", &Vfloat_output_format, | |
687
e2b747dd6a6e
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
1810 "The format descriptor string used to print floats.\n\ |
329 | 1811 This is a %-spec like those accepted by `printf' in C,\n\ |
1812 but with some restrictions. It must start with the two characters `%.'.\n\ | |
1813 After that comes an integer precision specification,\n\ | |
1814 and then a letter which controls the format.\n\ | |
1815 The letters allowed are `e', `f' and `g'.\n\ | |
1816 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\ | |
1817 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\ | |
1818 Use `g' to choose the shorter of those two formats for the number at hand.\n\ | |
1819 The precision in any of these cases is the number of digits following\n\ | |
1820 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
|
1821 decimal point. 0 is not allowed with `e' or `g'.\n\n\ |
20121 | 1822 A value of nil means to use the shortest notation\n\ |
1823 that represents the number without losing information."); | |
329 | 1824 Vfloat_output_format = Qnil; |
1825 Qfloat_output_format = intern ("float-output-format"); | |
1826 staticpro (&Qfloat_output_format); | |
1827 #endif /* LISP_FLOAT_TYPE */ | |
1828 | |
1829 DEFVAR_LISP ("print-length", &Vprint_length, | |
686
bd3068742807
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
621
diff
changeset
|
1830 "Maximum length of list to print before abbreviating.\n\ |
329 | 1831 A value of nil means no limit."); |
1832 Vprint_length = Qnil; | |
1833 | |
1834 DEFVAR_LISP ("print-level", &Vprint_level, | |
686
bd3068742807
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
621
diff
changeset
|
1835 "Maximum depth of list nesting to print before abbreviating.\n\ |
329 | 1836 A value of nil means no limit."); |
1837 Vprint_level = Qnil; | |
1838 | |
1839 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
|
1840 "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
|
1841 Also print formfeeds as backslash-f."); |
329 | 1842 print_escape_newlines = 0; |
1843 | |
22240
4e4c377f3310
(print_escape_nonascii): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22231
diff
changeset
|
1844 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii, |
4e4c377f3310
(print_escape_nonascii): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22231
diff
changeset
|
1845 "Non-nil means print non-ASCII characters in strings as backslash-NNN.\n\ |
4e4c377f3310
(print_escape_nonascii): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22231
diff
changeset
|
1846 NNN is the octal representation of the character's value.\n\ |
22243
ec7420aa37f3
(sms_of_print): Doc fix in prev change.
Richard M. Stallman <rms@gnu.org>
parents:
22240
diff
changeset
|
1847 Only single-byte characters are affected, and only in `prin1'."); |
22240
4e4c377f3310
(print_escape_nonascii): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22231
diff
changeset
|
1848 print_escape_nonascii = 0; |
4e4c377f3310
(print_escape_nonascii): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22231
diff
changeset
|
1849 |
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1850 DEFVAR_BOOL ("print-quoted", &print_quoted, |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1851 "Non-nil means print quoted forms with reader syntax.\n\ |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1852 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
|
1853 forms print in the new syntax."); |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1854 print_quoted = 0; |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1855 |
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1856 DEFVAR_LISP ("print-gensym", &Vprint_gensym, |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1857 "Non-nil means print uninterned symbols so they will read as uninterned.\n\ |
20025
37e3d9d78ad7
(syms_of_print): Fix doc string of print-gensym.
Karl Heuer <kwzh@gnu.org>
parents:
19882
diff
changeset
|
1858 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\ |
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1859 When the uninterned symbol appears within a larger data structure,\n\ |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1860 in addition use the #...# and #...= constructs as needed,\n\ |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1861 so that multiple references to the same symbol are shared once again\n\ |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1862 when the text is read back.\n\ |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1863 \n\ |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1864 If the value of `print-gensym' is a cons cell, then in addition refrain from\n\ |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1865 clearing `print-gensym-alist' on entry to and exit from printing functions,\n\ |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1866 so that the use of #...# and #...= can carry over for several separately\n\ |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1867 printed objects."); |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1868 Vprint_gensym = Qnil; |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1869 |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1870 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist, |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1871 "Association list of elements (GENSYM . N) to guide use of #N# and #N=.\n\ |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1872 In each element, GENSYM is an uninterned symbol that has been associated\n\ |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1873 with #N= for the specified value of N."); |
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1874 Vprint_gensym_alist = Qnil; |
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1875 |
329 | 1876 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */ |
1877 staticpro (&Vprin1_to_string_buffer); | |
1878 | |
1879 defsubr (&Sprin1); | |
1880 defsubr (&Sprin1_to_string); | |
13776
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1881 defsubr (&Serror_message_string); |
329 | 1882 defsubr (&Sprinc); |
1883 defsubr (&Sprint); | |
1884 defsubr (&Sterpri); | |
1885 defsubr (&Swrite_char); | |
1886 defsubr (&Sexternal_debugging_output); | |
1887 | |
1888 Qexternal_debugging_output = intern ("external-debugging-output"); | |
1889 staticpro (&Qexternal_debugging_output); | |
1890 | |
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1891 Qprint_escape_newlines = intern ("print-escape-newlines"); |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1892 staticpro (&Qprint_escape_newlines); |
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1893 |
329 | 1894 #ifndef standalone |
1895 defsubr (&Swith_output_to_temp_buffer); | |
1896 #endif /* not standalone */ | |
1897 } |