Mercurial > emacs
annotate lisp/emacs-lisp/cust-print.el @ 2563:c8ae06bda9fa
(global-map): Remove function key bindings that duplicate stuff in
loaddefs.el.
author | Eric S. Raymond <esr@snark.thyrsus.com> |
---|---|
date | Fri, 23 Apr 1993 02:21:02 +0000 |
parents | 2c7997f249eb |
children | b65cf676a09b |
rev | line source |
---|---|
2230
6314334d7c2b
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2229
diff
changeset
|
1 ;;; cust-print.el --- handles print-level and print-circle. |
655 | 2 |
845 | 3 ;; Copyright (C) 1992 Free Software Foundation, Inc. |
4 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
655
diff
changeset
|
5 ;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu> |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
655
diff
changeset
|
6 ;; Version: 1.0 |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
655
diff
changeset
|
7 ;; Adapted-By: ESR |
2247
2c7997f249eb
Add or correct keywords
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2230
diff
changeset
|
8 ;; Keywords: extensions |
655 | 9 |
10 ;; This file is part of GNU Emacs. | |
11 | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
655
diff
changeset
|
14 ;; the Free Software Foundation; either version 2, or (at your option) |
655 | 15 ;; any later version. |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
25 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
655
diff
changeset
|
26 ;;; Commentary: |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
655
diff
changeset
|
27 |
655 | 28 ;; This package provides a general print handler for prin1 and princ |
29 ;; that supports print-level and print-circle, and by the way, | |
30 ;; print-length since the standard routines are being replaced. Also, | |
31 ;; to print custom types constructed from lists and vectors, use | |
32 ;; custom-print-list and custom-print-vector. See the documentation | |
33 ;; strings of these variables for more details. | |
34 | |
35 ;; If the results of your expressions contain circular references to | |
36 ;; other parts of the same structure, the standard Emacs print | |
37 ;; subroutines may fail to print with an untrappable error, | |
38 ;; "Apparently circular structure being printed". If you only use cdr | |
39 ;; circular lists (where cdrs of lists point back; what is the right | |
40 ;; term here?), you can limit the length of printing with | |
41 ;; print-length. But car circular lists and circular vectors generate | |
42 ;; the above mentioned untrappable error in Emacs version 18. Version | |
43 ;; 19 will support print-level, but it is often useful to get a better | |
44 ;; print representation of circular structures; the print-circle | |
45 ;; option may be used to print more concise representations. | |
46 | |
47 ;; There are two main ways to use this package. First, you may | |
48 ;; replace prin1, princ, and some subroutines that use them by calling | |
49 ;; install-custom-print-funcs so that any use of these functions in | |
50 ;; lisp code will be affected. Second, you could call the custom | |
51 ;; routines directly, thus only affecting the printing that requires | |
52 ;; them. | |
53 | |
54 ;; Note that subroutines which call print subroutines directly will not | |
55 ;; use the custom print functions. In particular, the evaluation | |
56 ;; functions like eval-region call the print subroutines directly. | |
57 ;; Therefore, evaluating (aref circ-list 0), which calls error | |
58 ;; directly (because circ-list is not an array), will jump to the top | |
59 ;; level instead of printing the circular list. | |
60 | |
61 ;; Obviously the right way to implement this custom-print facility | |
62 ;; is in C. Please volunteer since I don't have the time or need. | |
63 | |
64 ;; Implementation design: we want to use the same list and vector | |
65 ;; processing algorithm for all versions of prin1 and princ, since how | |
66 ;; the processing is done depends on print-length, print-level, and | |
67 ;; print-circle. For circle printing, a preprocessing step is | |
68 ;; required before the final printing. Thanks to Jamie Zawinski | |
69 ;; for motivation and algorithms. | |
70 | |
71 ;;========================================================= | |
72 ;; export list: | |
73 | |
74 ;; print-level | |
75 ;; print-circle | |
76 | |
77 ;; custom-print-list | |
78 ;; custom-print-vector | |
79 ;; add-custom-print-list | |
80 ;; add-custom-print-vector | |
81 | |
82 ;; install-custom-print-funcs | |
83 ;; uninstall-custom-print-funcs | |
84 | |
85 ;; custom-prin1 | |
86 ;; custom-princ | |
87 ;; custom-prin1-to-string | |
88 ;; custom-print | |
89 ;; custom-format | |
90 ;; custom-message | |
91 ;; custom-error | |
92 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
655
diff
changeset
|
93 ;;; Code: |
655 | 94 |
95 (provide 'custom-print) | |
96 | |
97 ;;(defvar print-length nil | |
98 ;; "*Controls how many elements of a list, at each level, are printed. | |
99 ;;This is defined by emacs.") | |
100 | |
101 (defvar print-level nil | |
102 "*Controls how many levels deep a nested data object will print. | |
103 | |
104 If nil, printing proceeds recursively and may lead to | |
105 max-lisp-eval-depth being exceeded or an untrappable error may occur: | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
106 `Apparently circular structure being printed.' |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
107 Also see `print-length' and `print-circle'. |
655 | 108 |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
109 If non-nil, components at levels equal to or greater than `print-level' |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
110 are printed simply as `#'. The object to be printed is at level 0, |
655 | 111 and if the object is a list or vector, its top-level components are at |
112 level 1.") | |
113 | |
114 | |
115 (defvar print-circle nil | |
116 "*Controls the printing of recursive structures. | |
117 | |
118 If nil, printing proceeds recursively and may lead to | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
119 `max-lisp-eval-depth' being exceeded or an untrappable error may occur: |
655 | 120 \"Apparently circular structure being printed.\" Also see |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
121 `print-length' and `print-level'. |
655 | 122 |
123 If non-nil, shared substructures anywhere in the structure are printed | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
124 with `#N=' before the first occurance (in the order of the print |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
125 representation) and `#N#' in place of each subsequent occurance, |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
126 where N is a positive decimal integer. |
655 | 127 |
128 Currently, there is no way to read this representation in Emacs.") | |
129 | |
130 | |
131 (defconst custom-print-list | |
132 nil | |
133 ;; e.g. '((floatp . float-to-string)) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
134 "An alist for custom printing of lists. |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
135 Pairs are of the form (PRED . CONVERTER). If PREDICATE is true |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
136 for an object, then CONVERTER is called with the object and should |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
137 return a string to be printed with `princ'. |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
138 Also see `custom-print-vector'.") |
655 | 139 |
140 (defconst custom-print-vector | |
141 nil | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
142 "An alist for custom printing of vectors. |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
143 Pairs are of the form (PRED . CONVERTER). If PREDICATE is true |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
144 for an object, then CONVERTER is called with the object and should |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
145 return a string to be printed with `princ'. |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
146 Also see `custom-print-list'.") |
655 | 147 |
148 | |
149 (defun add-custom-print-list (pred converter) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
150 "Add a pair of PREDICATE and CONVERTER to `custom-print-list'. |
655 | 151 Any pair that has the same PREDICATE is first removed." |
152 (setq custom-print-list (cons (cons pred converter) | |
153 (delq (assq pred custom-print-list) | |
154 custom-print-list)))) | |
155 ;; e.g. (add-custom-print-list 'floatp 'float-to-string) | |
156 | |
157 | |
158 (defun add-custom-print-vector (pred converter) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
159 "Add a pair of PREDICATE and CONVERTER to `custom-print-vector'. |
655 | 160 Any pair that has the same PREDICATE is first removed." |
161 (setq custom-print-vector (cons (cons pred converter) | |
162 (delq (assq pred custom-print-vector) | |
163 custom-print-vector)))) | |
164 | |
165 | |
166 ;;==================================================== | |
167 ;; Saving and restoring internal printing routines. | |
168 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
169 (defun cust-print-set-function-cell (symbol-pair) |
655 | 170 (fset (car symbol-pair) |
171 (symbol-function (car (cdr symbol-pair))))) | |
172 | |
173 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
174 (if (not (fboundp 'cust-print-internal-prin1)) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
175 (mapcar 'cust-print-set-function-cell |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
176 '((cust-print-internal-prin1 prin1) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
177 (cust-print-internal-princ princ) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
178 (cust-print-internal-print print) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
179 (cust-print-internal-prin1-to-string prin1-to-string) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
180 (cust-print-internal-format format) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
181 (cust-print-internal-message message) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
182 (cust-print-internal-error error)))) |
655 | 183 |
184 | |
185 (defun install-custom-print-funcs () | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
186 "Replace print functions with general, customizable, Lisp versions. |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
187 The internal subroutines are saved away, and you can reinstall them |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
188 by running `uninstall-custom-print-funcs'." |
655 | 189 (interactive) |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
190 (mapcar 'cust-print-set-function-cell |
655 | 191 '((prin1 custom-prin1) |
192 (princ custom-princ) | |
193 (print custom-print) | |
194 (prin1-to-string custom-prin1-to-string) | |
195 (format custom-format) | |
196 (message custom-message) | |
197 (error custom-error) | |
198 ))) | |
199 | |
200 (defun uninstall-custom-print-funcs () | |
201 "Reset print functions to their internal subroutines." | |
202 (interactive) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
203 (mapcar 'cust-print-set-function-cell |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
204 '((prin1 cust-print-internal-prin1) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
205 (princ cust-print-internal-princ) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
206 (print cust-print-internal-print) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
207 (prin1-to-string cust-print-internal-prin1-to-string) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
208 (format cust-print-internal-format) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
209 (message cust-print-internal-message) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
210 (error cust-print-internal-error) |
655 | 211 ))) |
212 | |
213 | |
214 ;;=============================================================== | |
215 ;; Lisp replacements for prin1 and princ and for subrs that use prin1 | |
216 ;; (or princ) -- so far only the printing and formatting subrs. | |
217 | |
218 (defun custom-prin1 (object &optional stream) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
219 "Replacement for standard `prin1'. |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
220 Uses the appropriate printer depending on the values of `print-level' |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
221 and `print-circle' (which see). |
655 | 222 |
223 Output the printed representation of OBJECT, any Lisp object. | |
224 Quoting characters are printed when needed to make output that `read' | |
225 can handle, whenever this is possible. | |
226 Output stream is STREAM, or value of `standard-output' (which see)." | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
227 (cust-print-top-level object stream 'cust-print-internal-prin1)) |
655 | 228 |
229 | |
230 (defun custom-princ (object &optional stream) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
231 "Same as `custom-prin1' except no quoting." |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
232 (cust-print-top-level object stream 'cust-print-internal-princ)) |
655 | 233 |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
234 (defvar custom-prin1-chars) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
235 |
655 | 236 (defun custom-prin1-to-string-func (c) |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
237 "Stream function for `custom-prin1-to-string'." |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
238 (setq custom-prin1-chars (cons c custom-prin1-chars))) |
655 | 239 |
240 (defun custom-prin1-to-string (object) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
241 "Replacement for standard `prin1-to-string'." |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
242 (let ((custom-prin1-chars nil)) |
655 | 243 (custom-prin1 object 'custom-prin1-to-string-func) |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
244 (concat (nreverse custom-prin1-chars)))) |
655 | 245 |
246 | |
247 (defun custom-print (object &optional stream) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
248 "Replacement for standard `print'." |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
249 (cust-print-internal-princ "\n") |
655 | 250 (custom-prin1 object stream) |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
251 (cust-print-internal-princ "\n")) |
655 | 252 |
253 | |
254 (defun custom-format (fmt &rest args) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
255 "Replacement for standard `format'. |
655 | 256 |
257 Calls format after first making strings for list or vector args. | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
258 The format specification for such args should be `%s' in any case, so a |
655 | 259 string argument will also work. The string is generated with |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
260 `custom-prin1-to-string', which quotes quotable characters." |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
261 (apply 'cust-print-internal-format fmt |
655 | 262 (mapcar (function (lambda (arg) |
263 (if (or (listp arg) (vectorp arg)) | |
264 (custom-prin1-to-string arg) | |
265 arg))) | |
266 args))) | |
267 | |
268 | |
269 | |
270 (defun custom-message (fmt &rest args) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
271 "Replacement for standard `message' that works like `custom-format'." |
655 | 272 ;; It doesnt work to princ the result of custom-format |
273 ;; because the echo area requires special handling | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
274 ;; to avoid duplicating the output. cust-print-internal-message does it right. |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
275 ;; (cust-print-internal-princ (apply 'custom-format fmt args)) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
276 (apply 'cust-print-internal-message fmt |
655 | 277 (mapcar (function (lambda (arg) |
278 (if (or (listp arg) (vectorp arg)) | |
279 (custom-prin1-to-string arg) | |
280 arg))) | |
281 args))) | |
282 | |
283 | |
284 (defun custom-error (fmt &rest args) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
285 "Replacement for standard `error' that uses `custom-format'" |
655 | 286 (signal 'error (list (apply 'custom-format fmt args)))) |
287 | |
288 | |
289 ;;========================================= | |
290 ;; Support for custom prin1 and princ | |
291 | |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
292 (defvar circle-table) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
293 (defvar circle-tree) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
294 (defvar circle-level) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
295 |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
296 (defun cust-print-top-level (object stream internal-printer) |
655 | 297 "Set up for printing." |
298 (let ((standard-output (or stream standard-output)) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
299 (circle-table (and print-circle (cust-print-preprocess-circle-tree object))) |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
300 (circle-level (or print-level -1)) |
655 | 301 ) |
302 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
303 (fset 'cust-print-internal-printer internal-printer) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
304 (fset 'cust-print-low-level-prin |
655 | 305 (cond |
306 ((or custom-print-list | |
307 custom-print-vector | |
308 print-level ; comment out for version 19 | |
309 ) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
310 'cust-print-custom-object) |
655 | 311 (circle-table |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
312 'cust-print-object) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
313 (t 'cust-print-internal-printer))) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
314 (fset 'cust-print-prin (if circle-table 'cust-print-circular 'cust-print-low-level-prin)) |
655 | 315 |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
316 (cust-print-prin object) |
655 | 317 object)) |
318 | |
319 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
320 ;; Test object type and print accordingly. |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
321 (defun cust-print-object (object) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
322 ;; Could be called as either cust-print-low-level-prin or cust-print-prin. |
655 | 323 (cond |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
324 ((null object) (cust-print-internal-printer object)) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
325 ((consp object) (cust-print-list object)) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
326 ((vectorp object) (cust-print-vector object)) |
655 | 327 ;; All other types, just print. |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
328 (t (cust-print-internal-printer object)))) |
655 | 329 |
330 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
331 ;; Test object type and print accordingly. |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
332 (defun cust-print-custom-object (object) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
333 ;; Could be called as either cust-print-low-level-prin or cust-print-prin. |
655 | 334 (cond |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
335 ((null object) (cust-print-internal-printer object)) |
655 | 336 |
337 ((consp object) | |
338 (or (and custom-print-list | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
339 (cust-print-custom-object1 object custom-print-list)) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
340 (cust-print-list object))) |
655 | 341 |
342 ((vectorp object) | |
343 (or (and custom-print-vector | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
344 (cust-print-custom-object1 object custom-print-vector)) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
345 (cust-print-vector object))) |
655 | 346 |
347 ;; All other types, just print. | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
348 (t (cust-print-internal-printer object)))) |
655 | 349 |
350 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
351 ;; Helper for cust-print-custom-object. |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
352 ;; Print the custom OBJECT using the custom type ALIST. |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
353 ;; For the first predicate that matches the object, the corresponding |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
354 ;; converter is evaluated with the object and the string that results is |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
355 ;; printed with princ. Return nil if no predicte matches the object. |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
356 (defun cust-print-custom-object1 (object alist) |
655 | 357 (while (and alist (not (funcall (car (car alist)) object))) |
358 (setq alist (cdr alist))) | |
359 ;; If alist is not null, then something matched. | |
360 (if alist | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
361 (cust-print-internal-princ |
655 | 362 (funcall (cdr (car alist)) object) ; returns string |
363 ))) | |
364 | |
365 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
366 (defun cust-print-circular (object) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
367 "Printer for `prin1' and `princ' that handles circular structures. |
655 | 368 If OBJECT appears multiply, and has not yet been printed, |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
369 prefix with label; if it has been printed, use `#N#' instead. |
655 | 370 Otherwise, print normally." |
371 (let ((tag (assq object circle-table))) | |
372 (if tag | |
373 (let ((id (cdr tag))) | |
374 (if (> id 0) | |
375 (progn | |
376 ;; Already printed, so just print id. | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
377 (cust-print-internal-princ "#") |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
378 (cust-print-internal-princ id) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
379 (cust-print-internal-princ "#")) |
655 | 380 ;; Not printed yet, so label with id and print object. |
381 (setcdr tag (- id)) ; mark it as printed | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
382 (cust-print-internal-princ "#") |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
383 (cust-print-internal-princ (- id)) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
384 (cust-print-internal-princ "=") |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
385 (cust-print-low-level-prin object) |
655 | 386 )) |
387 ;; Not repeated in structure. | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
388 (cust-print-low-level-prin object)))) |
655 | 389 |
390 | |
391 ;;================================================ | |
392 ;; List and vector processing for print functions. | |
393 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
394 ;; Print a list using print-length, print-level, and print-circle. |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
395 (defun cust-print-list (list) |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
396 (if (= circle-level 0) |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
397 (cust-print-internal-princ "#") |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
398 (let ((circle-level (1- circle-level))) |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
399 (cust-print-internal-princ "(") |
655 | 400 (let ((length (or print-length 0))) |
401 | |
402 ;; Print the first element always (even if length = 0). | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
403 (cust-print-prin (car list)) |
655 | 404 (setq list (cdr list)) |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
405 (if list (cust-print-internal-princ " ")) |
655 | 406 (setq length (1- length)) |
407 | |
408 ;; Print the rest of the elements. | |
409 (while (and list (/= 0 length)) | |
410 (if (and (listp list) | |
411 (not (assq list circle-table))) | |
412 (progn | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
413 (cust-print-prin (car list)) |
655 | 414 (setq list (cdr list))) |
415 | |
416 ;; cdr is not a list, or it is in circle-table. | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
417 (cust-print-internal-princ ". ") |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
418 (cust-print-prin list) |
655 | 419 (setq list nil)) |
420 | |
421 (setq length (1- length)) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
422 (if list (cust-print-internal-princ " "))) |
655 | 423 |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
424 (if (and list (= length 0)) (cust-print-internal-princ "...")) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
425 (cust-print-internal-princ ")")))) |
655 | 426 list) |
427 | |
428 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
429 ;; Print a vector according to print-length, print-level, and print-circle. |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
430 (defun cust-print-vector (vector) |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
431 (if (= circle-level 0) |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
432 (cust-print-internal-princ "#") |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
433 (let ((circle-level (1- circle-level)) |
655 | 434 (i 0) |
435 (len (length vector))) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
436 (cust-print-internal-princ "[") |
655 | 437 |
438 (if print-length | |
439 (setq len (min print-length len))) | |
440 ;; Print the elements | |
441 (while (< i len) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
442 (cust-print-prin (aref vector i)) |
655 | 443 (setq i (1+ i)) |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
444 (if (< i (length vector)) (cust-print-internal-princ " "))) |
655 | 445 |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
446 (if (< i (length vector)) (cust-print-internal-princ "...")) |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
447 (cust-print-internal-princ "]") |
655 | 448 )) |
449 vector) | |
450 | |
451 | |
452 ;;================================== | |
453 ;; Circular structure preprocessing | |
454 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
455 (defun cust-print-preprocess-circle-tree (object) |
655 | 456 ;; Fill up the table. |
457 (let (;; Table of tags for each object in an object to be printed. | |
458 ;; A tag is of the form: | |
459 ;; ( <object> <nil-t-or-id-number> ) | |
460 ;; The id-number is generated after the entire table has been computed. | |
461 ;; During walk through, the real circle-table lives in the cdr so we | |
462 ;; can use setcdr to add new elements instead of having to setq the | |
463 ;; variable sometimes (poor man's locf). | |
464 (circle-table (list nil))) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
465 (cust-print-walk-circle-tree object) |
655 | 466 |
467 ;; Reverse table so it is in the order that the objects will be printed. | |
468 ;; This pass could be avoided if we always added to the end of the | |
469 ;; table with setcdr in walk-circle-tree. | |
470 (setcdr circle-table (nreverse (cdr circle-table))) | |
471 | |
472 ;; Walk through the table, assigning id-numbers to those | |
473 ;; objects which will be printed using #N= syntax. Delete those | |
474 ;; objects which will be printed only once (to speed up assq later). | |
475 (let ((rest circle-table) | |
476 (id -1)) | |
477 (while (cdr rest) | |
478 (let ((tag (car (cdr rest)))) | |
479 (cond ((cdr tag) | |
480 (setcdr tag id) | |
481 (setq id (1- id)) | |
482 (setq rest (cdr rest))) | |
483 ;; Else delete this object. | |
484 (t (setcdr rest (cdr (cdr rest)))))) | |
485 )) | |
486 ;; Drop the car. | |
487 (cdr circle-table) | |
488 )) | |
489 | |
490 | |
491 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
492 (defun cust-print-walk-circle-tree (object) |
655 | 493 (let (read-equivalent-p tag) |
494 (while object | |
495 (setq read-equivalent-p (or (numberp object) (symbolp object)) | |
496 tag (and (not read-equivalent-p) | |
497 (assq object (cdr circle-table)))) | |
498 (cond (tag | |
499 ;; Seen this object already, so note that. | |
500 (setcdr tag t)) | |
501 | |
502 ((not read-equivalent-p) | |
503 ;; Add a tag for this object. | |
504 (setcdr circle-table | |
505 (cons (list object) | |
506 (cdr circle-table))))) | |
507 (setq object | |
508 (cond | |
509 (tag ;; No need to descend since we have already. | |
510 nil) | |
511 | |
512 ((consp object) | |
513 ;; Walk the car of the list recursively. | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
514 (cust-print-walk-circle-tree (car object)) |
655 | 515 ;; But walk the cdr with the above while loop |
516 ;; to avoid problems with max-lisp-eval-depth. | |
517 ;; And it should be faster than recursion. | |
518 (cdr object)) | |
519 | |
520 ((vectorp object) | |
521 ;; Walk the vector. | |
522 (let ((i (length object)) | |
523 (j 0)) | |
524 (while (< j i) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
525 (cust-print-walk-circle-tree (aref object j)) |
655 | 526 (setq j (1+ j)))))))))) |
527 | |
528 | |
529 | |
530 ;;======================================= | |
531 | |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
532 ;; Example. |
655 | 533 |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
534 ;;;; Create some circular structures. |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
535 ;;(setq circ-sym (let ((x (make-symbol "FOO"))) (list x x))) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
536 ;;(setq circ-list (list 'a 'b (vector 1 2 3 4) 'd 'e 'f)) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
537 ;;(setcar (nthcdr 3 circ-list) circ-list) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
538 ;;(aset (nth 2 circ-list) 2 circ-list) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
539 ;;(setq dotted-circ-list (list 'a 'b 'c)) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
540 ;;(setcdr (cdr (cdr dotted-circ-list)) dotted-circ-list) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
541 ;;(setq circ-vector (vector 1 2 3 4 (list 'a 'b 'c 'd) 6 7)) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
542 ;;(aset circ-vector 5 (make-symbol "-gensym-")) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
543 ;;(setcar (cdr (aref circ-vector 4)) (aref circ-vector 5)) |
655 | 544 |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
545 ;;(install-custom-print-funcs) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
546 ;;;; (setq print-circle t) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
547 |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
548 ;;(let ((print-circle t)) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
549 ;; (or (equal (prin1-to-string circ-list) "#1=(a b [1 2 #1# 4] #1# e f)") |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
550 ;; (error "circular object with array printing"))) |
655 | 551 |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
552 ;;(let ((print-circle t)) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
553 ;; (or (equal (prin1-to-string dotted-circ-list) "#1=(a b c . #1#)") |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
554 ;; (error "circular object with array printing"))) |
655 | 555 |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
556 ;;(let* ((print-circle t) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
557 ;; (x (list 'p 'q)) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
558 ;; (y (list (list 'a 'b) x 'foo x))) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
559 ;; (setcdr (cdr (cdr (cdr y))) (cdr y)) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
560 ;; (or (equal (prin1-to-string y) "((a b) . #1=(#2=(p q) foo #2# . #1#))" |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
561 ;; ) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
562 ;; (error "circular list example from CL manual"))) |
655 | 563 |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
564 ;;;; There's no special handling of uninterned symbols in custom-print. |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
565 ;;(let ((print-circle nil)) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
566 ;; (or (equal (prin1-to-string circ-sym) "(#:FOO #:FOO)") |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
567 ;; (error "uninterned symbols in list"))) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
568 ;;(let ((print-circle t)) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
569 ;; (or (equal (prin1-to-string circ-sym) "(#1=FOO #1#)") |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
570 ;; (error "circular uninterned symbols in list"))) |
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
571 ;;(uninstall-custom-print-funcs) |
655 | 572 |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
573 ;;; cust-print.el ends here |