Mercurial > emacs
annotate lisp/emacs-lisp/cust-print.el @ 107168:282ddc0ca465
* simple.el (save-interprogram-paste-before-kill): Doc fix.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Tue, 16 Feb 2010 09:40:45 -0500 |
parents | 1d1d5d9bd884 |
children | 376148b31b5e |
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 |
103995
cbe885d14464
Remove leading * from defcustom docs.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
3 ;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, |
106815 | 4 ;; 2009, 2010 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 |
103995
cbe885d14464
Remove leading * from defcustom docs.
Glenn Morris <rgm@gnu.org>
parents:
100908
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 |
103995
cbe885d14464
Remove leading * from defcustom docs.
Glenn Morris <rgm@gnu.org>
parents:
100908
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 |
103995
cbe885d14464
Remove leading * from defcustom docs.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
168 "Non-nil if printing of vectors should obey `print-level' and `print-length'." |
26519 | 169 :type 'boolean |
170 :group 'cust-print) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
171 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
172 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
173 ;; Custom printers |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
174 ;;========================================================== |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
175 |
58386
82bca611f221
(custom-printers): Use `defvar' instead of `defconst'.
Luc Teirlinck <teirllm@auburn.edu>
parents:
52401
diff
changeset
|
176 (defvar custom-printers nil |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
177 ;; e.g. '((symbolp . pkg::print-symbol)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
178 "An alist for custom printing of any type. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
179 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
|
180 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
|
181 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
|
182 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
|
183 The PRINTER should return the object being printed. |
655 | 184 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
185 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
|
186 `delete-custom-printer'") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
187 ;; 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
|
188 ;; Or should the standard printers functions be replaced by |
26519 | 189 ;; 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
|
190 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
191 (defun add-custom-printer (pred printer) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
192 "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
|
193 Any pair that has the same PREDICATE is first removed." |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
194 (setq custom-printers (cons (cons pred printer) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
195 (delq (assq pred custom-printers) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
196 custom-printers))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
197 ;; 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
|
198 (cust-print-update-custom-printers)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
199 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
200 (defun delete-custom-printer (pred) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
201 "Delete the custom printer associated with PREDICATE." |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
202 (setq custom-printers (delq (assq pred custom-printers) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
203 custom-printers)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
204 (cust-print-update-custom-printers)) |
655 | 205 |
206 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
207 (defun cust-print-use-custom-printer (object) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
208 ;; Default function returns nil. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
209 nil) |
655 | 210 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
211 (defun cust-print-update-custom-printers () |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
212 ;; Modify the definition of cust-print-use-custom-printer |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
213 (defalias 'cust-print-use-custom-printer |
26519 | 214 ;; 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
|
215 ;; (byte-compile |
26519 | 216 `(lambda (object) |
217 (cond | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
218 ,@(mapcar (function |
26519 | 219 (lambda (pair) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
220 `((,(car pair) object) |
26519 | 221 (,(cdr pair) object)))) |
222 custom-printers) | |
223 ;; Otherwise return nil. | |
224 (t nil) | |
225 )) | |
226 ;; ) | |
227 )) | |
655 | 228 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
229 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
230 ;; Saving and restoring emacs printing routines. |
655 | 231 ;;==================================================== |
232 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
233 (defun cust-print-set-function-cell (symbol-pair) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
234 (defalias (car symbol-pair) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
235 (symbol-function (car (cdr symbol-pair))))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
236 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
237 (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
|
238 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
239 ;; Save emacs routines. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
240 (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
|
241 (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
|
242 '((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
|
243 (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
|
244 (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
|
245 (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
|
246 (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
|
247 (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
|
248 (cust-print-original-error error)))) |
655 | 249 |
250 | |
6687
30c38858c0d0
Change install- and uninstall- to -install and -uninstall.
Daniel LaLiberte <liberte@gnu.org>
parents:
6511
diff
changeset
|
251 (defun custom-print-install () |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
252 "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
|
253 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
|
254 by running `custom-print-uninstall'." |
655 | 255 (interactive) |
84895
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
256 (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
|
257 '((prin1 custom-prin1) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
258 (princ custom-princ) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
259 (print custom-print) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
260 (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
|
261 (format custom-format) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
262 (message custom-message) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
263 (error custom-error) |
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
264 )) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
265 t) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
266 |
6687
30c38858c0d0
Change install- and uninstall- to -install and -uninstall.
Daniel LaLiberte <liberte@gnu.org>
parents:
6511
diff
changeset
|
267 (defun custom-print-uninstall () |
73747
59cd5ef2f5f0
(custom-print-install, custom-print-uninstall, custom-format):
Juanma Barranquero <lekktu@gmail.com>
parents:
68648
diff
changeset
|
268 "Reset print functions to their Emacs subroutines." |
655 | 269 (interactive) |
84895
84fe291aadf6
(custom-print-install, custom-print-uninstall): Use `mapc' rather than `mapcar'.
Juanma Barranquero <lekktu@gmail.com>
parents:
78217
diff
changeset
|
270 (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
|
271 '((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
|
272 (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
|
273 (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
|
274 (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
|
275 (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
|
276 (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
|
277 (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
|
278 )) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
279 t) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
280 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
281 (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
|
282 (defun custom-print-installed-p () |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
283 "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
|
284 (eq (symbol-function 'custom-prin1) (symbol-function 'prin1))) |
655 | 285 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
286 (put 'with-custom-print-funcs 'edebug-form-spec '(body)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
287 (put 'with-custom-print 'edebug-form-spec '(body)) |
655 | 288 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
289 (defalias 'with-custom-print-funcs 'with-custom-print) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
290 (defmacro with-custom-print (&rest body) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
291 "Temporarily install the custom print package while executing BODY." |
26519 | 292 `(unwind-protect |
293 (progn | |
294 (custom-print-install) | |
295 ,@body) | |
296 (custom-print-uninstall))) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
297 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
298 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
299 ;; Lisp replacements for prin1 and princ, and for some subrs that use them |
655 | 300 ;;=============================================================== |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
301 ;; - so far only the printing and formatting subrs. |
655 | 302 |
303 (defun custom-prin1 (object &optional stream) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
304 "Output the printed representation of OBJECT, any Lisp object. |
655 | 305 Quoting characters are printed when needed to make output that `read' |
306 can handle, whenever this is possible. | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
307 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
|
308 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
309 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
|
310 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
|
311 and `print-circle' (which see)." |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
312 (cust-print-top-level object stream 'cust-print-original-prin1)) |
655 | 313 |
314 | |
315 (defun custom-princ (object &optional stream) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
316 "Output the printed representation of OBJECT, any Lisp object. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
317 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
|
318 the contents of strings. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
319 Output stream is STREAM, or value of `standard-output' (which see). |
655 | 320 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
321 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
|
322 (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
|
323 |
655 | 324 |
26519 | 325 (defun custom-prin1-to-string (object &optional noescape) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
326 "Return a string containing the printed representation of OBJECT, |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
327 any Lisp object. Quoting characters are used when needed to make output |
26519 | 328 that `read' can handle, whenever this is possible, unless the optional |
329 second argument NOESCAPE is non-nil. | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
330 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
331 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
|
332 (let ((buf (get-buffer-create " *custom-print-temp*"))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
333 ;; We must erase the buffer before printing in case an error |
26519 | 334 ;; occurred during the last prin1-to-string and we are in debugger. |
105813
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
103995
diff
changeset
|
335 (with-current-buffer buf |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
336 (erase-buffer)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
337 ;; We must be in the current-buffer when the print occurs. |
26519 | 338 (if noescape |
339 (custom-princ object buf) | |
340 (custom-prin1 object buf)) | |
105813
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
103995
diff
changeset
|
341 (with-current-buffer buf |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
342 (buffer-string) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
343 ;; We could erase the buffer again, but why bother? |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
344 ))) |
655 | 345 |
346 | |
347 (defun custom-print (object &optional stream) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
348 "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
|
349 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
|
350 can handle, whenever this is possible. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
351 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
|
352 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
353 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
|
354 (cust-print-original-princ "\n" stream) |
655 | 355 (custom-prin1 object stream) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
356 (cust-print-original-princ "\n" stream)) |
655 | 357 |
358 | |
359 (defun custom-format (fmt &rest args) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
360 "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
|
361 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
|
362 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
|
363 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
|
364 %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
|
365 %c means print a number as a single character. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
366 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
|
367 the argument used by %d, %b, %o, %x or %c must be a number. |
655 | 368 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
369 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
|
370 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
|
371 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
|
372 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
|
373 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
|
374 characters." |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
375 (apply 'cust-print-original-format fmt |
655 | 376 (mapcar (function (lambda (arg) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
377 (if (or (listp arg) (vectorp arg) (symbolp arg)) |
655 | 378 (custom-prin1-to-string arg) |
379 arg))) | |
380 args))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
381 |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
382 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
383 (defun custom-message (fmt &rest args) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
384 "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
|
385 The first argument is a control string. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
386 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
|
387 %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
|
388 %c means print a number as a single character. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
389 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
|
390 the argument used by %d or %c must be a number. |
655 | 391 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
392 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
|
393 See `custom-format' for the details." |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
394 ;; 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
|
395 ;; (cust-print-original-princ (apply 'custom-format fmt args)) |
655 | 396 ;; because the echo area requires special handling |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
397 ;; to avoid duplicating the output. |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
398 ;; cust-print-original-message does it right. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
399 (apply 'cust-print-original-message fmt |
655 | 400 (mapcar (function (lambda (arg) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
401 (if (or (listp arg) (vectorp arg) (symbolp arg)) |
655 | 402 (custom-prin1-to-string arg) |
403 arg))) | |
404 args))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
405 |
655 | 406 |
407 (defun custom-error (fmt &rest args) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
408 "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
|
409 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
410 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
|
411 See `custom-format' for the details." |
655 | 412 (signal 'error (list (apply 'custom-format fmt args)))) |
413 | |
414 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
415 |
655 | 416 ;; Support for custom prin1 and princ |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
417 ;;========================================= |
655 | 418 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
419 ;; 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
|
420 (defvar circle-table) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
421 (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
|
422 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
423 (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
|
424 (defun cust-print-low-level-prin (object)) ; Used internally. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
425 (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
|
426 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
427 (defun cust-print-top-level (object stream emacs-printer) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
428 ;; Set up for printing. |
655 | 429 (let ((standard-output (or stream standard-output)) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
430 ;; circle-table will be non-nil if anything is circular. |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
431 (circle-table (and print-circle |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
432 (cust-print-preprocess-circle-tree object))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
433 (cust-print-current-level (or print-level -1))) |
655 | 434 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
435 (defalias 'cust-print-original-printer emacs-printer) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
436 (defalias 'cust-print-low-level-prin |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
437 (cond |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
438 ((or custom-printers |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
439 circle-table |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
440 print-level ; comment out for version 19 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
441 ;; Emacs doesn't use print-level or print-length |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
442 ;; for vectors, but custom-print can. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
443 (if custom-print-vectors |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
444 (or print-level print-length))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
445 'cust-print-print-object) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
446 (t 'cust-print-original-printer))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
447 (defalias 'cust-print-prin |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
448 (if circle-table 'cust-print-print-circular 'cust-print-low-level-prin)) |
655 | 449 |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
450 (cust-print-prin object) |
655 | 451 object)) |
452 | |
453 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
454 (defun cust-print-print-object (object) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
455 ;; 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
|
456 ;; 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
|
457 (cond |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
458 ((null object) (cust-print-original-printer object)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
459 ((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
|
460 ((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
|
461 ((vectorp object) (cust-print-vector object)) |
655 | 462 ;; All other types, just print. |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
463 (t (cust-print-original-printer object)))) |
655 | 464 |
465 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
466 (defun cust-print-print-circular (object) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
467 ;; Printer for `prin1' and `princ' that handles circular structures. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
468 ;; 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
|
469 ;; 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
|
470 ;; Otherwise, print normally. |
655 | 471 (let ((tag (assq object circle-table))) |
472 (if tag | |
473 (let ((id (cdr tag))) | |
474 (if (> id 0) | |
475 (progn | |
476 ;; Already printed, so just print id. | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
477 (cust-print-original-princ "#") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
478 (cust-print-original-princ id) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
479 (cust-print-original-princ "#")) |
655 | 480 ;; Not printed yet, so label with id and print object. |
481 (setcdr tag (- id)) ; mark it as printed | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
482 (cust-print-original-princ "#") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
483 (cust-print-original-princ (- id)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
484 (cust-print-original-princ "=") |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
485 (cust-print-low-level-prin object) |
655 | 486 )) |
487 ;; Not repeated in structure. | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
488 (cust-print-low-level-prin object)))) |
655 | 489 |
490 | |
491 ;;================================================ | |
492 ;; List and vector processing for print functions. | |
493 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
494 (defun cust-print-list (list) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
495 ;; 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
|
496 (if (= cust-print-current-level 0) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
497 (cust-print-original-princ "#") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
498 (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
|
499 (cust-print-original-princ "(") |
655 | 500 (let ((length (or print-length 0))) |
501 | |
502 ;; 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
|
503 (cust-print-prin (car list)) |
655 | 504 (setq list (cdr list)) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
505 (if list (cust-print-original-princ " ")) |
655 | 506 (setq length (1- length)) |
507 | |
508 ;; Print the rest of the elements. | |
509 (while (and list (/= 0 length)) | |
510 (if (and (listp list) | |
511 (not (assq list circle-table))) | |
512 (progn | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
513 (cust-print-prin (car list)) |
655 | 514 (setq list (cdr list))) |
515 | |
516 ;; 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
|
517 (cust-print-original-princ ". ") |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
518 (cust-print-prin list) |
655 | 519 (setq list nil)) |
520 | |
521 (setq length (1- length)) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
522 (if list (cust-print-original-princ " "))) |
655 | 523 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
524 (if (and list (= length 0)) (cust-print-original-princ "...")) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
525 (cust-print-original-princ ")")))) |
655 | 526 list) |
527 | |
528 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
529 (defun cust-print-vector (vector) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
530 ;; 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
|
531 (if (= cust-print-current-level 0) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
532 (cust-print-original-princ "#") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
533 (let ((cust-print-current-level (1- cust-print-current-level)) |
655 | 534 (i 0) |
535 (len (length vector))) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
536 (cust-print-original-princ "[") |
655 | 537 |
538 (if print-length | |
539 (setq len (min print-length len))) | |
540 ;; Print the elements | |
541 (while (< i len) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
542 (cust-print-prin (aref vector i)) |
655 | 543 (setq i (1+ i)) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
544 (if (< i (length vector)) (cust-print-original-princ " "))) |
655 | 545 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
546 (if (< i (length vector)) (cust-print-original-princ "...")) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
547 (cust-print-original-princ "]") |
655 | 548 )) |
549 vector) | |
550 | |
551 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
552 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
553 ;; Circular structure preprocessing |
655 | 554 ;;================================== |
555 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
556 (defun cust-print-preprocess-circle-tree (object) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
557 ;; Fill up the table. |
655 | 558 (let (;; Table of tags for each object in an object to be printed. |
559 ;; A tag is of the form: | |
560 ;; ( <object> <nil-t-or-id-number> ) | |
561 ;; The id-number is generated after the entire table has been computed. | |
562 ;; During walk through, the real circle-table lives in the cdr so we | |
563 ;; can use setcdr to add new elements instead of having to setq the | |
564 ;; variable sometimes (poor man's locf). | |
565 (circle-table (list nil))) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
566 (cust-print-walk-circle-tree object) |
655 | 567 |
568 ;; Reverse table so it is in the order that the objects will be printed. | |
569 ;; This pass could be avoided if we always added to the end of the | |
570 ;; table with setcdr in walk-circle-tree. | |
571 (setcdr circle-table (nreverse (cdr circle-table))) | |
572 | |
573 ;; Walk through the table, assigning id-numbers to those | |
574 ;; objects which will be printed using #N= syntax. Delete those | |
575 ;; objects which will be printed only once (to speed up assq later). | |
576 (let ((rest circle-table) | |
577 (id -1)) | |
578 (while (cdr rest) | |
579 (let ((tag (car (cdr rest)))) | |
580 (cond ((cdr tag) | |
581 (setcdr tag id) | |
582 (setq id (1- id)) | |
583 (setq rest (cdr rest))) | |
584 ;; Else delete this object. | |
585 (t (setcdr rest (cdr (cdr rest)))))) | |
586 )) | |
587 ;; Drop the car. | |
588 (cdr circle-table) | |
589 )) | |
590 | |
591 | |
592 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
593 (defun cust-print-walk-circle-tree (object) |
655 | 594 (let (read-equivalent-p tag) |
595 (while object | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
596 (setq read-equivalent-p |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
597 (or (numberp object) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
598 (and (symbolp object) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
599 ;; Check if it is uninterned. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
600 (eq object (intern-soft (symbol-name object))))) |
655 | 601 tag (and (not read-equivalent-p) |
602 (assq object (cdr circle-table)))) | |
603 (cond (tag | |
604 ;; Seen this object already, so note that. | |
605 (setcdr tag t)) | |
606 | |
607 ((not read-equivalent-p) | |
608 ;; Add a tag for this object. | |
609 (setcdr circle-table | |
610 (cons (list object) | |
611 (cdr circle-table))))) | |
612 (setq object | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
613 (cond |
655 | 614 (tag ;; No need to descend since we have already. |
615 nil) | |
616 | |
617 ((consp object) | |
618 ;; 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
|
619 (cust-print-walk-circle-tree (car object)) |
655 | 620 ;; But walk the cdr with the above while loop |
621 ;; to avoid problems with max-lisp-eval-depth. | |
622 ;; And it should be faster than recursion. | |
623 (cdr object)) | |
624 | |
625 ((vectorp object) | |
626 ;; Walk the vector. | |
627 (let ((i (length object)) | |
628 (j 0)) | |
629 (while (< j i) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
630 (cust-print-walk-circle-tree (aref object j)) |
655 | 631 (setq j (1+ j)))))))))) |
632 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
633 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
634 ;; Example. |
655 | 635 ;;======================================= |
636 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
637 '(progn |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
638 (progn |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
639 ;; Create some circular structures. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
640 (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
|
641 (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
|
642 (setcar (nthcdr 3 circ-list) circ-list) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
643 (aset (nth 2 circ-list) 2 circ-list) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
644 (setq dotted-circ-list (list 'a 'b 'c)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
645 (setcdr (cdr (cdr dotted-circ-list)) dotted-circ-list) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
646 (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
|
647 (aset circ-vector 5 (make-symbol "-gensym-")) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
648 (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
|
649 nil) |
655 | 650 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
651 (install-custom-print) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
652 ;; (setq print-circle t) |
655 | 653 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
654 (let ((print-circle t)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
655 (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
|
656 (error "circular object with array printing"))) |
655 | 657 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
658 (let ((print-circle t)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
659 (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
|
660 (error "circular object with array printing"))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
661 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
662 (let* ((print-circle t) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
663 (x (list 'p 'q)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
664 (y (list (list 'a 'b) x 'foo x))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
665 (setcdr (cdr (cdr (cdr y))) (cdr y)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
666 (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
|
667 ) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
668 (error "circular list example from CL manual"))) |
655 | 669 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
670 (let ((print-circle nil)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
671 ;; 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
|
672 ;; (require 'cl-packages) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
673 (or (equal (prin1-to-string circ-sym) "(#:FOO #:FOO)") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
674 (error "uninterned symbols in list"))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
675 (let ((print-circle t)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
676 (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
|
677 (error "circular uninterned symbols in list"))) |
655 | 678 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
679 (uninstall-custom-print) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
680 ) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
681 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
682 (provide 'cust-print) |
655 | 683 |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
684 ;; arch-tag: 3a5a8650-622c-48c4-87d8-e01bf72ec580 |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
685 ;;; cust-print.el ends here |