annotate lisp/emacs-lisp/cust-print.el @ 59994:3e0903b0d56d

*** empty log message ***
author Kim F. Storm <storm@cua.dk>
date Tue, 08 Feb 2005 23:50:46 +0000
parents 82bca611f221
children 18a818a2ee7c f2ebccfa87d4
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
845
213978acbc1e entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 811
diff changeset
3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
213978acbc1e entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 811
diff changeset
4
30805
3cfd3dc474b8 Change authors' mail address.
Gerd Moellmann <gerd@gnu.org>
parents: 26519
diff changeset
5 ;; Author: Daniel LaLiberte <liberte@holonexus.org>
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 655
diff changeset
6 ;; Adapted-By: ESR
2247
2c7997f249eb Add or correct keywords
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2230
diff changeset
7 ;; Keywords: extensions
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
8
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
9 ;; LCD Archive Entry:
30805
3cfd3dc474b8 Change authors' mail address.
Gerd Moellmann <gerd@gnu.org>
parents: 26519
diff changeset
10 ;; cust-print|Daniel LaLiberte|liberte@holonexus.org
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
11 ;; |Handle print-level, print-circle and more.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
12
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
13 ;; This file is part of GNU Emacs.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
14
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
15 ;; GNU Emacs is free software; you can redistribute it and/or modify
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
16 ;; it under the terms of the GNU General Public License as published by
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 655
diff changeset
17 ;; the Free Software Foundation; either version 2, or (at your option)
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
18 ;; any later version.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
19
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
20 ;; 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
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
23 ;; GNU General Public License for more details.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
24
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
25 ;; You should have received a copy of the GNU General Public License
26519
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
26 ;; along with GNU Emacs; see the file COPYING. If not, write to the
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
28 ;; Boston, MA 02111-1307, USA.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
29
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 655
diff changeset
30 ;;; Commentary:
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 655
diff changeset
31
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
32 ;; This package provides a general print handler for prin1 and princ
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
33 ;; that supports print-level and print-circle, and by the way,
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
34 ;; print-length since the standard routines are being replaced. Also,
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
35 ;; to print custom types constructed from lists and vectors, use
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
36 ;; custom-print-list and custom-print-vector. See the documentation
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
37 ;; strings of these variables for more details.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
38
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
39 ;; If the results of your expressions contain circular references to
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
40 ;; other parts of the same structure, the standard Emacs print
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
41 ;; subroutines may fail to print with an untrappable error,
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
42 ;; "Apparently circular structure being printed". If you only use cdr
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
43 ;; 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
44 ;; term here?), you can limit the length of printing with
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
45 ;; 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
46 ;; the above mentioned error in Emacs version 18. Version
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
47 ;; 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
48 ;; print representation of circular and shared structures; the print-circle
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
49 ;; option may be used to print more concise representations.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
50
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
51 ;; 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
52 ;; 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
53 ;; 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
54 ;; 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
55 ;; uninstall-custom-print. Second, you may temporarily install
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
56 ;; 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
57 ;; 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
58 ;; printing that requires them.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
59
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
60 ;; Note that subroutines which call print subroutines directly will
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
61 ;; not use the custom print functions. In particular, the evaluation
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
62 ;; 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
63 ;; 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
64 ;; 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
65 ;; 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
66
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
67 ;; 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
68 ;; 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
69 ;; to print according to print-gensym.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
70
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
71 ;; 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
72 ;; 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
73 ;; 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
74 ;; capabilities could be added in the future.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
75
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
76 ;; Implementation design: we want to use the same list and vector
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
77 ;; processing algorithm for all versions of prin1 and princ, since how
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
78 ;; the processing is done depends on print-length, print-level, and
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
79 ;; print-circle. For circle printing, a preprocessing step is
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
80 ;; required before the final printing. Thanks to Jamie Zawinski
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
81 ;; for motivation and algorithms.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
82
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
83
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
84 ;;; Code:
26519
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
85
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
86 (defgroup cust-print nil
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
87 "Handles print-level and print-circle."
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
88 :prefix "print-"
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
89 :group 'lisp
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
90 :group 'extensions)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
91
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
92 ;; If using cl-packages:
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
93
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
94 '(defpackage "cust-print"
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
95 (:nicknames "CP" "custom-print")
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
96 (:use "el")
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
97 (:export
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
98 print-level
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
99 print-circle
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
100
6687
30c38858c0d0 Change install- and uninstall- to -install and -uninstall.
Daniel LaLiberte <liberte@gnu.org>
parents: 6511
diff changeset
101 custom-print-install
30c38858c0d0 Change install- and uninstall- to -install and -uninstall.
Daniel LaLiberte <liberte@gnu.org>
parents: 6511
diff changeset
102 custom-print-uninstall
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
103 custom-print-installed-p
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
104 with-custom-print
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
105
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
106 custom-prin1
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
107 custom-princ
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
108 custom-prin1-to-string
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
109 custom-print
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
110 custom-format
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
111 custom-message
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
112 custom-error
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
113
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
114 custom-printers
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
115 add-custom-printer
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
116 ))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
117
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
118 '(in-package cust-print)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
119
26519
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
120 ;; Emacs 18 doesn't have defalias.
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
121 ;; Provide def for byte compiler.
6779
baefeadae7a3 Jumping up to new revision.
Daniel LaLiberte <liberte@gnu.org>
parents: 6687
diff changeset
122 (eval-and-compile
baefeadae7a3 Jumping up to new revision.
Daniel LaLiberte <liberte@gnu.org>
parents: 6687
diff changeset
123 (or (fboundp 'defalias) (fset 'defalias 'fset)))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
124
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
125
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
126 ;; Variables:
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
127 ;;=========================================================
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
128
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
129 ;;(defvar print-length nil
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
130 ;; "*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
131 ;;This is defined by emacs.")
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
132
26519
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
133 (defcustom print-level nil
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
134 "*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
135
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
136 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
137 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
138 `Apparently circular structure being printed.'
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
139 Also see `print-length' and `print-circle'.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
140
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
141 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
142 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
143 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
144 level 1."
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
145 :type '(choice (const nil) integer)
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
146 :group 'cust-print)
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
147
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
148
26519
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
149 (defcustom print-circle nil
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
150 "*Controls the printing of recursive structures.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
151
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
152 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
153 `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
154 \"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
155 `print-length' and `print-level'.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
156
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
157 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
158 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
159 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
160 where N is a positive decimal integer.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
161
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
162 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
163 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
164 :type 'boolean
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
165 :group 'cust-print)
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
166
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
167
26519
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
168 (defcustom custom-print-vectors nil
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
169 "*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
170
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
171 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
172 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
173 print-level, but not for vectors."
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
174 :type 'boolean
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
175 :group 'cust-print)
6511
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
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
178 ;; Custom printers
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
179 ;;==========================================================
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
180
58386
82bca611f221 (custom-printers): Use `defvar' instead of `defconst'.
Luc Teirlinck <teirllm@auburn.edu>
parents: 52401
diff changeset
181 (defvar custom-printers nil
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
182 ;; e.g. '((symbolp . pkg::print-symbol))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
183 "An alist for custom printing of any type.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
184 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
185 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
186 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
187 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
188 The PRINTER should return the object being printed.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
189
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
190 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
191 `delete-custom-printer'")
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
192 ;; 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
193 ;; Or should the standard printers functions be replaced by
26519
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
194 ;; 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
195
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
196 (defun add-custom-printer (pred printer)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
197 "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
198 Any pair that has the same PREDICATE is first removed."
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
199 (setq custom-printers (cons (cons pred printer)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
200 (delq (assq pred custom-printers)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
201 custom-printers)))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
202 ;; 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
203 (cust-print-update-custom-printers))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
204
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
205 (defun delete-custom-printer (pred)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
206 "Delete the custom printer associated with PREDICATE."
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
207 (setq custom-printers (delq (assq pred custom-printers)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
208 custom-printers))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
209 (cust-print-update-custom-printers))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
210
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
211
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
212 (defun cust-print-use-custom-printer (object)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
213 ;; Default function returns nil.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
214 nil)
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
215
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
216 (defun cust-print-update-custom-printers ()
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
217 ;; Modify the definition of cust-print-use-custom-printer
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
218 (defalias 'cust-print-use-custom-printer
26519
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
219 ;; 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
220 ;; (byte-compile
26519
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
221 `(lambda (object)
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
222 (cond
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
223 ,@(mapcar (function
26519
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
224 (lambda (pair)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
225 `((,(car pair) object)
26519
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
226 (,(cdr pair) object))))
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
227 custom-printers)
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
228 ;; Otherwise return nil.
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
229 (t nil)
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 ;; )
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
232 ))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
233
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
234
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
235 ;; Saving and restoring emacs printing routines.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
236 ;;====================================================
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
237
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
238 (defun cust-print-set-function-cell (symbol-pair)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
239 (defalias (car symbol-pair)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
240 (symbol-function (car (cdr symbol-pair)))))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
241
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
242 (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
243
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
244 ;; Save emacs routines.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
245 (if (not (fboundp 'cust-print-original-prin1))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
246 (mapcar 'cust-print-set-function-cell
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
247 '((cust-print-original-prin1 prin1)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
248 (cust-print-original-princ princ)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
249 (cust-print-original-print print)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
250 (cust-print-original-prin1-to-string prin1-to-string)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
251 (cust-print-original-format format)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
252 (cust-print-original-message message)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
253 (cust-print-original-error error))))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
254
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
255
6687
30c38858c0d0 Change install- and uninstall- to -install and -uninstall.
Daniel LaLiberte <liberte@gnu.org>
parents: 6511
diff changeset
256 (defun custom-print-install ()
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
257 "Replace print functions with general, customizable, Lisp versions.
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
258 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
259 by running `custom-print-uninstall'."
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
260 (interactive)
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
261 (mapcar 'cust-print-set-function-cell
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
262 '((prin1 custom-prin1)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
263 (princ custom-princ)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
264 (print custom-print)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
265 (prin1-to-string custom-prin1-to-string)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
266 (format custom-format)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
267 (message custom-message)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
268 (error custom-error)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
269 ))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
270 t)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
271
6687
30c38858c0d0 Change install- and uninstall- to -install and -uninstall.
Daniel LaLiberte <liberte@gnu.org>
parents: 6511
diff changeset
272 (defun custom-print-uninstall ()
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
273 "Reset print functions to their emacs subroutines."
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
274 (interactive)
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
275 (mapcar 'cust-print-set-function-cell
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
276 '((prin1 cust-print-original-prin1)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
277 (princ cust-print-original-princ)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
278 (print cust-print-original-print)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
279 (prin1-to-string cust-print-original-prin1-to-string)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
280 (format cust-print-original-format)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
281 (message cust-print-original-message)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
282 (error cust-print-original-error)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
283 ))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
284 t)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
285
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
286 (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
287 (defun custom-print-installed-p ()
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
288 "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
289 (eq (symbol-function 'custom-prin1) (symbol-function 'prin1)))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
290
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
291 (put 'with-custom-print-funcs 'edebug-form-spec '(body))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
292 (put 'with-custom-print 'edebug-form-spec '(body))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
293
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
294 (defalias 'with-custom-print-funcs 'with-custom-print)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
295 (defmacro with-custom-print (&rest body)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
296 "Temporarily install the custom print package while executing BODY."
26519
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
297 `(unwind-protect
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
298 (progn
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
299 (custom-print-install)
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
300 ,@body)
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
301 (custom-print-uninstall)))
6511
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
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
304 ;; 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
305 ;;===============================================================
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
306 ;; - so far only the printing and formatting subrs.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
307
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
308 (defun custom-prin1 (object &optional stream)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
309 "Output the printed representation of OBJECT, any Lisp object.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
310 Quoting characters are printed when needed to make output that `read'
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
311 can handle, whenever this is possible.
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
312 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
313
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
314 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
315 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
316 and `print-circle' (which see)."
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
317 (cust-print-top-level object stream 'cust-print-original-prin1))
655
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
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
320 (defun custom-princ (object &optional stream)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
321 "Output the printed representation of OBJECT, any Lisp object.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
322 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
323 the contents of strings.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
324 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
325
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
326 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
327 (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
328
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
329
26519
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
330 (defun custom-prin1-to-string (object &optional noescape)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
331 "Return a string containing the printed representation of OBJECT,
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
332 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
333 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
334 second argument NOESCAPE is non-nil.
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
335
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
336 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
337 (let ((buf (get-buffer-create " *custom-print-temp*")))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
338 ;; 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
339 ;; 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
340 (save-excursion
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
341 (set-buffer buf)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
342 (erase-buffer))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
343 ;; 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
344 (if noescape
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
345 (custom-princ object buf)
693b53fde264 Use new backquote syntax.
Gerd Moellmann <gerd@gnu.org>
parents: 6779
diff changeset
346 (custom-prin1 object buf))
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
347 (save-excursion
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
348 (set-buffer buf)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
349 (buffer-string)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
350 ;; We could erase the buffer again, but why bother?
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
351 )))
655
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
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
354 (defun custom-print (object &optional stream)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
355 "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
356 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
357 can handle, whenever this is possible.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
358 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
359
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
360 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
361 (cust-print-original-princ "\n" stream)
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
362 (custom-prin1 object stream)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
363 (cust-print-original-princ "\n" stream))
655
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
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
366 (defun custom-format (fmt &rest args)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
367 "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
368 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
369 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
370 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
371 %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
372 %c means print a number as a single character.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
373 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
374 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
375
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
376 This is the custom-print replacement for the standard `format'. It
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
377 calls the emacs `format' after first making strings for list,
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
378 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
379 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
380 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
381 characters."
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
382 (apply 'cust-print-original-format fmt
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
383 (mapcar (function (lambda (arg)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
384 (if (or (listp arg) (vectorp arg) (symbolp arg))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
385 (custom-prin1-to-string arg)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
386 arg)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
387 args)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
388
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
389
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
390 (defun custom-message (fmt &rest args)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
391 "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
392 The first argument is a control string.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
393 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
394 %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
395 %c means print a number as a single character.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
396 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
397 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
398
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
399 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
400 See `custom-format' for the details."
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
401 ;; 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
402 ;; (cust-print-original-princ (apply 'custom-format fmt args))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
403 ;; because the echo area requires special handling
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
404 ;; to avoid duplicating the output.
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
405 ;; cust-print-original-message does it right.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
406 (apply 'cust-print-original-message fmt
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
407 (mapcar (function (lambda (arg)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
408 (if (or (listp arg) (vectorp arg) (symbolp arg))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
409 (custom-prin1-to-string arg)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
410 arg)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
411 args)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
412
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
413
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
414 (defun custom-error (fmt &rest args)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
415 "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
416
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
417 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
418 See `custom-format' for the details."
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
419 (signal 'error (list (apply 'custom-format fmt args))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
420
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
421
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
422
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
423 ;; Support for custom prin1 and princ
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
424 ;;=========================================
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
425
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
426 ;; 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
427 (defvar circle-table)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
428 (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
429
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
430 (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
431 (defun cust-print-low-level-prin (object)) ; Used internally.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
432 (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
433
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
434 (defun cust-print-top-level (object stream emacs-printer)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
435 ;; Set up for printing.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
436 (let ((standard-output (or stream standard-output))
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
437 ;; circle-table will be non-nil if anything is circular.
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
438 (circle-table (and print-circle
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
439 (cust-print-preprocess-circle-tree object)))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
440 (cust-print-current-level (or print-level -1)))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
441
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
442 (defalias 'cust-print-original-printer emacs-printer)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
443 (defalias 'cust-print-low-level-prin
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
444 (cond
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
445 ((or custom-printers
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
446 circle-table
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
447 print-level ; comment out for version 19
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
448 ;; Emacs doesn't use print-level or print-length
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
449 ;; for vectors, but custom-print can.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
450 (if custom-print-vectors
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
451 (or print-level print-length)))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
452 'cust-print-print-object)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
453 (t 'cust-print-original-printer)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
454 (defalias 'cust-print-prin
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
455 (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
456
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
457 (cust-print-prin object)
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
458 object))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
459
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
460
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
461 (defun cust-print-print-object (object)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
462 ;; 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
463 ;; 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
464 (cond
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
465 ((null object) (cust-print-original-printer object))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
466 ((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
467 ((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
468 ((vectorp object) (cust-print-vector object))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
469 ;; All other types, just print.
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
470 (t (cust-print-original-printer object))))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
471
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
472
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
473 (defun cust-print-print-circular (object)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
474 ;; Printer for `prin1' and `princ' that handles circular structures.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
475 ;; 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
476 ;; 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
477 ;; Otherwise, print normally.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
478 (let ((tag (assq object circle-table)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
479 (if tag
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
480 (let ((id (cdr tag)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
481 (if (> id 0)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
482 (progn
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
483 ;; Already printed, so just print id.
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
484 (cust-print-original-princ "#")
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
485 (cust-print-original-princ id)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
486 (cust-print-original-princ "#"))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
487 ;; Not printed yet, so label with id and print object.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
488 (setcdr tag (- id)) ; mark it as printed
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
489 (cust-print-original-princ "#")
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
490 (cust-print-original-princ (- id))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
491 (cust-print-original-princ "=")
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
492 (cust-print-low-level-prin object)
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
493 ))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
494 ;; Not repeated in structure.
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
495 (cust-print-low-level-prin object))))
655
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 ;;================================================
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
499 ;; List and vector processing for print functions.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
500
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
501 (defun cust-print-list (list)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
502 ;; 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
503 (if (= cust-print-current-level 0)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
504 (cust-print-original-princ "#")
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
505 (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
506 (cust-print-original-princ "(")
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
507 (let ((length (or print-length 0)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
508
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
509 ;; 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
510 (cust-print-prin (car list))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
511 (setq list (cdr list))
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
512 (if list (cust-print-original-princ " "))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
513 (setq length (1- length))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
514
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
515 ;; Print the rest of the elements.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
516 (while (and list (/= 0 length))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
517 (if (and (listp list)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
518 (not (assq list circle-table)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
519 (progn
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
520 (cust-print-prin (car list))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
521 (setq list (cdr list)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
522
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
523 ;; 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
524 (cust-print-original-princ ". ")
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
525 (cust-print-prin list)
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
526 (setq list nil))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
527
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
528 (setq length (1- length))
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
529 (if list (cust-print-original-princ " ")))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
530
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
531 (if (and list (= length 0)) (cust-print-original-princ "..."))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
532 (cust-print-original-princ ")"))))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
533 list)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
534
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
535
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
536 (defun cust-print-vector (vector)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
537 ;; 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
538 (if (= cust-print-current-level 0)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
539 (cust-print-original-princ "#")
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
540 (let ((cust-print-current-level (1- cust-print-current-level))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
541 (i 0)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
542 (len (length vector)))
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
543 (cust-print-original-princ "[")
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
544
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
545 (if print-length
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
546 (setq len (min print-length len)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
547 ;; Print the elements
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
548 (while (< i len)
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
549 (cust-print-prin (aref vector i))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
550 (setq i (1+ i))
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
551 (if (< i (length vector)) (cust-print-original-princ " ")))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
552
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
553 (if (< i (length vector)) (cust-print-original-princ "..."))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
554 (cust-print-original-princ "]")
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
555 ))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
556 vector)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
557
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
558
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
559
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
560 ;; Circular structure preprocessing
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
561 ;;==================================
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
562
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
563 (defun cust-print-preprocess-circle-tree (object)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
564 ;; Fill up the table.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
565 (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
566 ;; A tag is of the form:
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
567 ;; ( <object> <nil-t-or-id-number> )
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
568 ;; 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
569 ;; 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
570 ;; 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
571 ;; variable sometimes (poor man's locf).
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
572 (circle-table (list nil)))
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
573 (cust-print-walk-circle-tree object)
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
574
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
575 ;; 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
576 ;; 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
577 ;; table with setcdr in walk-circle-tree.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
578 (setcdr circle-table (nreverse (cdr circle-table)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
579
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
580 ;; Walk through the table, assigning id-numbers to those
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
581 ;; objects which will be printed using #N= syntax. Delete those
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
582 ;; 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
583 (let ((rest circle-table)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
584 (id -1))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
585 (while (cdr rest)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
586 (let ((tag (car (cdr rest))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
587 (cond ((cdr tag)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
588 (setcdr tag id)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
589 (setq id (1- id))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
590 (setq rest (cdr rest)))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
591 ;; Else delete this object.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
592 (t (setcdr rest (cdr (cdr rest))))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
593 ))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
594 ;; Drop the car.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
595 (cdr circle-table)
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
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
599
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
600 (defun cust-print-walk-circle-tree (object)
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
601 (let (read-equivalent-p tag)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
602 (while object
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
603 (setq read-equivalent-p
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
604 (or (numberp object)
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
605 (and (symbolp object)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
606 ;; Check if it is uninterned.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
607 (eq object (intern-soft (symbol-name object)))))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
608 tag (and (not read-equivalent-p)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
609 (assq object (cdr circle-table))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
610 (cond (tag
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
611 ;; Seen this object already, so note that.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
612 (setcdr tag t))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
613
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
614 ((not read-equivalent-p)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
615 ;; Add a tag for this object.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
616 (setcdr circle-table
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
617 (cons (list object)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
618 (cdr circle-table)))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
619 (setq object
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 38436
diff changeset
620 (cond
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
621 (tag ;; No need to descend since we have already.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
622 nil)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
623
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
624 ((consp object)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
625 ;; 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
626 (cust-print-walk-circle-tree (car object))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
627 ;; But walk the cdr with the above while loop
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
628 ;; to avoid problems with max-lisp-eval-depth.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
629 ;; And it should be faster than recursion.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
630 (cdr object))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
631
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
632 ((vectorp object)
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
633 ;; Walk the vector.
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
634 (let ((i (length object))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
635 (j 0))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
636 (while (< j i)
1359
96c43cee31f1 CP:: changed to cust-print- in all names.
Richard M. Stallman <rms@gnu.org>
parents: 1356
diff changeset
637 (cust-print-walk-circle-tree (aref object j))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
638 (setq j (1+ j))))))))))
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
639
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
640
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
641 ;; Example.
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
642 ;;=======================================
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
643
6511
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 (progn
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
646 ;; Create some circular structures.
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
647 (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
648 (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
649 (setcar (nthcdr 3 circ-list) circ-list)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
650 (aset (nth 2 circ-list) 2 circ-list)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
651 (setq dotted-circ-list (list 'a 'b 'c))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
652 (setcdr (cdr (cdr dotted-circ-list)) dotted-circ-list)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
653 (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
654 (aset circ-vector 5 (make-symbol "-gensym-"))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
655 (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
656 nil)
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
657
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
658 (install-custom-print)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
659 ;; (setq print-circle t)
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
660
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
661 (let ((print-circle t))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
662 (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
663 (error "circular object with array printing")))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
664
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
665 (let ((print-circle t))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
666 (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
667 (error "circular object with array printing")))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
668
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
669 (let* ((print-circle t)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
670 (x (list 'p 'q))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
671 (y (list (list 'a 'b) x 'foo x)))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
672 (setcdr (cdr (cdr (cdr y))) (cdr y))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
673 (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
674 )
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
675 (error "circular list example from CL manual")))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
676
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
677 (let ((print-circle nil))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
678 ;; 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
679 ;; (require 'cl-packages)
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
680 (or (equal (prin1-to-string circ-sym) "(#:FOO #:FOO)")
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
681 (error "uninterned symbols in list")))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
682 (let ((print-circle t))
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
683 (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
684 (error "circular uninterned symbols in list")))
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
685
6511
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
686 (uninstall-custom-print)
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
fb1c6b7aba39 Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents: 3591
diff changeset
689 (provide 'cust-print)
655
02591d9e7ad3 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
690
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 49598
diff changeset
691 ;;; arch-tag: 3a5a8650-622c-48c4-87d8-e01bf72ec580
811
e694e0879463 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 807
diff changeset
692 ;;; cust-print.el ends here