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