Mercurial > emacs
annotate lisp/emacs-lisp/cust-print.el @ 104489:25e047f7f6a2
Synch to Eric Ludlam's upstream CEDET repository.
* cedet/semantic/wisent/java-tags.el:
* cedet/semantic/wisent/javat-wy.el: New files.
* cedet/semantic/wisent/java.el:
* cedet/semantic/wisent/java-wy.el: Files removed.
* cedet/semantic/java.el (semantic-java-prototype-function)
(semantic-java-prototype-variable, semantic-java-prototype-type):
Doc fix
(java-mode::semantic-format-tag-prototype): Renamed from
semantic-format-prototype-tag, which didn't match the overloadable
function.
* cedet/semantic/bovine/c.el (semantic-c-dereference-namespace-alias):
Deal correctly with nested namespaces. Make sure type actually
exists in original namespace.
* cedet/semantic/lex-spp.el (semantic-lex-spp-hack-depth): New.
(semantic-lex-spp-lex-text-string): Use above to enable recursion.
* cedet/semantic/format.el: Whitespace cleanup.
(semantic-test-all-format-tag-functions): Move to end.
(semantic-format-tag-prototype, semantic-format-tag-name)
(semantic-format-tag-name-default): Revert to original upstream
positions.
* cedet/semantic/elp.el: File removed.
* cedet/semantic/analyze.el (semantic-adebug-analyze): New
function, moved here from semantic/adebug.
* cedet/semantic/adebug.el: Declare external semanticdb functions.
(semantic-adebug-analyze, semantic-adebug-edebug-expr): Deleted.
* emacs-lisp/eieio.el (eieio-unbound): Default value is now robust
to recompile.
* emacs-lisp/eieio-datadebug.el: Add eieio objects to the list of
data debug things to recognize.
* emacs-lisp/eieio-comp.el: Synch to upstream.
* cedet/data-debug.el: Don't require eieio and semantic/tag.
If eieio is loaded, require eieio-datadebug.
(data-debug-insert-ring-button): Do not be specific about the ring
contents.
(data-debug-thing-alist): Remove eieio and semantic specific
entries.
(data-debug-add-specialized-thing): New function.
* cedet/cedet.el: Update commentary.
* cedet/cedet-edebug.el: Require edebug and debug.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sun, 13 Sep 2009 15:58:30 +0000 |
parents | cbe885d14464 |
children | df4934f25eef |
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, |
cbe885d14464
Remove leading * from defcustom docs.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
4 ;; 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 |
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. |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
335 (save-excursion |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
336 (set-buffer buf) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
337 (erase-buffer)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
338 ;; We must be in the current-buffer when the print occurs. |
26519 | 339 (if noescape |
340 (custom-princ object buf) | |
341 (custom-prin1 object buf)) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
342 (save-excursion |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
343 (set-buffer buf) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
344 (buffer-string) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
345 ;; We could erase the buffer again, but why bother? |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
346 ))) |
655 | 347 |
348 | |
349 (defun custom-print (object &optional stream) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
350 "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
|
351 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
|
352 can handle, whenever this is possible. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
353 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
|
354 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
355 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
|
356 (cust-print-original-princ "\n" stream) |
655 | 357 (custom-prin1 object stream) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
358 (cust-print-original-princ "\n" stream)) |
655 | 359 |
360 | |
361 (defun custom-format (fmt &rest args) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
362 "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
|
363 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
|
364 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
|
365 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
|
366 %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
|
367 %c means print a number as a single character. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
368 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
|
369 the argument used by %d, %b, %o, %x or %c must be a number. |
655 | 370 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
371 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
|
372 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
|
373 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
|
374 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
|
375 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
|
376 characters." |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
377 (apply 'cust-print-original-format fmt |
655 | 378 (mapcar (function (lambda (arg) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
379 (if (or (listp arg) (vectorp arg) (symbolp arg)) |
655 | 380 (custom-prin1-to-string arg) |
381 arg))) | |
382 args))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
383 |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
384 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
385 (defun custom-message (fmt &rest args) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
386 "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
|
387 The first argument is a control string. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
388 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
|
389 %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
|
390 %c means print a number as a single character. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
391 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
|
392 the argument used by %d or %c must be a number. |
655 | 393 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
394 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
|
395 See `custom-format' for the details." |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
396 ;; 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
|
397 ;; (cust-print-original-princ (apply 'custom-format fmt args)) |
655 | 398 ;; because the echo area requires special handling |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
399 ;; to avoid duplicating the output. |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
400 ;; cust-print-original-message does it right. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
401 (apply 'cust-print-original-message fmt |
655 | 402 (mapcar (function (lambda (arg) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
403 (if (or (listp arg) (vectorp arg) (symbolp arg)) |
655 | 404 (custom-prin1-to-string arg) |
405 arg))) | |
406 args))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
407 |
655 | 408 |
409 (defun custom-error (fmt &rest args) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
410 "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
|
411 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
412 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
|
413 See `custom-format' for the details." |
655 | 414 (signal 'error (list (apply 'custom-format fmt args)))) |
415 | |
416 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
417 |
655 | 418 ;; Support for custom prin1 and princ |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
419 ;;========================================= |
655 | 420 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
421 ;; 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
|
422 (defvar circle-table) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
423 (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
|
424 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
425 (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
|
426 (defun cust-print-low-level-prin (object)) ; Used internally. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
427 (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
|
428 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
429 (defun cust-print-top-level (object stream emacs-printer) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
430 ;; Set up for printing. |
655 | 431 (let ((standard-output (or stream standard-output)) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
432 ;; circle-table will be non-nil if anything is circular. |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
433 (circle-table (and print-circle |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
434 (cust-print-preprocess-circle-tree object))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
435 (cust-print-current-level (or print-level -1))) |
655 | 436 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
437 (defalias 'cust-print-original-printer emacs-printer) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
438 (defalias 'cust-print-low-level-prin |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
439 (cond |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
440 ((or custom-printers |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
441 circle-table |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
442 print-level ; comment out for version 19 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
443 ;; Emacs doesn't use print-level or print-length |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
444 ;; for vectors, but custom-print can. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
445 (if custom-print-vectors |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
446 (or print-level print-length))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
447 'cust-print-print-object) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
448 (t 'cust-print-original-printer))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
449 (defalias 'cust-print-prin |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
450 (if circle-table 'cust-print-print-circular 'cust-print-low-level-prin)) |
655 | 451 |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
452 (cust-print-prin object) |
655 | 453 object)) |
454 | |
455 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
456 (defun cust-print-print-object (object) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
457 ;; 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
|
458 ;; 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
|
459 (cond |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
460 ((null object) (cust-print-original-printer object)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
461 ((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
|
462 ((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
|
463 ((vectorp object) (cust-print-vector object)) |
655 | 464 ;; All other types, just print. |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
465 (t (cust-print-original-printer object)))) |
655 | 466 |
467 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
468 (defun cust-print-print-circular (object) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
469 ;; Printer for `prin1' and `princ' that handles circular structures. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
470 ;; 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
|
471 ;; 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
|
472 ;; Otherwise, print normally. |
655 | 473 (let ((tag (assq object circle-table))) |
474 (if tag | |
475 (let ((id (cdr tag))) | |
476 (if (> id 0) | |
477 (progn | |
478 ;; Already printed, so just print id. | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
479 (cust-print-original-princ "#") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
480 (cust-print-original-princ id) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
481 (cust-print-original-princ "#")) |
655 | 482 ;; Not printed yet, so label with id and print object. |
483 (setcdr tag (- id)) ; mark it as printed | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
484 (cust-print-original-princ "#") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
485 (cust-print-original-princ (- id)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
486 (cust-print-original-princ "=") |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
487 (cust-print-low-level-prin object) |
655 | 488 )) |
489 ;; Not repeated in structure. | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
490 (cust-print-low-level-prin object)))) |
655 | 491 |
492 | |
493 ;;================================================ | |
494 ;; List and vector processing for print functions. | |
495 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
496 (defun cust-print-list (list) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
497 ;; 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
|
498 (if (= cust-print-current-level 0) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
499 (cust-print-original-princ "#") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
500 (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
|
501 (cust-print-original-princ "(") |
655 | 502 (let ((length (or print-length 0))) |
503 | |
504 ;; 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
|
505 (cust-print-prin (car list)) |
655 | 506 (setq list (cdr list)) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
507 (if list (cust-print-original-princ " ")) |
655 | 508 (setq length (1- length)) |
509 | |
510 ;; Print the rest of the elements. | |
511 (while (and list (/= 0 length)) | |
512 (if (and (listp list) | |
513 (not (assq list circle-table))) | |
514 (progn | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
515 (cust-print-prin (car list)) |
655 | 516 (setq list (cdr list))) |
517 | |
518 ;; 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
|
519 (cust-print-original-princ ". ") |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
520 (cust-print-prin list) |
655 | 521 (setq list nil)) |
522 | |
523 (setq length (1- length)) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
524 (if list (cust-print-original-princ " "))) |
655 | 525 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
526 (if (and list (= length 0)) (cust-print-original-princ "...")) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
527 (cust-print-original-princ ")")))) |
655 | 528 list) |
529 | |
530 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
531 (defun cust-print-vector (vector) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
532 ;; 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
|
533 (if (= cust-print-current-level 0) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
534 (cust-print-original-princ "#") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
535 (let ((cust-print-current-level (1- cust-print-current-level)) |
655 | 536 (i 0) |
537 (len (length vector))) | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
538 (cust-print-original-princ "[") |
655 | 539 |
540 (if print-length | |
541 (setq len (min print-length len))) | |
542 ;; Print the elements | |
543 (while (< i len) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
544 (cust-print-prin (aref vector i)) |
655 | 545 (setq i (1+ i)) |
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 " "))) |
655 | 547 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
548 (if (< i (length vector)) (cust-print-original-princ "...")) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
549 (cust-print-original-princ "]") |
655 | 550 )) |
551 vector) | |
552 | |
553 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
554 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
555 ;; Circular structure preprocessing |
655 | 556 ;;================================== |
557 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
558 (defun cust-print-preprocess-circle-tree (object) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
559 ;; Fill up the table. |
655 | 560 (let (;; Table of tags for each object in an object to be printed. |
561 ;; A tag is of the form: | |
562 ;; ( <object> <nil-t-or-id-number> ) | |
563 ;; The id-number is generated after the entire table has been computed. | |
564 ;; During walk through, the real circle-table lives in the cdr so we | |
565 ;; can use setcdr to add new elements instead of having to setq the | |
566 ;; variable sometimes (poor man's locf). | |
567 (circle-table (list nil))) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
568 (cust-print-walk-circle-tree object) |
655 | 569 |
570 ;; Reverse table so it is in the order that the objects will be printed. | |
571 ;; This pass could be avoided if we always added to the end of the | |
572 ;; table with setcdr in walk-circle-tree. | |
573 (setcdr circle-table (nreverse (cdr circle-table))) | |
574 | |
575 ;; Walk through the table, assigning id-numbers to those | |
576 ;; objects which will be printed using #N= syntax. Delete those | |
577 ;; objects which will be printed only once (to speed up assq later). | |
578 (let ((rest circle-table) | |
579 (id -1)) | |
580 (while (cdr rest) | |
581 (let ((tag (car (cdr rest)))) | |
582 (cond ((cdr tag) | |
583 (setcdr tag id) | |
584 (setq id (1- id)) | |
585 (setq rest (cdr rest))) | |
586 ;; Else delete this object. | |
587 (t (setcdr rest (cdr (cdr rest)))))) | |
588 )) | |
589 ;; Drop the car. | |
590 (cdr circle-table) | |
591 )) | |
592 | |
593 | |
594 | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
595 (defun cust-print-walk-circle-tree (object) |
655 | 596 (let (read-equivalent-p tag) |
597 (while object | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
598 (setq read-equivalent-p |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
599 (or (numberp object) |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
600 (and (symbolp object) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
601 ;; Check if it is uninterned. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
602 (eq object (intern-soft (symbol-name object))))) |
655 | 603 tag (and (not read-equivalent-p) |
604 (assq object (cdr circle-table)))) | |
605 (cond (tag | |
606 ;; Seen this object already, so note that. | |
607 (setcdr tag t)) | |
608 | |
609 ((not read-equivalent-p) | |
610 ;; Add a tag for this object. | |
611 (setcdr circle-table | |
612 (cons (list object) | |
613 (cdr circle-table))))) | |
614 (setq object | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
615 (cond |
655 | 616 (tag ;; No need to descend since we have already. |
617 nil) | |
618 | |
619 ((consp object) | |
620 ;; 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
|
621 (cust-print-walk-circle-tree (car object)) |
655 | 622 ;; But walk the cdr with the above while loop |
623 ;; to avoid problems with max-lisp-eval-depth. | |
624 ;; And it should be faster than recursion. | |
625 (cdr object)) | |
626 | |
627 ((vectorp object) | |
628 ;; Walk the vector. | |
629 (let ((i (length object)) | |
630 (j 0)) | |
631 (while (< j i) | |
1359
96c43cee31f1
CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents:
1356
diff
changeset
|
632 (cust-print-walk-circle-tree (aref object j)) |
655 | 633 (setq j (1+ j)))))))))) |
634 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
635 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
636 ;; Example. |
655 | 637 ;;======================================= |
638 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
639 '(progn |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
640 (progn |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
641 ;; Create some circular structures. |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
642 (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
|
643 (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
|
644 (setcar (nthcdr 3 circ-list) circ-list) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
645 (aset (nth 2 circ-list) 2 circ-list) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
646 (setq dotted-circ-list (list 'a 'b 'c)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
647 (setcdr (cdr (cdr dotted-circ-list)) dotted-circ-list) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
648 (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
|
649 (aset circ-vector 5 (make-symbol "-gensym-")) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
650 (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
|
651 nil) |
655 | 652 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
653 (install-custom-print) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
654 ;; (setq print-circle t) |
655 | 655 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
656 (let ((print-circle t)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
657 (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
|
658 (error "circular object with array printing"))) |
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 dotted-circ-list) "#1=(a b c . #1#)") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
662 (error "circular object with array printing"))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
663 |
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 (x (list 'p 'q)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
666 (y (list (list 'a 'b) x 'foo x))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
667 (setcdr (cdr (cdr (cdr y))) (cdr y)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
668 (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
|
669 ) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
670 (error "circular list example from CL manual"))) |
655 | 671 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
672 (let ((print-circle nil)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
673 ;; 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
|
674 ;; (require 'cl-packages) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
675 (or (equal (prin1-to-string circ-sym) "(#:FOO #:FOO)") |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
676 (error "uninterned symbols in list"))) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
677 (let ((print-circle t)) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
678 (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
|
679 (error "circular uninterned symbols in list"))) |
655 | 680 |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
681 (uninstall-custom-print) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
682 ) |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
683 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
684 (provide 'cust-print) |
655 | 685 |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
686 ;; arch-tag: 3a5a8650-622c-48c4-87d8-e01bf72ec580 |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
687 ;;; cust-print.el ends here |