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