annotate lisp/emacs-lisp/cust-print.el @ 101683:1c8fb01a3229

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