Mercurial > emacs
annotate lisp/emacs-lisp/cust-print.el @ 102929:6be674ea734e
* vc-dir.el (vc-dir): Dox fix.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 10 Apr 2009 14:19:12 +0000 |
parents | a9dc0e7c3f2b |
children | cbe885d14464 |
rev | line source |
---|---|
38436
b174db545cfd
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
30805
diff
changeset
|
1 ;;; cust-print.el --- handles print-level and print-circle |
655 | 2 |
74466 | 3 ;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005, |
100908 | 4 ;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. |
845 | 5 |
30805
3cfd3dc474b8
Change authors' mail address.
Gerd Moellmann <gerd@gnu.org>
parents:
26519
diff
changeset
|
6 ;; Author: Daniel LaLiberte <liberte@holonexus.org> |
807
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 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
10 ;; LCD Archive Entry: |
30805
3cfd3dc474b8
Change authors' mail address.
Gerd Moellmann <gerd@gnu.org>
parents:
26519
diff
changeset
|
11 ;; cust-print|Daniel LaLiberte|liberte@holonexus.org |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
12 ;; |Handle print-level, print-circle and more. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
13 |
655 | 14 ;; This file is part of GNU Emacs. |
15 | |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
16 ;; GNU Emacs is free software: you can redistribute it and/or modify |
655 | 17 ;; it under the terms of the GNU General Public License as published by |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
18 ;; the Free Software Foundation, either version 3 of the License, or |
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
19 ;; (at your option) any later version. |
655 | 20 |
21 ;; GNU Emacs is distributed in the hope that it will be useful, | |
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
24 ;; GNU General Public License for more details. | |
25 | |
26 ;; You should have received a copy of the GNU General Public License | |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
27 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
655 | 28 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
655
diff
changeset
|
29 ;;; Commentary: |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
655
diff
changeset
|
30 |
655 | 31 ;; This package provides a general print handler for prin1 and princ |
32 ;; that supports print-level and print-circle, and by the way, | |
33 ;; print-length since the standard routines are being replaced. Also, | |
34 ;; to print custom types constructed from lists and vectors, use | |
35 ;; custom-print-list and custom-print-vector. See the documentation | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
36 ;; strings of these variables for more details. |
655 | 37 |
38 ;; If the results of your expressions contain circular references to | |
39 ;; other parts of the same structure, the standard Emacs print | |
40 ;; subroutines may fail to print with an untrappable error, | |
41 ;; "Apparently circular structure being printed". If you only use cdr | |
42 ;; circular lists (where cdrs of lists point back; what is the right | |
43 ;; term here?), you can limit the length of printing with | |
44 ;; print-length. But car circular lists and circular vectors generate | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
45 ;; the above mentioned error in Emacs version 18. Version |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
46 ;; 19 supports print-level, but it is often useful to get a better |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
47 ;; print representation of circular and shared structures; the print-circle |
655 | 48 ;; option may be used to print more concise representations. |
49 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
50 ;; There are three main ways to use this package. First, you may |
655 | 51 ;; replace prin1, princ, and some subroutines that use them by calling |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
52 ;; install-custom-print so that any use of these functions in |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
53 ;; Lisp code will be affected; you can later reset with |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
54 ;; uninstall-custom-print. Second, you may temporarily install |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
55 ;; these functions with the macro with-custom-print. Third, you |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
56 ;; could call the custom routines directly, thus only affecting the |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
57 ;; printing that requires them. |
655 | 58 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
59 ;; Note that subroutines which call print subroutines directly will |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
60 ;; not use the custom print functions. In particular, the evaluation |
655 | 61 ;; functions like eval-region call the print subroutines directly. |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
62 ;; Therefore, if you evaluate (aref circ-list 0), where circ-list is a |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
63 ;; circular list rather than an array, aref calls error directly which |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
64 ;; will jump to the top level instead of printing the circular list. |
655 | 65 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
66 ;; Uninterned symbols are recognized when print-circle is non-nil, |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
67 ;; but they are not printed specially here. Use the cl-packages package |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
68 ;; to print according to print-gensym. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
69 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
70 ;; Obviously the right way to implement this custom-print facility is |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
71 ;; in C or with hooks into the standard printer. Please volunteer |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
72 ;; since I don't have the time or need. More CL-like printing |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
73 ;; capabilities could be added in the future. |
655 | 74 |
75 ;; Implementation design: we want to use the same list and vector | |
76 ;; processing algorithm for all versions of prin1 and princ, since how | |
77 ;; the processing is done depends on print-length, print-level, and | |
78 ;; print-circle. For circle printing, a preprocessing step is | |
79 ;; required before the final printing. Thanks to Jamie Zawinski | |
80 ;; for motivation and algorithms. | |
81 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
82 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
83 ;;; Code: |
26519 | 84 |
85 (defgroup cust-print nil | |
86 "Handles print-level and print-circle." | |
87 :prefix "print-" | |
88 :group 'lisp | |
89 :group 'extensions) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
90 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
91 ;; If using cl-packages: |
655 | 92 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
93 '(defpackage "cust-print" |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
94 (:nicknames "CP" "custom-print") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
95 (:use "el") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
96 (:export |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
97 print-level |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
98 print-circle |
655 | 99 |
6687
30c38858c0d0
Change install- and uninstall- to -install and -uninstall.
Daniel LaLiberte <liberte@gnu.org>
parents:
6511
diff
changeset
|
100 custom-print-install |
30c38858c0d0
Change install- and uninstall- to -install and -uninstall.
Daniel LaLiberte <liberte@gnu.org>
parents:
6511
diff
changeset
|
101 custom-print-uninstall |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
102 custom-print-installed-p |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
103 with-custom-print |
655 | 104 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
105 custom-prin1 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
106 custom-princ |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
107 custom-prin1-to-string |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
108 custom-print |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
109 custom-format |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
110 custom-message |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
111 custom-error |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
112 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
113 custom-printers |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
114 add-custom-printer |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
115 )) |
655 | 116 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
117 '(in-package cust-print) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
118 |
26519 | 119 ;; Emacs 18 doesn't have defalias. |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
120 ;; Provide def for byte compiler. |
6779
baefeadae7a3
Jumping up to new revision.
Daniel LaLiberte <liberte@gnu.org>
parents:
6687
diff
changeset
|
121 (eval-and-compile |
baefeadae7a3
Jumping up to new revision.
Daniel LaLiberte <liberte@gnu.org>
parents:
6687
diff
changeset
|
122 (or (fboundp 'defalias) (fset 'defalias 'fset))) |
655 | 123 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
124 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
125 ;; Variables: |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
126 ;;========================================================= |
655 | 127 |
128 ;;(defvar print-length nil | |
129 ;; "*Controls how many elements of a list, at each level, are printed. | |
130 ;;This is defined by emacs.") | |
131 | |
26519 | 132 (defcustom print-level nil |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
133 "*Controls how many levels deep a nested data object will print. |
655 | 134 |
135 If nil, printing proceeds recursively and may lead to | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
136 max-lisp-eval-depth being exceeded or an error may occur: |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
137 `Apparently circular structure being printed.' |
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
138 Also see `print-length' and `print-circle'. |
655 | 139 |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
140 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
|
141 are printed simply as `#'. The object to be printed is at level 0, |
655 | 142 and if the object is a list or vector, its top-level components are at |
26519 | 143 level 1." |
144 :type '(choice (const nil) integer) | |
145 :group 'cust-print) | |
655 | 146 |
147 | |
26519 | 148 (defcustom print-circle nil |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
149 "*Controls the printing of recursive structures. |
655 | 150 |
151 If nil, printing proceeds recursively and may lead to | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
152 `max-lisp-eval-depth' being exceeded or an error may occur: |
655 | 153 \"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
|
154 `print-length' and `print-level'. |
655 | 155 |
156 If non-nil, shared substructures anywhere in the structure are printed | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
2571
diff
changeset
|
157 with `#N=' before the first occurrence (in the order of the print |
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
2571
diff
changeset
|
158 representation) and `#N#' in place of each subsequent occurrence, |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
159 where N is a positive decimal integer. |
655 | 160 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
161 There is no way to read this representation in standard Emacs, |
26519 | 162 but if you need to do so, try the cl-read.el package." |
163 :type 'boolean | |
164 :group 'cust-print) | |
655 | 165 |
166 | |
26519 | 167 (defcustom custom-print-vectors nil |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
168 "*Non-nil if printing of vectors should obey print-level and print-length. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
169 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
170 For Emacs 18, setting print-level, or adding custom print list or |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
171 vector handling will make this happen anyway. Emacs 19 obeys |
26519 | 172 print-level, but not for vectors." |
173 :type 'boolean | |
174 :group 'cust-print) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
175 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
176 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
177 ;; Custom printers |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
178 ;;========================================================== |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
179 |
58386
82bca611f221
(custom-printers): Use `defvar' instead of `defconst'.
Luc Teirlinck <teirllm@auburn.edu>
parents:
52401
diff
changeset
|
180 (defvar custom-printers nil |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
181 ;; e.g. '((symbolp . pkg::print-symbol)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
182 "An alist for custom printing of any type. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
183 Pairs are of the form (PREDICATE . PRINTER). If PREDICATE is true |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
184 for an object, then PRINTER is called with the object. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
185 PRINTER should print to `standard-output' using cust-print-original-princ |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
186 if the standard printer is sufficient, or cust-print-prin for complex things. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
187 The PRINTER should return the object being printed. |
655 | 188 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
189 Don't modify this variable directly. Use `add-custom-printer' and |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
190 `delete-custom-printer'") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
191 ;; Should cust-print-original-princ and cust-print-prin be exported symbols? |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
192 ;; Or should the standard printers functions be replaced by |
26519 | 193 ;; CP ones in Emacs Lisp so that CP internal functions need not be called? |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
194 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
195 (defun add-custom-printer (pred printer) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
196 "Add a pair of PREDICATE and PRINTER to `custom-printers'. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
197 Any pair that has the same PREDICATE is first removed." |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
198 (setq custom-printers (cons (cons pred printer) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
199 (delq (assq pred custom-printers) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
200 custom-printers))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
201 ;; Rather than updating here, we could wait until cust-print-top-level is called. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
202 (cust-print-update-custom-printers)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
203 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
204 (defun delete-custom-printer (pred) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
205 "Delete the custom printer associated with PREDICATE." |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
206 (setq custom-printers (delq (assq pred custom-printers) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
207 custom-printers)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
208 (cust-print-update-custom-printers)) |
655 | 209 |
210 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
211 (defun cust-print-use-custom-printer (object) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
212 ;; Default function returns nil. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
213 nil) |
655 | 214 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
215 (defun cust-print-update-custom-printers () |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
216 ;; Modify the definition of cust-print-use-custom-printer |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
217 (defalias 'cust-print-use-custom-printer |
26519 | 218 ;; We don't really want to require the byte-compiler. |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
219 ;; (byte-compile |
26519 | 220 `(lambda (object) |
221 (cond | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
222 ,@(mapcar (function |
26519 | 223 (lambda (pair) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
224 `((,(car pair) object) |
26519 | 225 (,(cdr pair) object)))) |
226 custom-printers) | |
227 ;; Otherwise return nil. | |
228 (t nil) | |
229 )) | |
230 ;; ) | |
231 )) | |
655 | 232 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
233 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
234 ;; Saving and restoring emacs printing routines. |
655 | 235 ;;==================================================== |
236 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
237 (defun cust-print-set-function-cell (symbol-pair) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
238 (defalias (car symbol-pair) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
239 (symbol-function (car (cdr symbol-pair))))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
240 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
241 (defun cust-print-original-princ (object &optional stream)) ; dummy def |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
242 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
243 ;; Save emacs routines. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
244 (if (not (fboundp 'cust-print-original-prin1)) |
84895
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
245 (mapc 'cust-print-set-function-cell |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
246 '((cust-print-original-prin1 prin1) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
247 (cust-print-original-princ princ) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
248 (cust-print-original-print print) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
249 (cust-print-original-prin1-to-string prin1-to-string) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
250 (cust-print-original-format format) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
251 (cust-print-original-message message) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
252 (cust-print-original-error error)))) |
655 | 253 |
254 | |
6687
30c38858c0d0
Change install- and uninstall- to -install and -uninstall.
Daniel LaLiberte <liberte@gnu.org>
parents:
6511
diff
changeset
|
255 (defun custom-print-install () |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
256 "Replace print functions with general, customizable, Lisp versions. |
73747
59cd5ef2f5f0
(custom-print-install, custom-print-uninstall, custom-format):
Juanma Barranquero <lekktu@gmail.com>
parents:
68648
diff
changeset
|
257 The Emacs subroutines are saved away, and you can reinstall them |
6687
30c38858c0d0
Change install- and uninstall- to -install and -uninstall.
Daniel LaLiberte <liberte@gnu.org>
parents:
6511
diff
changeset
|
258 by running `custom-print-uninstall'." |
655 | 259 (interactive) |
84895
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
260 (mapc 'cust-print-set-function-cell |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
261 '((prin1 custom-prin1) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
262 (princ custom-princ) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
263 (print custom-print) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
264 (prin1-to-string custom-prin1-to-string) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
265 (format custom-format) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
266 (message custom-message) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
267 (error custom-error) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
268 )) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
269 t) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
270 |
6687
30c38858c0d0
Change install- and uninstall- to -install and -uninstall.
Daniel LaLiberte <liberte@gnu.org>
parents:
6511
diff
changeset
|
271 (defun custom-print-uninstall () |
73747
59cd5ef2f5f0
(custom-print-install, custom-print-uninstall, custom-format):
Juanma Barranquero <lekktu@gmail.com>
parents:
68648
diff
changeset
|
272 "Reset print functions to their Emacs subroutines." |
655 | 273 (interactive) |
84895
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
274 (mapc 'cust-print-set-function-cell |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
275 '((prin1 cust-print-original-prin1) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
276 (princ cust-print-original-princ) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
277 (print cust-print-original-print) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
278 (prin1-to-string cust-print-original-prin1-to-string) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
279 (format cust-print-original-format) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
280 (message cust-print-original-message) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
281 (error cust-print-original-error) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
282 )) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
283 t) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
284 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
285 (defalias 'custom-print-funcs-installed-p 'custom-print-installed-p) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
286 (defun custom-print-installed-p () |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
287 "Return t if custom-print is currently installed, nil otherwise." |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
288 (eq (symbol-function 'custom-prin1) (symbol-function 'prin1))) |
655 | 289 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
290 (put 'with-custom-print-funcs 'edebug-form-spec '(body)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
291 (put 'with-custom-print 'edebug-form-spec '(body)) |
655 | 292 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
293 (defalias 'with-custom-print-funcs 'with-custom-print) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
294 (defmacro with-custom-print (&rest body) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
295 "Temporarily install the custom print package while executing BODY." |
26519 | 296 `(unwind-protect |
297 (progn | |
298 (custom-print-install) | |
299 ,@body) | |
300 (custom-print-uninstall))) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
301 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
302 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
303 ;; Lisp replacements for prin1 and princ, and for some subrs that use them |
655 | 304 ;;=============================================================== |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
305 ;; - so far only the printing and formatting subrs. |
655 | 306 |
307 (defun custom-prin1 (object &optional stream) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
308 "Output the printed representation of OBJECT, any Lisp object. |
655 | 309 Quoting characters are printed when needed to make output that `read' |
310 can handle, whenever this is possible. | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
311 Output stream is STREAM, or value of `standard-output' (which see). |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
312 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
313 This is the custom-print replacement for the standard `prin1'. It |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
314 uses the appropriate printer depending on the values of `print-level' |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
315 and `print-circle' (which see)." |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
316 (cust-print-top-level object stream 'cust-print-original-prin1)) |
655 | 317 |
318 | |
319 (defun custom-princ (object &optional stream) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
320 "Output the printed representation of OBJECT, any Lisp object. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
321 No quoting characters are used; no delimiters are printed around |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
322 the contents of strings. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
323 Output stream is STREAM, or value of `standard-output' (which see). |
655 | 324 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
325 This is the custom-print replacement for the standard `princ'." |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
326 (cust-print-top-level object stream 'cust-print-original-princ)) |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
327 |
655 | 328 |
26519 | 329 (defun custom-prin1-to-string (object &optional noescape) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
330 "Return a string containing the printed representation of OBJECT, |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
331 any Lisp object. Quoting characters are used when needed to make output |
26519 | 332 that `read' can handle, whenever this is possible, unless the optional |
333 second argument NOESCAPE is non-nil. | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
334 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
335 This is the custom-print replacement for the standard `prin1-to-string'." |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
336 (let ((buf (get-buffer-create " *custom-print-temp*"))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
337 ;; We must erase the buffer before printing in case an error |
26519 | 338 ;; occurred during the last prin1-to-string and we are in debugger. |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
339 (save-excursion |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
340 (set-buffer buf) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
341 (erase-buffer)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
342 ;; We must be in the current-buffer when the print occurs. |
26519 | 343 (if noescape |
344 (custom-princ object buf) | |
345 (custom-prin1 object buf)) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
346 (save-excursion |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
347 (set-buffer buf) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
348 (buffer-string) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
349 ;; We could erase the buffer again, but why bother? |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
350 ))) |
655 | 351 |
352 | |
353 (defun custom-print (object &optional stream) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
354 "Output the printed representation of OBJECT, with newlines around it. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
355 Quoting characters are printed when needed to make output that `read' |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
356 can handle, whenever this is possible. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
357 Output stream is STREAM, or value of `standard-output' (which see). |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
358 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
359 This is the custom-print replacement for the standard `print'." |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
360 (cust-print-original-princ "\n" stream) |
655 | 361 (custom-prin1 object stream) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
362 (cust-print-original-princ "\n" stream)) |
655 | 363 |
364 | |
365 (defun custom-format (fmt &rest args) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
366 "Format a string out of a control-string and arguments. |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
367 The first argument is a control string. It, and subsequent arguments |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
368 substituted into it, become the value, which is a string. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
369 It may contain %s or %d or %c to substitute successive following arguments. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
370 %s means print an argument as a string, %d means print as number in decimal, |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
371 %c means print a number as a single character. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
372 The argument used by %s must be a string or a symbol; |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
373 the argument used by %d, %b, %o, %x or %c must be a number. |
655 | 374 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
375 This is the custom-print replacement for the standard `format'. It |
73747
59cd5ef2f5f0
(custom-print-install, custom-print-uninstall, custom-format):
Juanma Barranquero <lekktu@gmail.com>
parents:
68648
diff
changeset
|
376 calls the Emacs `format' after first making strings for list, |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
377 vector, or symbol args. The format specification for such args should |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
378 be `%s' in any case, so a string argument will also work. The string |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
379 is generated with `custom-prin1-to-string', which quotes quotable |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
380 characters." |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
381 (apply 'cust-print-original-format fmt |
655 | 382 (mapcar (function (lambda (arg) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
383 (if (or (listp arg) (vectorp arg) (symbolp arg)) |
655 | 384 (custom-prin1-to-string arg) |
385 arg))) | |
386 args))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
387 |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
388 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
389 (defun custom-message (fmt &rest args) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
390 "Print a one-line message at the bottom of the screen. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
391 The first argument is a control string. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
392 It may contain %s or %d or %c to print successive following arguments. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
393 %s means print an argument as a string, %d means print as number in decimal, |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
394 %c means print a number as a single character. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
395 The argument used by %s must be a string or a symbol; |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
396 the argument used by %d or %c must be a number. |
655 | 397 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
398 This is the custom-print replacement for the standard `message'. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
399 See `custom-format' for the details." |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
400 ;; It doesn't work to princ the result of custom-format as in: |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
401 ;; (cust-print-original-princ (apply 'custom-format fmt args)) |
655 | 402 ;; because the echo area requires special handling |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
403 ;; to avoid duplicating the output. |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
404 ;; cust-print-original-message does it right. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
405 (apply 'cust-print-original-message fmt |
655 | 406 (mapcar (function (lambda (arg) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
407 (if (or (listp arg) (vectorp arg) (symbolp arg)) |
655 | 408 (custom-prin1-to-string arg) |
409 arg))) | |
410 args))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
411 |
655 | 412 |
413 (defun custom-error (fmt &rest args) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
414 "Signal an error, making error message by passing all args to `format'. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
415 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
416 This is the custom-print replacement for the standard `error'. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
417 See `custom-format' for the details." |
655 | 418 (signal 'error (list (apply 'custom-format fmt args)))) |
419 | |
420 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
421 |
655 | 422 ;; Support for custom prin1 and princ |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
423 ;;========================================= |
655 | 424 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
425 ;; Defs to quiet byte-compiler. |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
426 (defvar circle-table) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
427 (defvar cust-print-current-level) |
1366
ebf903dc2d70
(custom-prin1-chars): Var defined, and renamed from prin1-chars.
Richard M. Stallman <rms@gnu.org>
parents:
1359
diff
changeset
|
428 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
429 (defun cust-print-original-printer (object)) ; One of the standard printers. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
430 (defun cust-print-low-level-prin (object)) ; Used internally. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
431 (defun cust-print-prin (object)) ; Call this to print recursively. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
432 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
433 (defun cust-print-top-level (object stream emacs-printer) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
434 ;; Set up for printing. |
655 | 435 (let ((standard-output (or stream standard-output)) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
436 ;; circle-table will be non-nil if anything is circular. |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
437 (circle-table (and print-circle |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
438 (cust-print-preprocess-circle-tree object))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
439 (cust-print-current-level (or print-level -1))) |
655 | 440 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
441 (defalias 'cust-print-original-printer emacs-printer) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
442 (defalias 'cust-print-low-level-prin |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
443 (cond |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
444 ((or custom-printers |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
445 circle-table |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
446 print-level ; comment out for version 19 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
447 ;; Emacs doesn't use print-level or print-length |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
448 ;; for vectors, but custom-print can. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
449 (if custom-print-vectors |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
450 (or print-level print-length))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
451 'cust-print-print-object) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
452 (t 'cust-print-original-printer))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
453 (defalias 'cust-print-prin |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
454 (if circle-table 'cust-print-print-circular 'cust-print-low-level-prin)) |
655 | 455 |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
456 (cust-print-prin object) |
655 | 457 object)) |
458 | |
459 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
460 (defun cust-print-print-object (object) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
461 ;; Test object type and print accordingly. |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
462 ;; Could be called as either cust-print-low-level-prin or cust-print-prin. |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
463 (cond |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
464 ((null object) (cust-print-original-printer object)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
465 ((cust-print-use-custom-printer object) object) |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
466 ((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
|
467 ((vectorp object) (cust-print-vector object)) |
655 | 468 ;; All other types, just print. |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
469 (t (cust-print-original-printer object)))) |
655 | 470 |
471 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
472 (defun cust-print-print-circular (object) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
473 ;; Printer for `prin1' and `princ' that handles circular structures. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
474 ;; If OBJECT appears multiply, and has not yet been printed, |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
475 ;; prefix with label; if it has been printed, use `#N#' instead. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
476 ;; Otherwise, print normally. |
655 | 477 (let ((tag (assq object circle-table))) |
478 (if tag | |
479 (let ((id (cdr tag))) | |
480 (if (> id 0) | |
481 (progn | |
482 ;; Already printed, so just print id. | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
483 (cust-print-original-princ "#") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
484 (cust-print-original-princ id) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
485 (cust-print-original-princ "#")) |
655 | 486 ;; Not printed yet, so label with id and print object. |
487 (setcdr tag (- id)) ; mark it as printed | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
488 (cust-print-original-princ "#") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
489 (cust-print-original-princ (- id)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
490 (cust-print-original-princ "=") |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
491 (cust-print-low-level-prin object) |
655 | 492 )) |
493 ;; Not repeated in structure. | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
494 (cust-print-low-level-prin object)))) |
655 | 495 |
496 | |
497 ;;================================================ | |
498 ;; List and vector processing for print functions. | |
499 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
500 (defun cust-print-list (list) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
501 ;; Print a list using print-length, print-level, and print-circle. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
502 (if (= cust-print-current-level 0) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
503 (cust-print-original-princ "#") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
504 (let ((cust-print-current-level (1- cust-print-current-level))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
505 (cust-print-original-princ "(") |
655 | 506 (let ((length (or print-length 0))) |
507 | |
508 ;; 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
|
509 (cust-print-prin (car list)) |
655 | 510 (setq list (cdr list)) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
511 (if list (cust-print-original-princ " ")) |
655 | 512 (setq length (1- length)) |
513 | |
514 ;; Print the rest of the elements. | |
515 (while (and list (/= 0 length)) | |
516 (if (and (listp list) | |
517 (not (assq list circle-table))) | |
518 (progn | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
519 (cust-print-prin (car list)) |
655 | 520 (setq list (cdr list))) |
521 | |
522 ;; cdr is not a list, or it is in circle-table. | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
523 (cust-print-original-princ ". ") |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
524 (cust-print-prin list) |
655 | 525 (setq list nil)) |
526 | |
527 (setq length (1- length)) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
528 (if list (cust-print-original-princ " "))) |
655 | 529 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
530 (if (and list (= length 0)) (cust-print-original-princ "...")) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
531 (cust-print-original-princ ")")))) |
655 | 532 list) |
533 | |
534 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
535 (defun cust-print-vector (vector) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
536 ;; Print a vector according to print-length, print-level, and print-circle. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
537 (if (= cust-print-current-level 0) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
538 (cust-print-original-princ "#") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
539 (let ((cust-print-current-level (1- cust-print-current-level)) |
655 | 540 (i 0) |
541 (len (length vector))) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
542 (cust-print-original-princ "[") |
655 | 543 |
544 (if print-length | |
545 (setq len (min print-length len))) | |
546 ;; Print the elements | |
547 (while (< i len) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
548 (cust-print-prin (aref vector i)) |
655 | 549 (setq i (1+ i)) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
550 (if (< i (length vector)) (cust-print-original-princ " "))) |
655 | 551 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
552 (if (< i (length vector)) (cust-print-original-princ "...")) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
553 (cust-print-original-princ "]") |
655 | 554 )) |
555 vector) | |
556 | |
557 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
558 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
559 ;; Circular structure preprocessing |
655 | 560 ;;================================== |
561 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
562 (defun cust-print-preprocess-circle-tree (object) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
563 ;; Fill up the table. |
655 | 564 (let (;; Table of tags for each object in an object to be printed. |
565 ;; A tag is of the form: | |
566 ;; ( <object> <nil-t-or-id-number> ) | |
567 ;; The id-number is generated after the entire table has been computed. | |
568 ;; During walk through, the real circle-table lives in the cdr so we | |
569 ;; can use setcdr to add new elements instead of having to setq the | |
570 ;; variable sometimes (poor man's locf). | |
571 (circle-table (list nil))) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
572 (cust-print-walk-circle-tree object) |
655 | 573 |
574 ;; Reverse table so it is in the order that the objects will be printed. | |
575 ;; This pass could be avoided if we always added to the end of the | |
576 ;; table with setcdr in walk-circle-tree. | |
577 (setcdr circle-table (nreverse (cdr circle-table))) | |
578 | |
579 ;; Walk through the table, assigning id-numbers to those | |
580 ;; objects which will be printed using #N= syntax. Delete those | |
581 ;; objects which will be printed only once (to speed up assq later). | |
582 (let ((rest circle-table) | |
583 (id -1)) | |
584 (while (cdr rest) | |
585 (let ((tag (car (cdr rest)))) | |
586 (cond ((cdr tag) | |
587 (setcdr tag id) | |
588 (setq id (1- id)) | |
589 (setq rest (cdr rest))) | |
590 ;; Else delete this object. | |
591 (t (setcdr rest (cdr (cdr rest)))))) | |
592 )) | |
593 ;; Drop the car. | |
594 (cdr circle-table) | |
595 )) | |
596 | |
597 | |
598 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
599 (defun cust-print-walk-circle-tree (object) |
655 | 600 (let (read-equivalent-p tag) |
601 (while object | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
602 (setq read-equivalent-p |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
603 (or (numberp object) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
604 (and (symbolp object) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
605 ;; Check if it is uninterned. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
606 (eq object (intern-soft (symbol-name object))))) |
655 | 607 tag (and (not read-equivalent-p) |
608 (assq object (cdr circle-table)))) | |
609 (cond (tag | |
610 ;; Seen this object already, so note that. | |
611 (setcdr tag t)) | |
612 | |
613 ((not read-equivalent-p) | |
614 ;; Add a tag for this object. | |
615 (setcdr circle-table | |
616 (cons (list object) | |
617 (cdr circle-table))))) | |
618 (setq object | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
619 (cond |
655 | 620 (tag ;; No need to descend since we have already. |
621 nil) | |
622 | |
623 ((consp object) | |
624 ;; 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
|
625 (cust-print-walk-circle-tree (car object)) |
655 | 626 ;; But walk the cdr with the above while loop |
627 ;; to avoid problems with max-lisp-eval-depth. | |
628 ;; And it should be faster than recursion. | |
629 (cdr object)) | |
630 | |
631 ((vectorp object) | |
632 ;; Walk the vector. | |
633 (let ((i (length object)) | |
634 (j 0)) | |
635 (while (< j i) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
636 (cust-print-walk-circle-tree (aref object j)) |
655 | 637 (setq j (1+ j)))))))))) |
638 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
639 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
640 ;; Example. |
655 | 641 ;;======================================= |
642 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
643 '(progn |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
644 (progn |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
645 ;; Create some circular structures. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
646 (setq circ-sym (let ((x (make-symbol "FOO"))) (list x x))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
647 (setq circ-list (list 'a 'b (vector 1 2 3 4) 'd 'e 'f)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
648 (setcar (nthcdr 3 circ-list) circ-list) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
649 (aset (nth 2 circ-list) 2 circ-list) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
650 (setq dotted-circ-list (list 'a 'b 'c)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
651 (setcdr (cdr (cdr dotted-circ-list)) dotted-circ-list) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
652 (setq circ-vector (vector 1 2 3 4 (list 'a 'b 'c 'd) 6 7)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
653 (aset circ-vector 5 (make-symbol "-gensym-")) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
654 (setcar (cdr (aref circ-vector 4)) (aref circ-vector 5)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
655 nil) |
655 | 656 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
657 (install-custom-print) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
658 ;; (setq print-circle t) |
655 | 659 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
660 (let ((print-circle t)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
661 (or (equal (prin1-to-string circ-list) "#1=(a b [1 2 #1# 4] #1# e f)") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
662 (error "circular object with array printing"))) |
655 | 663 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
664 (let ((print-circle t)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
665 (or (equal (prin1-to-string dotted-circ-list) "#1=(a b c . #1#)") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
666 (error "circular object with array printing"))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
667 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
668 (let* ((print-circle t) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
669 (x (list 'p 'q)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
670 (y (list (list 'a 'b) x 'foo x))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
671 (setcdr (cdr (cdr (cdr y))) (cdr y)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
672 (or (equal (prin1-to-string y) "((a b) . #1=(#2=(p q) foo #2# . #1#))" |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
673 ) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
674 (error "circular list example from CL manual"))) |
655 | 675 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
676 (let ((print-circle nil)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
677 ;; cl-packages.el is required to print uninterned symbols like #:FOO. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
678 ;; (require 'cl-packages) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
679 (or (equal (prin1-to-string circ-sym) "(#:FOO #:FOO)") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
680 (error "uninterned symbols in list"))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
681 (let ((print-circle t)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
682 (or (equal (prin1-to-string circ-sym) "(#1=FOO #1#)") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
683 (error "circular uninterned symbols in list"))) |
655 | 684 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
685 (uninstall-custom-print) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
686 ) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
687 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
688 (provide 'cust-print) |
655 | 689 |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
690 ;; arch-tag: 3a5a8650-622c-48c4-87d8-e01bf72ec580 |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
691 ;;; cust-print.el ends here |