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