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