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