Mercurial > emacs
annotate src/print.c @ 19142:fffebc19fe53
(x-get-selection): Change default for data-type
back to `STRING'.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Mon, 04 Aug 1997 07:46:26 +0000 |
| parents | 2190c39dc640 |
| children | b6aaf1f70676 |
| rev | line source |
|---|---|
| 329 | 1 /* Lisp object printing and output streams. |
| 11235 | 2 Copyright (C) 1985, 86, 88, 93, 94, 95 Free Software Foundation, Inc. |
| 329 | 3 |
| 4 This file is part of GNU Emacs. | |
| 5 | |
| 6 GNU Emacs is free software; you can redistribute it and/or modify | |
| 7 it under the terms of the GNU General Public License as published by | |
| 621 | 8 the Free Software Foundation; either version 2, or (at your option) |
| 329 | 9 any later version. |
| 10 | |
| 11 GNU Emacs is distributed in the hope that it will be useful, | |
| 12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 14 GNU General Public License for more details. | |
| 15 | |
| 16 You should have received a copy of the GNU General Public License | |
| 17 along with GNU Emacs; see the file COPYING. If not, write to | |
|
14186
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
14084
diff
changeset
|
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
|
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
14084
diff
changeset
|
19 Boston, MA 02111-1307, USA. */ |
| 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 | |
| 26 #ifndef standalone | |
| 27 #include "buffer.h" | |
| 17040 | 28 #include "charset.h" |
| 766 | 29 #include "frame.h" |
| 329 | 30 #include "window.h" |
| 31 #include "process.h" | |
| 32 #include "dispextern.h" | |
| 33 #include "termchar.h" | |
| 11341 | 34 #include "keyboard.h" |
| 329 | 35 #endif /* not standalone */ |
| 36 | |
| 1967 | 37 #ifdef USE_TEXT_PROPERTIES |
| 38 #include "intervals.h" | |
| 39 #endif | |
| 40 | |
| 329 | 41 Lisp_Object Vstandard_output, Qstandard_output; |
| 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 #ifdef LISP_FLOAT_TYPE |
| 47 Lisp_Object Vfloat_output_format, Qfloat_output_format; | |
| 48 #endif /* LISP_FLOAT_TYPE */ | |
| 49 | |
| 50 /* Avoid actual stack overflow in print. */ | |
| 51 int print_depth; | |
| 52 | |
|
379
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
53 /* Detect most circularities to print finite output. */ |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
54 #define PRINT_CIRCLE 200 |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
55 Lisp_Object being_printed[PRINT_CIRCLE]; |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
56 |
|
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
57 /* 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
|
58 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
|
59 char *print_buffer; |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
60 |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
61 /* 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
|
62 int print_buffer_size; |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
63 /* Size used in print_buffer. */ |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
64 int print_buffer_pos; |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
65 |
| 329 | 66 /* Maximum length of list to print in full; noninteger means |
| 67 effectively infinity */ | |
| 68 | |
| 69 Lisp_Object Vprint_length; | |
| 70 | |
| 71 /* Maximum depth of list to print in full; noninteger means | |
| 72 effectively infinity. */ | |
| 73 | |
| 74 Lisp_Object Vprint_level; | |
| 75 | |
| 76 /* Nonzero means print newlines in strings as \n. */ | |
| 77 | |
| 78 int print_escape_newlines; | |
| 79 | |
| 80 Lisp_Object Qprint_escape_newlines; | |
| 81 | |
|
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
82 /* Nonzero means print (quote foo) forms as 'foo, etc. */ |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
83 |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
84 int print_quoted; |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
85 |
|
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
86 /* Non-nil means print #: before uninterned symbols. |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
87 Neither t nor nil means so that and don't clear Vprint_gensym_alist |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
88 on entry to and exit from print functions. */ |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
89 |
|
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
90 Lisp_Object Vprint_gensym; |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
91 |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
92 /* Association list of certain objects that are `eq' in the form being |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
93 printed and which should be `eq' when read back in, using the #n=object |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
94 and #n# reader forms. Each element has the form (object . n). */ |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
95 |
|
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
96 Lisp_Object Vprint_gensym_alist; |
|
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
97 |
|
10418
fdad41459fd6
(printchar, strout): Call message_dolog.
Karl Heuer <kwzh@gnu.org>
parents:
10301
diff
changeset
|
98 /* Nonzero means print newline to stdout before next minibuffer message. |
| 329 | 99 Defined in xdisp.c */ |
| 100 | |
| 101 extern int noninteractive_need_newline; | |
|
10418
fdad41459fd6
(printchar, strout): Call message_dolog.
Karl Heuer <kwzh@gnu.org>
parents:
10301
diff
changeset
|
102 |
|
19001
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
103 extern int minibuffer_auto_raise; |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
104 |
| 329 | 105 #ifdef MAX_PRINT_CHARS |
| 106 static int print_chars; | |
| 107 static int max_print; | |
| 108 #endif /* MAX_PRINT_CHARS */ | |
| 1967 | 109 |
| 110 void print_interval (); | |
| 329 | 111 |
| 112 #if 0 | |
| 113 /* Convert between chars and GLYPHs */ | |
| 114 | |
| 115 int | |
| 116 glyphlen (glyphs) | |
| 117 register GLYPH *glyphs; | |
| 118 { | |
| 119 register int i = 0; | |
| 120 | |
| 121 while (glyphs[i]) | |
| 122 i++; | |
| 123 return i; | |
| 124 } | |
| 125 | |
| 126 void | |
| 127 str_to_glyph_cpy (str, glyphs) | |
| 128 char *str; | |
| 129 GLYPH *glyphs; | |
| 130 { | |
| 131 register GLYPH *gp = glyphs; | |
| 132 register char *cp = str; | |
| 133 | |
| 134 while (*cp) | |
| 135 *gp++ = *cp++; | |
| 136 } | |
| 137 | |
| 138 void | |
| 139 str_to_glyph_ncpy (str, glyphs, n) | |
| 140 char *str; | |
| 141 GLYPH *glyphs; | |
| 142 register int n; | |
| 143 { | |
| 144 register GLYPH *gp = glyphs; | |
| 145 register char *cp = str; | |
| 146 | |
| 147 while (n-- > 0) | |
| 148 *gp++ = *cp++; | |
| 149 } | |
| 150 | |
| 151 void | |
| 152 glyph_to_str_cpy (glyphs, str) | |
| 153 GLYPH *glyphs; | |
| 154 char *str; | |
| 155 { | |
| 156 register GLYPH *gp = glyphs; | |
| 157 register char *cp = str; | |
| 158 | |
| 159 while (*gp) | |
| 160 *str++ = *gp++ & 0377; | |
| 161 } | |
| 162 #endif | |
| 163 | |
|
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3377
diff
changeset
|
164 /* Low level output routines for characters and strings */ |
| 329 | 165 |
| 166 /* 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
|
167 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
|
168 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
|
169 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
|
170 Use PRINTCHAR to output one character, |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
171 or call strout to output a block of characters. |
| 329 | 172 */ |
| 173 | |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
174 #define PRINTDECLARE \ |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
175 struct buffer *old = current_buffer; \ |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
176 int old_point = -1, start_point; \ |
|
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
177 int specpdl_count = specpdl_ptr - specpdl; \ |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
178 int free_print_buffer = 0; \ |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
179 Lisp_Object original |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
180 |
|
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
181 #define PRINTPREPARE \ |
|
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
182 original = printcharfun; \ |
|
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
183 if (NILP (printcharfun)) printcharfun = Qt; \ |
|
9117
f69e6cf74874
(PRINTPREPARE, PRINTFINISH, float_to_string, print): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8854
diff
changeset
|
184 if (BUFFERP (printcharfun)) \ |
|
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
185 { \ |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
186 if (XBUFFER (printcharfun) != current_buffer) \ |
|
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
187 Fset_buffer (printcharfun); \ |
|
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
188 printcharfun = Qnil; \ |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
189 } \ |
|
9117
f69e6cf74874
(PRINTPREPARE, PRINTFINISH, float_to_string, print): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8854
diff
changeset
|
190 if (MARKERP (printcharfun)) \ |
|
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
191 { \ |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
192 if (!(XMARKER (original)->buffer)) \ |
|
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
193 error ("Marker does not point anywhere"); \ |
|
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
194 if (XMARKER (original)->buffer != current_buffer) \ |
|
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
195 set_buffer_internal (XMARKER (original)->buffer); \ |
|
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15908
diff
changeset
|
196 old_point = PT; \ |
|
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
197 SET_PT (marker_position (printcharfun)); \ |
|
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15908
diff
changeset
|
198 start_point = PT; \ |
|
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
199 printcharfun = Qnil; \ |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
200 } \ |
|
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
201 if (NILP (printcharfun)) \ |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
202 { \ |
|
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
203 if (print_buffer != 0) \ |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
204 record_unwind_protect (print_unwind, \ |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
205 make_string (print_buffer, \ |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
206 print_buffer_pos)); \ |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
207 else \ |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
208 { \ |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
209 print_buffer_size = 1000; \ |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
210 print_buffer = (char *) xmalloc (print_buffer_size); \ |
|
16513
ecf0700e9550
(PRINTPREPARE): Really do set free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16512
diff
changeset
|
211 free_print_buffer = 1; \ |
|
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
212 } \ |
|
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
213 print_buffer_pos = 0; \ |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
214 } \ |
|
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
215 if (!CONSP (Vprint_gensym)) \ |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
216 Vprint_gensym_alist = Qnil |
| 329 | 217 |
|
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
218 #define PRINTFINISH \ |
|
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
219 if (NILP (printcharfun)) \ |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
220 insert (print_buffer, print_buffer_pos); \ |
|
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
221 if (free_print_buffer) \ |
|
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
222 { \ |
|
16520
d18129921259
(PRINTFINISH): Use xfree, not free.
Richard M. Stallman <rms@gnu.org>
parents:
16513
diff
changeset
|
223 xfree (print_buffer); \ |
|
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
224 print_buffer = 0; \ |
|
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
225 } \ |
|
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
226 unbind_to (specpdl_count, Qnil); \ |
|
9117
f69e6cf74874
(PRINTPREPARE, PRINTFINISH, float_to_string, print): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8854
diff
changeset
|
227 if (MARKERP (original)) \ |
|
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15908
diff
changeset
|
228 Fset_marker (original, make_number (PT), Qnil); \ |
|
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
229 if (old_point >= 0) \ |
|
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
230 SET_PT (old_point + (old_point >= start_point \ |
|
16039
855c8d8ba0f0
Change all references from point to PT.
Karl Heuer <kwzh@gnu.org>
parents:
15908
diff
changeset
|
231 ? PT - start_point : 0)); \ |
|
2193
652b38173a63
(PRINTPREPARE): Handle marker that points nowhere.
Richard M. Stallman <rms@gnu.org>
parents:
1991
diff
changeset
|
232 if (old != current_buffer) \ |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
233 set_buffer_internal (old); \ |
|
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
234 if (!CONSP (Vprint_gensym)) \ |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
235 Vprint_gensym_alist = Qnil |
| 329 | 236 |
| 237 #define PRINTCHAR(ch) printchar (ch, printcharfun) | |
| 238 | |
|
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
239 /* Nonzero if there is no room to print any more characters |
|
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
240 so print might as well return right away. */ |
|
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
241 |
|
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
242 #define PRINTFULLP() \ |
|
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
243 (EQ (printcharfun, Qt) && !noninteractive \ |
|
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
244 && printbufidx >= FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window))))) |
|
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
245 |
|
16512
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
246 /* 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
|
247 when there is a recursive call to print. */ |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
248 static Lisp_Object |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
249 print_unwind (saved_text) |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
250 Lisp_Object saved_text; |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
251 { |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
252 bcopy (XSTRING (saved_text)->data, print_buffer, XSTRING (saved_text)->size); |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
253 } |
|
59835b743b93
(PRINTDECLARE): Declare specpdl_count and free_print_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
16496
diff
changeset
|
254 |
|
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
255 /* Index of first unused element of FRAME_MESSAGE_BUF (mini_frame). */ |
| 329 | 256 static int printbufidx; |
| 257 | |
| 258 static void | |
| 259 printchar (ch, fun) | |
| 17040 | 260 unsigned int ch; |
| 329 | 261 Lisp_Object fun; |
| 262 { | |
| 263 Lisp_Object ch1; | |
| 264 | |
| 265 #ifdef MAX_PRINT_CHARS | |
| 266 if (max_print) | |
| 267 print_chars++; | |
| 268 #endif /* MAX_PRINT_CHARS */ | |
| 269 #ifndef standalone | |
| 270 if (EQ (fun, Qnil)) | |
| 271 { | |
| 17040 | 272 int len; |
| 273 char work[4], *str; | |
| 274 | |
| 329 | 275 QUIT; |
| 17040 | 276 len = CHAR_STRING (ch, work, str); |
| 277 if (print_buffer_pos + len >= print_buffer_size) | |
|
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
278 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
|
279 print_buffer_size *= 2); |
| 17040 | 280 bcopy (str, print_buffer + print_buffer_pos, len); |
| 281 print_buffer_pos += len; | |
| 329 | 282 return; |
| 283 } | |
| 284 | |
| 285 if (EQ (fun, Qt)) | |
| 286 { | |
|
6808
514a324b3681
(printchar, strout): Use FRAME_PTR, not struct frame *.
Karl Heuer <kwzh@gnu.org>
parents:
6802
diff
changeset
|
287 FRAME_PTR mini_frame |
|
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
288 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window))); |
| 17040 | 289 unsigned char work[4], *str; |
| 290 int len = CHAR_STRING (ch, work, str); | |
|
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
291 |
|
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
292 QUIT; |
|
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
293 |
| 329 | 294 if (noninteractive) |
| 295 { | |
| 17040 | 296 while (len--) |
| 297 putchar (*str), str++; | |
| 329 | 298 noninteractive_need_newline = 1; |
| 299 return; | |
| 300 } | |
| 301 | |
|
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
302 if (echo_area_glyphs != FRAME_MESSAGE_BUF (mini_frame) |
| 329 | 303 || !message_buf_print) |
| 304 { | |
|
10568
275f62e27ee2
(printchar, strout): Use message_log_maybe_newline.
Karl Heuer <kwzh@gnu.org>
parents:
10482
diff
changeset
|
305 message_log_maybe_newline (); |
|
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
306 echo_area_glyphs = FRAME_MESSAGE_BUF (mini_frame); |
| 329 | 307 printbufidx = 0; |
|
5233
83e771f33251
(printchar, strout): Set echo_area_glyphs_length.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
308 echo_area_glyphs_length = 0; |
| 329 | 309 message_buf_print = 1; |
|
19001
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
310 |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
311 if (minibuffer_auto_raise) |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
312 { |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
313 Lisp_Object mini_window; |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
314 |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
315 /* Get the frame containing the minibuffer |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
316 that the selected frame is using. */ |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
317 mini_window = FRAME_MINIBUF_WINDOW (selected_frame); |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
318 |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
319 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window))); |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
320 } |
| 329 | 321 } |
| 322 | |
| 17040 | 323 message_dolog (str, len, 0); |
| 324 if (printbufidx < FRAME_MESSAGE_BUF_SIZE (mini_frame) - len) | |
| 325 bcopy (str, &FRAME_MESSAGE_BUF (mini_frame)[printbufidx], len), | |
| 326 printbufidx += len; | |
|
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
327 FRAME_MESSAGE_BUF (mini_frame)[printbufidx] = 0; |
|
5233
83e771f33251
(printchar, strout): Set echo_area_glyphs_length.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
328 echo_area_glyphs_length = printbufidx; |
| 329 | 329 |
| 330 return; | |
| 331 } | |
| 332 #endif /* not standalone */ | |
| 333 | |
|
9317
58f6a917533b
(printchar): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents:
9276
diff
changeset
|
334 XSETFASTINT (ch1, ch); |
| 329 | 335 call1 (fun, ch1); |
| 336 } | |
| 337 | |
| 338 static void | |
| 339 strout (ptr, size, printcharfun) | |
| 340 char *ptr; | |
| 341 int size; | |
| 342 Lisp_Object printcharfun; | |
| 343 { | |
| 344 int i = 0; | |
| 345 | |
| 17040 | 346 if (size < 0) |
| 347 size = strlen (ptr); | |
| 348 | |
| 329 | 349 if (EQ (printcharfun, Qnil)) |
| 350 { | |
|
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
351 if (print_buffer_pos + size > print_buffer_size) |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
352 { |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
353 print_buffer_size = print_buffer_size * 2 + size; |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
354 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
|
355 print_buffer_size); |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
356 } |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
357 bcopy (ptr, print_buffer + print_buffer_pos, size); |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
358 print_buffer_pos += size; |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
359 |
| 329 | 360 #ifdef MAX_PRINT_CHARS |
| 361 if (max_print) | |
|
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
362 print_chars += size; |
| 329 | 363 #endif /* MAX_PRINT_CHARS */ |
| 364 return; | |
| 365 } | |
| 366 if (EQ (printcharfun, Qt)) | |
| 367 { | |
|
6808
514a324b3681
(printchar, strout): Use FRAME_PTR, not struct frame *.
Karl Heuer <kwzh@gnu.org>
parents:
6802
diff
changeset
|
368 FRAME_PTR mini_frame |
|
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
369 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window))); |
|
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
370 |
|
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
371 QUIT; |
|
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
372 |
| 329 | 373 #ifdef MAX_PRINT_CHARS |
| 374 if (max_print) | |
| 17040 | 375 print_chars += size; |
| 329 | 376 #endif /* MAX_PRINT_CHARS */ |
| 377 | |
| 378 if (noninteractive) | |
| 379 { | |
| 17040 | 380 fwrite (ptr, 1, size, stdout); |
| 329 | 381 noninteractive_need_newline = 1; |
| 382 return; | |
| 383 } | |
| 384 | |
|
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
385 if (echo_area_glyphs != FRAME_MESSAGE_BUF (mini_frame) |
| 329 | 386 || !message_buf_print) |
| 387 { | |
|
10568
275f62e27ee2
(printchar, strout): Use message_log_maybe_newline.
Karl Heuer <kwzh@gnu.org>
parents:
10482
diff
changeset
|
388 message_log_maybe_newline (); |
|
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
389 echo_area_glyphs = FRAME_MESSAGE_BUF (mini_frame); |
| 329 | 390 printbufidx = 0; |
|
5233
83e771f33251
(printchar, strout): Set echo_area_glyphs_length.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
391 echo_area_glyphs_length = 0; |
| 329 | 392 message_buf_print = 1; |
|
19001
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
393 |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
394 if (minibuffer_auto_raise) |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
395 { |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
396 Lisp_Object mini_window; |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
397 |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
398 /* Get the frame containing the minibuffer |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
399 that the selected frame is using. */ |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
400 mini_window = FRAME_MINIBUF_WINDOW (selected_frame); |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
401 |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
402 Fraise_frame (WINDOW_FRAME (XWINDOW (mini_window))); |
|
2190c39dc640
(strout, printchar): Handle minibuffer_auto_raise.
Richard M. Stallman <rms@gnu.org>
parents:
18961
diff
changeset
|
403 } |
| 329 | 404 } |
| 405 | |
| 17040 | 406 message_dolog (ptr, size, 0); |
| 407 if (size > FRAME_MESSAGE_BUF_SIZE (mini_frame) - printbufidx - 1) | |
| 408 { | |
| 409 size = FRAME_MESSAGE_BUF_SIZE (mini_frame) - printbufidx - 1; | |
| 410 /* Rewind incomplete multi-byte form. */ | |
| 411 while (size && (unsigned char) ptr[size] >= 0xA0) size--; | |
| 412 } | |
| 413 bcopy (ptr, &FRAME_MESSAGE_BUF (mini_frame) [printbufidx], size); | |
| 414 printbufidx += size; | |
|
5233
83e771f33251
(printchar, strout): Set echo_area_glyphs_length.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
415 echo_area_glyphs_length = printbufidx; |
|
5487
58a9bb23c3ea
(strout, printchar): Use proper frame for minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
5233
diff
changeset
|
416 FRAME_MESSAGE_BUF (mini_frame) [printbufidx] = 0; |
| 329 | 417 |
| 418 return; | |
| 419 } | |
| 420 | |
| 17040 | 421 i = 0; |
| 422 while (i < size) | |
| 423 { | |
| 424 /* Here, we must convert each multi-byte form to the | |
| 425 corresponding character code before handing it to PRINTCHAR. */ | |
| 426 int len; | |
| 427 int ch = STRING_CHAR_AND_LENGTH (ptr + i, size - i, len); | |
| 428 | |
| 429 PRINTCHAR (ch); | |
| 430 i += len; | |
| 431 } | |
| 329 | 432 } |
| 433 | |
| 434 /* 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
|
435 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
|
436 because printing one char can relocate. */ |
| 329 | 437 |
| 438 print_string (string, printcharfun) | |
| 439 Lisp_Object string; | |
| 440 Lisp_Object printcharfun; | |
| 441 { | |
|
15801
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
442 if (EQ (printcharfun, Qt) || NILP (printcharfun)) |
|
b0bd5de2ce82
When printing into a buffer, generate all the text
Richard M. Stallman <rms@gnu.org>
parents:
15707
diff
changeset
|
443 /* strout is safe for output to a frame (echo area) or to print_buffer. */ |
| 329 | 444 strout (XSTRING (string)->data, XSTRING (string)->size, printcharfun); |
| 445 else | |
| 446 { | |
| 447 /* Otherwise, fetch the string address for each character. */ | |
| 448 int i; | |
| 449 int size = XSTRING (string)->size; | |
| 450 struct gcpro gcpro1; | |
| 451 GCPRO1 (string); | |
| 452 for (i = 0; i < size; i++) | |
| 453 PRINTCHAR (XSTRING (string)->data[i]); | |
| 454 UNGCPRO; | |
| 455 } | |
| 456 } | |
| 457 | |
| 458 DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0, | |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
459 "Output character CHARACTER to stream PRINTCHARFUN.\n\ |
| 7185 | 460 PRINTCHARFUN defaults to the value of `standard-output' (which see).") |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
461 (character, printcharfun) |
|
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
462 Lisp_Object character, printcharfun; |
| 329 | 463 { |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
464 PRINTDECLARE; |
| 329 | 465 |
| 520 | 466 if (NILP (printcharfun)) |
| 329 | 467 printcharfun = Vstandard_output; |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
468 CHECK_NUMBER (character, 0); |
| 329 | 469 PRINTPREPARE; |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
470 PRINTCHAR (XINT (character)); |
| 329 | 471 PRINTFINISH; |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
472 return character; |
| 329 | 473 } |
| 474 | |
| 475 /* Used from outside of print.c to print a block of SIZE chars at DATA | |
| 476 on the default output stream. | |
| 477 Do not use this on the contents of a Lisp string. */ | |
| 478 | |
| 479 write_string (data, size) | |
| 480 char *data; | |
| 481 int size; | |
| 482 { | |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
483 PRINTDECLARE; |
| 329 | 484 Lisp_Object printcharfun; |
| 485 | |
| 486 printcharfun = Vstandard_output; | |
| 487 | |
| 488 PRINTPREPARE; | |
| 489 strout (data, size, printcharfun); | |
| 490 PRINTFINISH; | |
| 491 } | |
| 492 | |
| 493 /* Used from outside of print.c to print a block of SIZE chars at DATA | |
| 494 on a specified stream PRINTCHARFUN. | |
| 495 Do not use this on the contents of a Lisp string. */ | |
| 496 | |
| 497 write_string_1 (data, size, printcharfun) | |
| 498 char *data; | |
| 499 int size; | |
| 500 Lisp_Object printcharfun; | |
| 501 { | |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
502 PRINTDECLARE; |
| 329 | 503 |
| 504 PRINTPREPARE; | |
| 505 strout (data, size, printcharfun); | |
| 506 PRINTFINISH; | |
| 507 } | |
| 508 | |
| 509 | |
| 510 #ifndef standalone | |
| 511 | |
| 512 void | |
| 513 temp_output_buffer_setup (bufname) | |
| 514 char *bufname; | |
| 515 { | |
| 516 register struct buffer *old = current_buffer; | |
| 517 register Lisp_Object buf; | |
| 518 | |
| 519 Fset_buffer (Fget_buffer_create (build_string (bufname))); | |
| 520 | |
|
11114
c8ab5c627f74
(temp_output_buffer_setup): (Re)set the default
Richard M. Stallman <rms@gnu.org>
parents:
11010
diff
changeset
|
521 current_buffer->directory = old->directory; |
| 329 | 522 current_buffer->read_only = Qnil; |
| 523 Ferase_buffer (); | |
| 524 | |
|
9276
ae62e12feac5
(temp_output_buffer_setup): Use new accessor macros instead of calling XSET
Karl Heuer <kwzh@gnu.org>
parents:
9117
diff
changeset
|
525 XSETBUFFER (buf, current_buffer); |
| 329 | 526 specbind (Qstandard_output, buf); |
| 527 | |
| 528 set_buffer_internal (old); | |
| 529 } | |
| 530 | |
| 531 Lisp_Object | |
| 532 internal_with_output_to_temp_buffer (bufname, function, args) | |
| 533 char *bufname; | |
| 534 Lisp_Object (*function) (); | |
| 535 Lisp_Object args; | |
| 536 { | |
| 537 int count = specpdl_ptr - specpdl; | |
| 538 Lisp_Object buf, val; | |
|
8315
8921d0012bd5
(internal_with_output_to_temp_buffer): gcpro things.
Richard M. Stallman <rms@gnu.org>
parents:
7185
diff
changeset
|
539 struct gcpro gcpro1; |
| 329 | 540 |
|
8315
8921d0012bd5
(internal_with_output_to_temp_buffer): gcpro things.
Richard M. Stallman <rms@gnu.org>
parents:
7185
diff
changeset
|
541 GCPRO1 (args); |
| 329 | 542 record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); |
| 543 temp_output_buffer_setup (bufname); | |
| 544 buf = Vstandard_output; | |
|
8315
8921d0012bd5
(internal_with_output_to_temp_buffer): gcpro things.
Richard M. Stallman <rms@gnu.org>
parents:
7185
diff
changeset
|
545 UNGCPRO; |
| 329 | 546 |
| 547 val = (*function) (args); | |
| 548 | |
|
8315
8921d0012bd5
(internal_with_output_to_temp_buffer): gcpro things.
Richard M. Stallman <rms@gnu.org>
parents:
7185
diff
changeset
|
549 GCPRO1 (val); |
| 329 | 550 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
|
551 UNGCPRO; |
| 329 | 552 |
| 553 return unbind_to (count, val); | |
| 554 } | |
| 555 | |
| 556 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer, | |
| 557 1, UNEVALLED, 0, | |
| 558 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\ | |
| 559 The buffer is cleared out initially, and marked as unmodified when done.\n\ | |
| 560 All output done by BODY is inserted in that buffer by default.\n\ | |
| 561 The buffer is displayed in another window, but not selected.\n\ | |
| 562 The value of the last form in BODY is returned.\n\ | |
| 563 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\ | |
|
3337
f5f76ebe6286
(Fwith_output_to_temp_buffer): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
2782
diff
changeset
|
564 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\ |
| 329 | 565 to get the buffer displayed. It gets one argument, the buffer to display.") |
| 566 (args) | |
| 567 Lisp_Object args; | |
| 568 { | |
| 569 struct gcpro gcpro1; | |
| 570 Lisp_Object name; | |
| 571 int count = specpdl_ptr - specpdl; | |
| 572 Lisp_Object buf, val; | |
| 573 | |
| 574 GCPRO1(args); | |
| 575 name = Feval (Fcar (args)); | |
| 576 UNGCPRO; | |
| 577 | |
| 578 CHECK_STRING (name, 0); | |
| 579 temp_output_buffer_setup (XSTRING (name)->data); | |
| 580 buf = Vstandard_output; | |
| 581 | |
| 582 val = Fprogn (Fcdr (args)); | |
| 583 | |
| 584 temp_output_buffer_show (buf); | |
| 585 | |
| 586 return unbind_to (count, val); | |
| 587 } | |
| 588 #endif /* not standalone */ | |
| 589 | |
| 590 static void print (); | |
| 591 | |
| 592 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0, | |
| 7185 | 593 "Output a newline to stream PRINTCHARFUN.\n\ |
| 594 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.") | |
| 329 | 595 (printcharfun) |
| 596 Lisp_Object printcharfun; | |
| 597 { | |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
598 PRINTDECLARE; |
| 329 | 599 |
| 520 | 600 if (NILP (printcharfun)) |
| 329 | 601 printcharfun = Vstandard_output; |
| 602 PRINTPREPARE; | |
| 603 PRINTCHAR ('\n'); | |
| 604 PRINTFINISH; | |
| 605 return Qt; | |
| 606 } | |
| 607 | |
| 608 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0, | |
| 609 "Output the printed representation of OBJECT, any Lisp object.\n\ | |
| 610 Quoting characters are printed when needed to make output that `read'\n\ | |
| 611 can handle, whenever this is possible.\n\ | |
| 7185 | 612 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).") |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
613 (object, printcharfun) |
|
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
614 Lisp_Object object, printcharfun; |
| 329 | 615 { |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
616 PRINTDECLARE; |
| 329 | 617 |
| 618 #ifdef MAX_PRINT_CHARS | |
| 619 max_print = 0; | |
| 620 #endif /* MAX_PRINT_CHARS */ | |
| 520 | 621 if (NILP (printcharfun)) |
| 329 | 622 printcharfun = Vstandard_output; |
| 623 PRINTPREPARE; | |
| 624 print_depth = 0; | |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
625 print (object, printcharfun, 1); |
| 329 | 626 PRINTFINISH; |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
627 return object; |
| 329 | 628 } |
| 629 | |
| 630 /* a buffer which is used to hold output being built by prin1-to-string */ | |
| 631 Lisp_Object Vprin1_to_string_buffer; | |
| 632 | |
| 633 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0, | |
| 634 "Return a string containing the printed representation of OBJECT,\n\ | |
| 635 any Lisp object. Quoting characters are used when needed to make output\n\ | |
| 636 that `read' can handle, whenever this is possible, unless the optional\n\ | |
| 637 second argument NOESCAPE is non-nil.") | |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
638 (object, noescape) |
|
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
639 Lisp_Object object, noescape; |
| 329 | 640 { |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
641 PRINTDECLARE; |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
642 Lisp_Object printcharfun; |
|
15270
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
643 struct gcpro gcpro1, gcpro2; |
|
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
644 Lisp_Object tem; |
|
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
645 |
|
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
646 /* Save and restore this--we are altering a buffer |
|
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
647 but we don't want to deactivate the mark just for that. |
|
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
648 No need for specbind, since errors deactivate the mark. */ |
|
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
649 tem = Vdeactivate_mark; |
|
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
650 GCPRO2 (object, tem); |
| 329 | 651 |
| 652 printcharfun = Vprin1_to_string_buffer; | |
| 653 PRINTPREPARE; | |
| 654 print_depth = 0; | |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
655 print (object, printcharfun, NILP (noescape)); |
| 329 | 656 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */ |
| 657 PRINTFINISH; | |
| 658 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
|
659 object = Fbuffer_string (); |
| 329 | 660 |
| 661 Ferase_buffer (); | |
| 662 set_buffer_internal (old); | |
|
15270
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
663 |
|
22867e90511f
(Fprin1_to_string): Preserve Vdeactivate_mark.
Karl Heuer <kwzh@gnu.org>
parents:
14186
diff
changeset
|
664 Vdeactivate_mark = tem; |
| 329 | 665 UNGCPRO; |
| 666 | |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
667 return object; |
| 329 | 668 } |
| 669 | |
| 670 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0, | |
| 671 "Output the printed representation of OBJECT, any Lisp object.\n\ | |
| 672 No quoting characters are used; no delimiters are printed around\n\ | |
| 673 the contents of strings.\n\ | |
| 7185 | 674 Output stream is PRINTCHARFUN, or value of standard-output (which see).") |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
675 (object, printcharfun) |
|
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
676 Lisp_Object object, printcharfun; |
| 329 | 677 { |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
678 PRINTDECLARE; |
| 329 | 679 |
| 520 | 680 if (NILP (printcharfun)) |
| 329 | 681 printcharfun = Vstandard_output; |
| 682 PRINTPREPARE; | |
| 683 print_depth = 0; | |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
684 print (object, printcharfun, 0); |
| 329 | 685 PRINTFINISH; |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
686 return object; |
| 329 | 687 } |
| 688 | |
| 689 DEFUN ("print", Fprint, Sprint, 1, 2, 0, | |
| 690 "Output the printed representation of OBJECT, with newlines around it.\n\ | |
| 691 Quoting characters are printed when needed to make output that `read'\n\ | |
| 692 can handle, whenever this is possible.\n\ | |
| 7185 | 693 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).") |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
694 (object, printcharfun) |
|
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
695 Lisp_Object object, printcharfun; |
| 329 | 696 { |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
697 PRINTDECLARE; |
| 329 | 698 struct gcpro gcpro1; |
| 699 | |
| 700 #ifdef MAX_PRINT_CHARS | |
| 701 print_chars = 0; | |
| 702 max_print = MAX_PRINT_CHARS; | |
| 703 #endif /* MAX_PRINT_CHARS */ | |
| 520 | 704 if (NILP (printcharfun)) |
| 329 | 705 printcharfun = Vstandard_output; |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
706 GCPRO1 (object); |
| 329 | 707 PRINTPREPARE; |
| 708 print_depth = 0; | |
| 709 PRINTCHAR ('\n'); | |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
710 print (object, printcharfun, 1); |
| 329 | 711 PRINTCHAR ('\n'); |
| 712 PRINTFINISH; | |
| 713 #ifdef MAX_PRINT_CHARS | |
| 714 max_print = 0; | |
| 715 print_chars = 0; | |
| 716 #endif /* MAX_PRINT_CHARS */ | |
| 717 UNGCPRO; | |
|
14084
8765a56417ac
(Fwrite_char, Fprin1, Fprin1_to_string, Fprinc, Fprint): Harmonize
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
718 return object; |
| 329 | 719 } |
| 720 | |
| 721 /* The subroutine object for external-debugging-output is kept here | |
| 722 for the convenience of the debugger. */ | |
| 723 Lisp_Object Qexternal_debugging_output; | |
| 724 | |
| 621 | 725 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0, |
| 726 "Write CHARACTER to stderr.\n\ | |
| 329 | 727 You can call print while debugging emacs, and pass it this function\n\ |
| 728 to make it write to the debugging output.\n") | |
| 621 | 729 (character) |
| 730 Lisp_Object character; | |
| 329 | 731 { |
| 732 CHECK_NUMBER (character, 0); | |
| 733 putc (XINT (character), stderr); | |
| 734 | |
| 735 return character; | |
| 736 } | |
|
6533
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
737 |
|
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
738 /* This is the interface for debugging printing. */ |
|
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
739 |
|
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
740 void |
|
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
741 debug_print (arg) |
|
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
742 Lisp_Object arg; |
|
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
743 { |
|
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
744 Fprin1 (arg, Qexternal_debugging_output); |
|
13456
b66f0626addb
(debug_print): Explicitly print a CR.
Richard M. Stallman <rms@gnu.org>
parents:
13405
diff
changeset
|
745 fprintf (stderr, "\r\n"); |
|
6533
49f896769be4
(debug_print): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5852
diff
changeset
|
746 } |
| 329 | 747 |
|
13776
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
748 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
|
749 1, 1, 0, |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
750 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.") |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
751 (obj) |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
752 Lisp_Object obj; |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
753 { |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
754 struct buffer *old = current_buffer; |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
755 Lisp_Object original, printcharfun, value; |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
756 struct gcpro gcpro1; |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
757 |
|
18342
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
758 /* 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
|
759 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
|
760 space here when the error is due to memory full. */ |
|
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
761 if (CONSP (obj) && EQ (XCONS (obj)->car, Qerror) |
|
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
762 && CONSP (XCONS (obj)->cdr) |
|
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
763 && STRINGP (XCONS (XCONS (obj)->cdr)->car) |
|
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
764 && NILP (XCONS (XCONS (obj)->cdr)->cdr)) |
|
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
765 return XCONS (XCONS (obj)->cdr)->car; |
|
913d2cc5a6aa
(Ferror_message_string): Optimize (error STRING) case.
Richard M. Stallman <rms@gnu.org>
parents:
17509
diff
changeset
|
766 |
|
13776
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
767 print_error_message (obj, Vprin1_to_string_buffer, NULL); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
768 |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
769 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer)); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
770 value = Fbuffer_string (); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
771 |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
772 GCPRO1 (value); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
773 Ferase_buffer (); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
774 set_buffer_internal (old); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
775 UNGCPRO; |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
776 |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
777 return value; |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
778 } |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
779 |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
780 /* Print an error message for the error DATA |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
781 onto Lisp output stream STREAM (suitable for the print functions). */ |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
782 |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
783 print_error_message (data, stream) |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
784 Lisp_Object data, stream; |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
785 { |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
786 Lisp_Object errname, errmsg, file_error, tail; |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
787 struct gcpro gcpro1; |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
788 int i; |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
789 |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
790 errname = Fcar (data); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
791 |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
792 if (EQ (errname, Qerror)) |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
793 { |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
794 data = Fcdr (data); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
795 if (!CONSP (data)) data = Qnil; |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
796 errmsg = Fcar (data); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
797 file_error = Qnil; |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
798 } |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
799 else |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
800 { |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
801 errmsg = Fget (errname, Qerror_message); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
802 file_error = Fmemq (Qfile_error, |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
803 Fget (errname, Qerror_conditions)); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
804 } |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
805 |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
806 /* Print an error message including the data items. */ |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
807 |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
808 tail = Fcdr_safe (data); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
809 GCPRO1 (tail); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
810 |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
811 /* For file-error, make error message by concatenating |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
812 all the data items. They are all strings. */ |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
813 if (!NILP (file_error) && !NILP (tail)) |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
814 errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr; |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
815 |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
816 if (STRINGP (errmsg)) |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
817 Fprinc (errmsg, stream); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
818 else |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
819 write_string_1 ("peculiar error", -1, stream); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
820 |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
821 for (i = 0; CONSP (tail); tail = Fcdr (tail), i++) |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
822 { |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
823 write_string_1 (i ? ", " : ": ", 2, stream); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
824 if (!NILP (file_error)) |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
825 Fprinc (Fcar (tail), stream); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
826 else |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
827 Fprin1 (Fcar (tail), stream); |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
828 } |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
829 UNGCPRO; |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
830 } |
|
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
831 |
| 329 | 832 #ifdef LISP_FLOAT_TYPE |
| 833 | |
| 834 /* | |
|
1759
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
835 * The buffer should be at least as large as the max string size of the |
| 14036 | 836 * largest float, printed in the biggest notation. This is undoubtedly |
| 329 | 837 * 20d float_output_format, with the negative of the C-constant "HUGE" |
| 838 * from <math.h>. | |
| 839 * | |
| 840 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes. | |
| 841 * | |
| 842 * I assume that IEEE-754 format numbers can take 329 bytes for the worst | |
| 843 * case of -1e307 in 20d float_output_format. What is one to do (short of | |
| 844 * re-writing _doprnt to be more sane)? | |
| 845 * -wsr | |
| 846 */ | |
|
1759
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
847 |
|
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
848 void |
|
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
849 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
|
850 unsigned char *buf; |
| 329 | 851 double data; |
| 852 { | |
|
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
853 unsigned char *cp; |
|
4224
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
854 int width; |
| 329 | 855 |
| 520 | 856 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
|
857 || !STRINGP (Vfloat_output_format)) |
| 329 | 858 lose: |
|
4224
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
859 { |
|
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
860 sprintf (buf, "%.17g", data); |
|
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
861 width = -1; |
|
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
862 } |
| 329 | 863 else /* oink oink */ |
| 864 { | |
| 865 /* Check that the spec we have is fully valid. | |
| 866 This means not only valid for printf, | |
| 867 but meant for floats, and reasonable. */ | |
| 868 cp = XSTRING (Vfloat_output_format)->data; | |
| 869 | |
| 870 if (cp[0] != '%') | |
| 871 goto lose; | |
| 872 if (cp[1] != '.') | |
| 873 goto lose; | |
| 874 | |
| 875 cp += 2; | |
|
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
876 |
|
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
877 /* 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
|
878 width = -1; |
|
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
879 if ('0' <= *cp && *cp <= '9') |
|
11798
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
880 { |
|
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
881 width = 0; |
|
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
882 do |
|
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
883 width = (width * 10) + (*cp++ - '0'); |
|
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
884 while (*cp >= '0' && *cp <= '9'); |
|
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
885 |
|
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
886 /* 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
|
887 if (width > DBL_DIG |
|
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
888 || (width == 0 && *cp != 'f')) |
|
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
889 goto lose; |
|
7646040d7383
(float_to_string): Fix type mismatch and simplify.
Karl Heuer <kwzh@gnu.org>
parents:
11697
diff
changeset
|
890 } |
| 329 | 891 |
| 892 if (*cp != 'e' && *cp != 'f' && *cp != 'g') | |
| 893 goto lose; | |
| 894 | |
| 895 if (cp[1] != 0) | |
| 896 goto lose; | |
| 897 | |
| 898 sprintf (buf, XSTRING (Vfloat_output_format)->data, data); | |
| 899 } | |
|
1759
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
900 |
|
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
901 /* 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
|
902 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
|
903 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
|
904 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
|
905 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
|
906 { |
|
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
907 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
|
908 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
|
909 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
|
910 |
|
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
911 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
|
912 { |
|
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
913 cp[1] = '0'; |
|
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
914 cp[2] = 0; |
|
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
915 } |
|
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
916 |
|
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
917 if (*cp == 0) |
|
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
918 { |
|
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
919 *cp++ = '.'; |
|
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
920 *cp++ = '0'; |
|
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
921 *cp++ = 0; |
|
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
922 } |
|
1759
3c615a9dcd64
(float_to_string): Add `.0' at end if needed.
Richard M. Stallman <rms@gnu.org>
parents:
1521
diff
changeset
|
923 } |
| 329 | 924 } |
| 925 #endif /* LISP_FLOAT_TYPE */ | |
| 926 | |
| 927 static void | |
| 928 print (obj, printcharfun, escapeflag) | |
| 929 Lisp_Object obj; | |
| 930 register Lisp_Object printcharfun; | |
| 931 int escapeflag; | |
| 932 { | |
| 933 char buf[30]; | |
| 934 | |
| 935 QUIT; | |
| 936 | |
|
379
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
937 #if 1 /* I'm not sure this is really worth doing. */ |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
938 /* Detect circularities and truncate them. |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
939 No need to offer any alternative--this is better than an error. */ |
|
9117
f69e6cf74874
(PRINTPREPARE, PRINTFINISH, float_to_string, print): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8854
diff
changeset
|
940 if (CONSP (obj) || VECTORP (obj) || COMPILEDP (obj)) |
|
379
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
941 { |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
942 int i; |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
943 for (i = 0; i < print_depth; i++) |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
944 if (EQ (obj, being_printed[i])) |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
945 { |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
946 sprintf (buf, "#%d", i); |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
947 strout (buf, -1, printcharfun); |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
948 return; |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
949 } |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
950 } |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
951 #endif |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
952 |
|
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
953 being_printed[print_depth] = obj; |
| 329 | 954 print_depth++; |
| 955 | |
|
379
34ec8957c6c0
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
373
diff
changeset
|
956 if (print_depth > PRINT_CIRCLE) |
| 329 | 957 error ("Apparently circular structure being printed"); |
| 958 #ifdef MAX_PRINT_CHARS | |
| 959 if (max_print && print_chars > max_print) | |
| 960 { | |
| 961 PRINTCHAR ('\n'); | |
| 962 print_chars = 0; | |
| 963 } | |
| 964 #endif /* MAX_PRINT_CHARS */ | |
| 965 | |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
966 switch (XGCTYPE (obj)) |
| 329 | 967 { |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
968 case Lisp_Int: |
|
11697
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
969 if (sizeof (int) == sizeof (EMACS_INT)) |
|
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
970 sprintf (buf, "%d", XINT (obj)); |
|
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
971 else if (sizeof (long) == sizeof (EMACS_INT)) |
|
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
972 sprintf (buf, "%ld", XINT (obj)); |
|
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
973 else |
|
2de5b0c89802
(print): Make the printing understand EMACS_INTs
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
974 abort (); |
| 329 | 975 strout (buf, -1, printcharfun); |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
976 break; |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
977 |
| 10001 | 978 #ifdef LISP_FLOAT_TYPE |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
979 case Lisp_Float: |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
980 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
981 char pigbuf[350]; /* see comments in float_to_string */ |
| 329 | 982 |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
983 float_to_string (pigbuf, XFLOAT(obj)->data); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
984 strout (pigbuf, -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
985 } |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
986 break; |
| 10001 | 987 #endif |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
988 |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
989 case Lisp_String: |
| 329 | 990 if (!escapeflag) |
| 991 print_string (obj, printcharfun); | |
| 992 else | |
| 993 { | |
| 994 register int i; | |
| 995 register unsigned char c; | |
| 996 struct gcpro gcpro1; | |
| 997 | |
| 1967 | 998 GCPRO1 (obj); |
| 999 | |
| 1000 #ifdef USE_TEXT_PROPERTIES | |
| 1001 if (!NULL_INTERVAL_P (XSTRING (obj)->intervals)) | |
| 1002 { | |
| 1003 PRINTCHAR ('#'); | |
| 1004 PRINTCHAR ('('); | |
| 1005 } | |
| 1006 #endif | |
| 329 | 1007 |
| 1008 PRINTCHAR ('\"'); | |
| 1009 for (i = 0; i < XSTRING (obj)->size; i++) | |
| 1010 { | |
| 1011 QUIT; | |
| 1012 c = XSTRING (obj)->data[i]; | |
| 1013 if (c == '\n' && print_escape_newlines) | |
| 1014 { | |
| 1015 PRINTCHAR ('\\'); | |
| 1016 PRINTCHAR ('n'); | |
| 1017 } | |
|
5852
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
1018 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
|
1019 { |
|
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
1020 PRINTCHAR ('\\'); |
|
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
1021 PRINTCHAR ('f'); |
|
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
1022 } |
| 329 | 1023 else |
| 1024 { | |
| 1025 if (c == '\"' || c == '\\') | |
| 1026 PRINTCHAR ('\\'); | |
| 1027 PRINTCHAR (c); | |
| 1028 } | |
| 1029 } | |
| 1030 PRINTCHAR ('\"'); | |
| 1967 | 1031 |
| 1032 #ifdef USE_TEXT_PROPERTIES | |
| 1033 if (!NULL_INTERVAL_P (XSTRING (obj)->intervals)) | |
| 1034 { | |
| 1035 traverse_intervals (XSTRING (obj)->intervals, | |
| 1036 0, 0, print_interval, printcharfun); | |
| 1037 PRINTCHAR (')'); | |
| 1038 } | |
| 1039 #endif | |
| 1040 | |
| 329 | 1041 UNGCPRO; |
| 1042 } | |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1043 break; |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1044 |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1045 case Lisp_Symbol: |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1046 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1047 register int confusing; |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1048 register unsigned char *p = XSYMBOL (obj)->name->data; |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1049 register unsigned char *end = p + XSYMBOL (obj)->name->size; |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1050 register unsigned char c; |
|
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1051 int i; |
| 329 | 1052 |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1053 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
|
1054 if (p == end) |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1055 confusing = 0; |
|
17509
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1056 /* 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
|
1057 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
|
1058 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
|
1059 |
|
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1060 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
|
1061 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
|
1062 about them here. */ |
|
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1063 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
|
1064 && 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
|
1065 { |
|
17223
ed068c0c1648
(print): Generate a backslash in \2e10.
Richard M. Stallman <rms@gnu.org>
parents:
17040
diff
changeset
|
1066 while (p != end && ((*p >= '0' && *p <= '9') |
|
ed068c0c1648
(print): Generate a backslash in \2e10.
Richard M. Stallman <rms@gnu.org>
parents:
17040
diff
changeset
|
1067 /* Needed for \2e10. */ |
|
ed068c0c1648
(print): Generate a backslash in \2e10.
Richard M. Stallman <rms@gnu.org>
parents:
17040
diff
changeset
|
1068 || *p == 'e')) |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1069 p++; |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1070 confusing = (end == p); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1071 } |
|
17509
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1072 else |
|
0c38918fbf13
(print): Symbols like e2 and 2e are not confusing.
Richard M. Stallman <rms@gnu.org>
parents:
17325
diff
changeset
|
1073 confusing = 0; |
| 329 | 1074 |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1075 /* If we print an uninterned symbol as part of a complex object and |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1076 the flag print-gensym is non-nil, prefix it with #n= to read the |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1077 object back with the #n# reader syntax later if needed. */ |
|
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1078 if (! NILP (Vprint_gensym) && NILP (XSYMBOL (obj)->obarray)) |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1079 { |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1080 if (print_depth > 1) |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1081 { |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1082 Lisp_Object tem; |
|
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1083 tem = Fassq (obj, Vprint_gensym_alist); |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1084 if (CONSP (tem)) |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1085 { |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1086 PRINTCHAR ('#'); |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1087 print (XCDR (tem), printcharfun, escapeflag); |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1088 PRINTCHAR ('#'); |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1089 break; |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1090 } |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1091 else |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1092 { |
|
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1093 if (CONSP (Vprint_gensym_alist)) |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1094 XSETFASTINT (tem, XFASTINT (XCDR (XCAR (Vprint_gensym_alist))) + 1); |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1095 else |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1096 XSETFASTINT (tem, 1); |
|
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1097 Vprint_gensym_alist = Fcons (Fcons (obj, tem), Vprint_gensym_alist); |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1098 |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1099 PRINTCHAR ('#'); |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1100 print (tem, printcharfun, escapeflag); |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1101 PRINTCHAR ('='); |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1102 } |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1103 } |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1104 PRINTCHAR ('#'); |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1105 PRINTCHAR (':'); |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1106 } |
|
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1107 |
|
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1108 for (i = 0; i < XSYMBOL (obj)->name->size; i++) |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1109 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1110 QUIT; |
|
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1111 c = XSYMBOL (obj)->name->data[i]; |
|
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1112 |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1113 if (escapeflag) |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1114 { |
|
16496
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1115 if (c == '\"' || c == '\\' || c == '\'' |
|
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1116 || c == ';' || c == '#' || c == '(' || c == ')' |
|
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1117 || c == ',' || c =='.' || c == '`' |
|
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1118 || c == '[' || c == ']' || c == '?' || c <= 040 |
|
a4e5a8ee32cc
(printchar, strout): Do QUIT for echo area output.
Richard M. Stallman <rms@gnu.org>
parents:
16140
diff
changeset
|
1119 || confusing) |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1120 PRINTCHAR ('\\'), confusing = 0; |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1121 } |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1122 PRINTCHAR (c); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1123 } |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1124 } |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1125 break; |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1126 |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1127 case Lisp_Cons: |
| 329 | 1128 /* 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
|
1129 if (INTEGERP (Vprint_level) |
| 329 | 1130 && print_depth > XINT (Vprint_level)) |
| 10001 | 1131 strout ("...", -1, printcharfun); |
|
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1132 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
|
1133 && (EQ (XCAR (obj), Qquote))) |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1134 { |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1135 PRINTCHAR ('\''); |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1136 print (XCAR (XCDR (obj)), printcharfun, escapeflag); |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1137 } |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1138 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
|
1139 && (EQ (XCAR (obj), Qfunction))) |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1140 { |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1141 PRINTCHAR ('#'); |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1142 PRINTCHAR ('\''); |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1143 print (XCAR (XCDR (obj)), printcharfun, escapeflag); |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1144 } |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1145 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
|
1146 && ((EQ (XCAR (obj), Qbackquote) |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1147 || EQ (XCAR (obj), Qcomma) |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1148 || EQ (XCAR (obj), Qcomma_at) |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1149 || EQ (XCAR (obj), Qcomma_dot)))) |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1150 { |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1151 print (XCAR (obj), printcharfun, 0); |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1152 print (XCAR (XCDR (obj)), printcharfun, escapeflag); |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1153 } |
| 10001 | 1154 else |
| 329 | 1155 { |
| 10001 | 1156 PRINTCHAR ('('); |
| 329 | 1157 { |
| 10001 | 1158 register int i = 0; |
| 1159 register int max = 0; | |
| 1160 | |
| 1161 if (INTEGERP (Vprint_length)) | |
| 1162 max = XINT (Vprint_length); | |
| 1163 /* Could recognize circularities in cdrs here, | |
| 1164 but that would make printing of long lists quadratic. | |
| 1165 It's not worth doing. */ | |
| 1166 while (CONSP (obj)) | |
| 329 | 1167 { |
| 10001 | 1168 if (i++) |
| 1169 PRINTCHAR (' '); | |
| 1170 if (max && i > max) | |
| 1171 { | |
| 1172 strout ("...", 3, printcharfun); | |
| 1173 break; | |
| 1174 } | |
|
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1175 print (XCAR (obj), printcharfun, escapeflag); |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1176 obj = XCDR (obj); |
| 329 | 1177 } |
| 1178 } | |
|
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1179 if (!NILP (obj)) |
| 10001 | 1180 { |
| 1181 strout (" . ", 3, printcharfun); | |
| 1182 print (obj, printcharfun, escapeflag); | |
| 1183 } | |
| 1184 PRINTCHAR (')'); | |
| 329 | 1185 } |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1186 break; |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1187 |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1188 case Lisp_Vectorlike: |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1189 if (PROCESSP (obj)) |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1190 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1191 if (escapeflag) |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1192 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1193 strout ("#<process ", -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1194 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
|
1195 PRINTCHAR ('>'); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1196 } |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1197 else |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1198 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
|
1199 } |
|
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1200 else if (BOOL_VECTOR_P (obj)) |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1201 { |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1202 register int i; |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1203 register unsigned char c; |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1204 struct gcpro gcpro1; |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1205 int size_in_chars |
|
16893
5889a6e7c71b
(print): Round size of bool-vector properly.
Richard M. Stallman <rms@gnu.org>
parents:
16520
diff
changeset
|
1206 = (XBOOL_VECTOR (obj)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; |
|
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1207 |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1208 GCPRO1 (obj); |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1209 |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1210 PRINTCHAR ('#'); |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1211 PRINTCHAR ('&'); |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1212 sprintf (buf, "%d", XBOOL_VECTOR (obj)->size); |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1213 strout (buf, -1, printcharfun); |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1214 PRINTCHAR ('\"'); |
|
15563
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1215 |
|
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1216 /* Don't print more characters than the specified maximum. */ |
|
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1217 if (INTEGERP (Vprint_length) |
|
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1218 && XINT (Vprint_length) < size_in_chars) |
|
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1219 size_in_chars = XINT (Vprint_length); |
|
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1220 |
|
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1221 for (i = 0; i < size_in_chars; i++) |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1222 { |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1223 QUIT; |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1224 c = XBOOL_VECTOR (obj)->data[i]; |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1225 if (c == '\n' && print_escape_newlines) |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1226 { |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1227 PRINTCHAR ('\\'); |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1228 PRINTCHAR ('n'); |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1229 } |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1230 else if (c == '\f' && print_escape_newlines) |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1231 { |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1232 PRINTCHAR ('\\'); |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1233 PRINTCHAR ('f'); |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1234 } |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1235 else |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1236 { |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1237 if (c == '\"' || c == '\\') |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1238 PRINTCHAR ('\\'); |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1239 PRINTCHAR (c); |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1240 } |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1241 } |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1242 PRINTCHAR ('\"'); |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1243 |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1244 UNGCPRO; |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1245 } |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1246 else if (SUBRP (obj)) |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1247 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1248 strout ("#<subr ", -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1249 strout (XSUBR (obj)->symbol_name, -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1250 PRINTCHAR ('>'); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1251 } |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1252 #ifndef standalone |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1253 else if (WINDOWP (obj)) |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1254 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1255 strout ("#<window ", -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1256 sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number)); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1257 strout (buf, -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1258 if (!NILP (XWINDOW (obj)->buffer)) |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1259 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1260 strout (" on ", -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1261 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
|
1262 } |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1263 PRINTCHAR ('>'); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1264 } |
|
10301
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1265 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
|
1266 { |
|
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1267 if (NILP (XBUFFER (obj)->name)) |
|
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1268 strout ("#<killed buffer>", -1, printcharfun); |
|
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1269 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
|
1270 { |
|
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1271 strout ("#<buffer ", -1, printcharfun); |
|
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1272 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
|
1273 PRINTCHAR ('>'); |
|
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1274 } |
|
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1275 else |
|
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1276 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
|
1277 } |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1278 else if (WINDOW_CONFIGURATIONP (obj)) |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1279 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1280 strout ("#<window-configuration>", -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1281 } |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1282 else if (FRAMEP (obj)) |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1283 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1284 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
|
1285 ? "#<frame " : "#<dead frame "), |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1286 -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1287 print_string (XFRAME (obj)->name, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1288 sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj))); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1289 strout (buf, -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1290 PRINTCHAR ('>'); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1291 } |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1292 #endif /* not standalone */ |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1293 else |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1294 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1295 int size = XVECTOR (obj)->size; |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1296 if (COMPILEDP (obj)) |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1297 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1298 PRINTCHAR ('#'); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1299 size &= PSEUDOVECTOR_SIZE_MASK; |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1300 } |
|
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1301 if (CHAR_TABLE_P (obj)) |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1302 { |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1303 /* 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
|
1304 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
|
1305 character slots. But we add #^ as a prefix. */ |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1306 PRINTCHAR ('#'); |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1307 PRINTCHAR ('^'); |
|
17325
c19c552c486f
(read1): Adjusted for the new structure of Lisp_Char_Table.
Kenichi Handa <handa@m17n.org>
parents:
17223
diff
changeset
|
1308 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
|
1309 PRINTCHAR ('^'); |
|
13147
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1310 size &= PSEUDOVECTOR_SIZE_MASK; |
|
bd9ff4ee6cd4
(print): Handle chartables and boolvectors.
Richard M. Stallman <rms@gnu.org>
parents:
12782
diff
changeset
|
1311 } |
|
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1312 if (size & PSEUDOVECTOR_FLAG) |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1313 goto badtype; |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1314 |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1315 PRINTCHAR ('['); |
| 329 | 1316 { |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1317 register int i; |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1318 register Lisp_Object tem; |
|
15563
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1319 |
|
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1320 /* Don't print more elements than the specified maximum. */ |
|
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1321 if (INTEGERP (Vprint_length) |
|
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1322 && XINT (Vprint_length) < size) |
|
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1323 size = XINT (Vprint_length); |
|
e47df82909ff
(print): Obey Vprint_length for vectors, bitvectors.
Richard M. Stallman <rms@gnu.org>
parents:
15270
diff
changeset
|
1324 |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1325 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
|
1326 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1327 if (i) PRINTCHAR (' '); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1328 tem = XVECTOR (obj)->contents[i]; |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1329 print (tem, printcharfun, escapeflag); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1330 } |
| 329 | 1331 } |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1332 PRINTCHAR (']'); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1333 } |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1334 break; |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1335 |
| 329 | 1336 #ifndef standalone |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1337 case Lisp_Misc: |
|
11241
5fed07fb66fb
(print): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11235
diff
changeset
|
1338 switch (XMISCTYPE (obj)) |
| 329 | 1339 { |
|
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1340 case Lisp_Misc_Marker: |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1341 strout ("#<marker ", -1, printcharfun); |
| 17040 | 1342 #if 0 |
| 1343 /* Do you think this is necessary? */ | |
| 1344 if (XMARKER (obj)->insertion_type != 0) | |
| 1345 strout ("(before-insertion) ", -1, printcharfun); | |
| 1346 #endif /* 0 */ | |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1347 if (!(XMARKER (obj)->buffer)) |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1348 strout ("in no buffer", -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1349 else |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1350 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1351 sprintf (buf, "at %d", marker_position (obj)); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1352 strout (buf, -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1353 strout (" in ", -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1354 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
|
1355 } |
| 329 | 1356 PRINTCHAR ('>'); |
|
10301
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1357 break; |
|
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1358 |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1359 case Lisp_Misc_Overlay: |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1360 strout ("#<overlay ", -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1361 if (!(XMARKER (OVERLAY_START (obj))->buffer)) |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1362 strout ("in no buffer", -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1363 else |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1364 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1365 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
|
1366 marker_position (OVERLAY_START (obj)), |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1367 marker_position (OVERLAY_END (obj))); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1368 strout (buf, -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1369 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
|
1370 printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1371 } |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1372 PRINTCHAR ('>'); |
|
10301
aa73a5c0d1f2
(print): Don't drop thru to error for markers and overlays.
Richard M. Stallman <rms@gnu.org>
parents:
10293
diff
changeset
|
1373 break; |
|
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1374 |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1375 /* 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
|
1376 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
|
1377 case Lisp_Misc_Free: |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1378 strout ("#<misc free cell>", -1, printcharfun); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1379 break; |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1380 |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1381 case Lisp_Misc_Intfwd: |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1382 sprintf (buf, "#<intfwd to %d>", *XINTFWD (obj)->intvar); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1383 strout (buf, -1, printcharfun); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1384 break; |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1385 |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1386 case Lisp_Misc_Boolfwd: |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1387 sprintf (buf, "#<boolfwd to %s>", |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1388 (*XBOOLFWD (obj)->boolvar ? "t" : "nil")); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1389 strout (buf, -1, printcharfun); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1390 break; |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1391 |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1392 case Lisp_Misc_Objfwd: |
|
15707
303f5be100a9
(print): Fix args in strout calls.
Karl Heuer <kwzh@gnu.org>
parents:
15563
diff
changeset
|
1393 strout ("#<objfwd to ", -1, printcharfun); |
|
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1394 print (*XOBJFWD (obj)->objvar, printcharfun, escapeflag); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1395 PRINTCHAR ('>'); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1396 break; |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1397 |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1398 case Lisp_Misc_Buffer_Objfwd: |
|
15707
303f5be100a9
(print): Fix args in strout calls.
Karl Heuer <kwzh@gnu.org>
parents:
15563
diff
changeset
|
1399 strout ("#<buffer_objfwd to ", -1, printcharfun); |
|
10583
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1400 print (*(Lisp_Object *)((char *)current_buffer |
|
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1401 + XBUFFER_OBJFWD (obj)->offset), |
|
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1402 printcharfun, escapeflag); |
|
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1403 PRINTCHAR ('>'); |
|
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1404 break; |
|
6736693cb8c8
(print): Handle internal display-local object.
Karl Heuer <kwzh@gnu.org>
parents:
10568
diff
changeset
|
1405 |
|
11010
45ae0022c48a
(print): Rename perdisplay to kboard.
Karl Heuer <kwzh@gnu.org>
parents:
10993
diff
changeset
|
1406 case Lisp_Misc_Kboard_Objfwd: |
|
15707
303f5be100a9
(print): Fix args in strout calls.
Karl Heuer <kwzh@gnu.org>
parents:
15563
diff
changeset
|
1407 strout ("#<kboard_objfwd to ", -1, printcharfun); |
|
11010
45ae0022c48a
(print): Rename perdisplay to kboard.
Karl Heuer <kwzh@gnu.org>
parents:
10993
diff
changeset
|
1408 print (*(Lisp_Object *)((char *) current_kboard |
|
45ae0022c48a
(print): Rename perdisplay to kboard.
Karl Heuer <kwzh@gnu.org>
parents:
10993
diff
changeset
|
1409 + XKBOARD_OBJFWD (obj)->offset), |
|
10993
e72bd65cab70
(print): current_perdisplay now is never null.
Karl Heuer <kwzh@gnu.org>
parents:
10651
diff
changeset
|
1410 printcharfun, escapeflag); |
|
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1411 PRINTCHAR ('>'); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1412 break; |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1413 |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1414 case Lisp_Misc_Buffer_Local_Value: |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1415 strout ("#<buffer_local_value ", -1, printcharfun); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1416 goto do_buffer_local; |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1417 case Lisp_Misc_Some_Buffer_Local_Value: |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1418 strout ("#<some_buffer_local_value ", -1, printcharfun); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1419 do_buffer_local: |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1420 strout ("[realvalue] ", -1, printcharfun); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1421 print (XBUFFER_LOCAL_VALUE (obj)->car, printcharfun, escapeflag); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1422 strout ("[buffer] ", -1, printcharfun); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1423 print (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->car, |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1424 printcharfun, escapeflag); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1425 strout ("[alist-elt] ", -1, printcharfun); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1426 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr)->car, |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1427 printcharfun, escapeflag); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1428 strout ("[default-value] ", -1, printcharfun); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1429 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr)->cdr, |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1430 printcharfun, escapeflag); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1431 PRINTCHAR ('>'); |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1432 break; |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1433 |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1434 default: |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1435 goto badtype; |
| 329 | 1436 } |
|
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1437 break; |
| 329 | 1438 #endif /* standalone */ |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1439 |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1440 default: |
|
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1441 badtype: |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1442 { |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1443 /* 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
|
1444 Probably should just abort () */ |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1445 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, printcharfun); |
|
10482
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1446 if (MISCP (obj)) |
|
11241
5fed07fb66fb
(print): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11235
diff
changeset
|
1447 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
|
1448 else if (VECTORLIKEP (obj)) |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1449 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
|
1450 else |
|
a15a058ec779
(print): Print internal types too, for debugging.
Karl Heuer <kwzh@gnu.org>
parents:
10418
diff
changeset
|
1451 sprintf (buf, "(0x%02x)", (int) XTYPE (obj)); |
|
10293
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1452 strout (buf, -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1453 strout (" Save your buffers immediately and please report this bug>", |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1454 -1, printcharfun); |
|
96cc5c0a7ada
(print): Get size of compiled function as pseudovector.
Richard M. Stallman <rms@gnu.org>
parents:
10001
diff
changeset
|
1455 } |
| 329 | 1456 } |
| 1457 | |
| 1458 print_depth--; | |
| 1459 } | |
| 1460 | |
| 1967 | 1461 #ifdef USE_TEXT_PROPERTIES |
| 1462 | |
| 1463 /* Print a description of INTERVAL using PRINTCHARFUN. | |
| 1464 This is part of printing a string that has text properties. */ | |
| 1465 | |
| 1466 void | |
| 1467 print_interval (interval, printcharfun) | |
| 1468 INTERVAL interval; | |
| 1469 Lisp_Object printcharfun; | |
| 1470 { | |
|
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
|
1471 PRINTCHAR (' '); |
| 1967 | 1472 print (make_number (interval->position), printcharfun, 1); |
| 1473 PRINTCHAR (' '); | |
| 1474 print (make_number (interval->position + LENGTH (interval)), | |
| 1475 printcharfun, 1); | |
| 1476 PRINTCHAR (' '); | |
| 1477 print (interval->plist, printcharfun, 1); | |
| 1478 } | |
| 1479 | |
| 1480 #endif /* USE_TEXT_PROPERTIES */ | |
| 1481 | |
| 329 | 1482 void |
| 1483 syms_of_print () | |
| 1484 { | |
| 1485 DEFVAR_LISP ("standard-output", &Vstandard_output, | |
| 1486 "Output stream `print' uses by default for outputting a character.\n\ | |
| 1487 This may be any function of one argument.\n\ | |
| 1488 It may also be a buffer (output is inserted before point)\n\ | |
| 1489 or a marker (output is inserted and the marker is advanced)\n\ | |
|
13776
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1490 or the symbol t (output appears in the echo area)."); |
| 329 | 1491 Vstandard_output = Qt; |
| 1492 Qstandard_output = intern ("standard-output"); | |
| 1493 staticpro (&Qstandard_output); | |
| 1494 | |
| 1495 #ifdef LISP_FLOAT_TYPE | |
| 1496 DEFVAR_LISP ("float-output-format", &Vfloat_output_format, | |
|
687
e2b747dd6a6e
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
1497 "The format descriptor string used to print floats.\n\ |
| 329 | 1498 This is a %-spec like those accepted by `printf' in C,\n\ |
| 1499 but with some restrictions. It must start with the two characters `%.'.\n\ | |
| 1500 After that comes an integer precision specification,\n\ | |
| 1501 and then a letter which controls the format.\n\ | |
| 1502 The letters allowed are `e', `f' and `g'.\n\ | |
| 1503 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\ | |
| 1504 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\ | |
| 1505 Use `g' to choose the shorter of those two formats for the number at hand.\n\ | |
| 1506 The precision in any of these cases is the number of digits following\n\ | |
| 1507 the decimal point. With `f', a precision of 0 means to omit the\n\ | |
|
4140
2738089e8383
* print.c (float_to_string): Distinguish between a precision of
Jim Blandy <jimb@redhat.com>
parents:
4003
diff
changeset
|
1508 decimal point. 0 is not allowed with `e' or `g'.\n\n\ |
|
4224
6cb1cfba6500
(float_to_string): Don't use uninitialized pointer `cp'.
Richard M. Stallman <rms@gnu.org>
parents:
4140
diff
changeset
|
1509 A value of nil means to use `%.17g'."); |
| 329 | 1510 Vfloat_output_format = Qnil; |
| 1511 Qfloat_output_format = intern ("float-output-format"); | |
| 1512 staticpro (&Qfloat_output_format); | |
| 1513 #endif /* LISP_FLOAT_TYPE */ | |
| 1514 | |
| 1515 DEFVAR_LISP ("print-length", &Vprint_length, | |
|
686
bd3068742807
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
621
diff
changeset
|
1516 "Maximum length of list to print before abbreviating.\n\ |
| 329 | 1517 A value of nil means no limit."); |
| 1518 Vprint_length = Qnil; | |
| 1519 | |
| 1520 DEFVAR_LISP ("print-level", &Vprint_level, | |
|
686
bd3068742807
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
621
diff
changeset
|
1521 "Maximum depth of list nesting to print before abbreviating.\n\ |
| 329 | 1522 A value of nil means no limit."); |
| 1523 Vprint_level = Qnil; | |
| 1524 | |
| 1525 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines, | |
|
6802
7d69da13c140
(syms_of_print): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
6533
diff
changeset
|
1526 "Non-nil means print newlines in strings as backslash-n.\n\ |
|
5852
f2e341b1f908
(print): If print_escapes_newlines, print '\f' as "\\f".
Roland McGrath <roland@gnu.org>
parents:
5487
diff
changeset
|
1527 Also print formfeeds as backslash-f."); |
| 329 | 1528 print_escape_newlines = 0; |
| 1529 | |
|
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1530 DEFVAR_BOOL ("print-quoted", &print_quoted, |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1531 "Non-nil means print quoted forms with reader syntax.\n\ |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1532 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\ |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1533 forms print in the new syntax."); |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1534 print_quoted = 0; |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1535 |
|
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1536 DEFVAR_LISP ("print-gensym", &Vprint_gensym, |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1537 "Non-nil means print uninterned symbols so they will read as uninterned.\n\ |
|
18961
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1538 I.e., the value of (make-symbol "foobar") prints as #:foobar.\n\ |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1539 When the uninterned symbol appears within a larger data structure,\n\ |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1540 in addition use the #...# and #...= constructs as needed,\n\ |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1541 so that multiple references to the same symbol are shared once again\n\ |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1542 when the text is read back.\n\ |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1543 \n\ |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1544 If the value of `print-gensym' is a cons cell, then in addition refrain from\n\ |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1545 clearing `print-gensym-alist' on entry to and exit from printing functions,\n\ |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1546 so that the use of #...# and #...= can carry over for several separately\n\ |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1547 printed objects."); |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1548 Vprint_gensym = Qnil; |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1549 |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1550 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist, |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1551 "Association list of elements (GENSYM . N) to guide use of #N# and #N=.\n\ |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1552 In each element, GENSYM is an uninterned symbol that has been associated\n\ |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1553 with #N= for the specified value of N."); |
|
e537071624ee
(Vprint_gensym_alist): Renamed from printed_gensyms.
Richard M. Stallman <rms@gnu.org>
parents:
18613
diff
changeset
|
1554 Vprint_gensym_alist = Qnil; |
|
16140
e7de214aac01
Add #n=object, #n#, and #:symbol constructs to printer.
Erik Naggum <erik@naggum.no>
parents:
16051
diff
changeset
|
1555 |
| 329 | 1556 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */ |
| 1557 staticpro (&Vprin1_to_string_buffer); | |
| 1558 | |
| 1559 defsubr (&Sprin1); | |
| 1560 defsubr (&Sprin1_to_string); | |
|
13776
8160ed43603e
(Ferror_message_string): New function.
Karl Heuer <kwzh@gnu.org>
parents:
13456
diff
changeset
|
1561 defsubr (&Serror_message_string); |
| 329 | 1562 defsubr (&Sprinc); |
| 1563 defsubr (&Sprint); | |
| 1564 defsubr (&Sterpri); | |
| 1565 defsubr (&Swrite_char); | |
| 1566 defsubr (&Sexternal_debugging_output); | |
| 1567 | |
| 1568 Qexternal_debugging_output = intern ("external-debugging-output"); | |
| 1569 staticpro (&Qexternal_debugging_output); | |
| 1570 | |
|
15908
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1571 Qprint_escape_newlines = intern ("print-escape-newlines"); |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1572 staticpro (&Qprint_escape_newlines); |
|
045bf20a0e7c
(print-quoted): New variable.
Erik Naggum <erik@naggum.no>
parents:
15801
diff
changeset
|
1573 |
| 329 | 1574 #ifndef standalone |
| 1575 defsubr (&Swith_output_to_temp_buffer); | |
| 1576 #endif /* not standalone */ | |
| 1577 } |
